'Object-level constants and enums...
Private Const ERROR_BASE = vbObjectError + 2000
Private Const ERROR_INVALID_NIC_ADDRESS = ERROR_BASE + 1
Private Const ERROR_INVALID_IP_SUBNET_ADDRESS = ERROR_BASE + 2
Private Const ERROR_INVALID_IP_SUBNET_MASK = ERROR_BASE + 3
Private Const ERROR_INVALID_WINSOCK_REFERENCE = ERROR_BASE + 4
Private Const ERROR_NO_WINSOCK_REFERENCE_AVAILABLE = ERROR_BASE + 5
'Object-level variables...
Private m_WinsockControl
As Control
Private m_NICAddress
As String
Private m_IPSubnetAddress
As String
Private m_IPSubnetMask
As String
'************************************************************************
' Property WinsockControl()
'
' This is the property assignment function (LET only) for the Winsock
' Control property. It validates that the winsock control being
' assigned is really a winsock control, and that it is not set to
' "nothing". If either of these checks fails, an appropriate error
' message is raised back to the caller.
'
'************************************************************************
Public Property Let WinsockControl(
ByRef RefWinsock
As Control)
'Check for uninitialized controls...
If RefWinsock
Is Nothing Then
Err.Raise ERROR_NO_WINSOCK_REFERENCE_AVAILABLE, _
"CMagicPacket.WinsockControl(LET)", _
"An attempt was made to set the WinsockControl property " & _
"to an uninitialized control"
End If
'Check for invalid control types...
If TypeOf RefWinsock
Is Winsock
Then
Set m_WinsockControl = RefWinsock
Else
Err.Raise ERROR_INVALID_WINSOCK_REFERENCE, _
"CMagicPacket.WinsockControl(LET)", _
"An attempt was made to set the WinsockControl property " & _
"to a non-winsock control"
End If
'It passed the test, so set our reference to it...
Set m_WinsockControl = RefWinsock
End Property
'************************************************************************
' Property IPSubnetAddress()
'
' These are the assignment functions for the IP Address property. LET
' validates the IP subnet address being assigned and raises an error back
' to the calling function if it was not a valid 32-bit IP address. GET
' returns the current address in dotted-decimal notation (www.xxx.yyy.zzz)
'
'************************************************************************
Public Property Let IPSubnetAddress(
ByVal NewAddress
As String)
'Set the new IP subnet address...
m_IPSubnetAddress = ValidateIPAddress(NewAddress)
'And raise an error if it is not valid...
If m_IPSubnetAddress = ""
Then
Err.Raise ERROR_INVALID_IP_SUBNET_ADDRESS, _
"CMagicPacket.IPSubnetAddress(LET)", _
"Invalid IP Subnet Address"
End If
End Property
Public Property Get IPSubnetAddress()
As String
IPSubnetAddress = m_IPSubnetAddress
End Property
'************************************************************************
' Property IPSubnetMask()
'
' These are the assignment functions for the IP Subnet Mask property. LET
' validates the IP subnet mask being assigned and raises an error back to
' the calling function if it was not a valid 32-bit IP mask address. GET
' returns the current address in dotted-decimal notation (www.xxx.yyy.zzz)
'
'************************************************************************
Public Property Let IPSubnetMask(
ByVal NewMask
As String)
'Set the new IP subnet address...
m_IPSubnetMask = ValidateIPAddress(NewMask)
'And raise an error if it is not valid...
If m_IPSubnetAddress = ""
Then
Err.Raise ERROR_INVALID_IP_SUBNET_MASK, _
"CMagicPacket.IPSubnetMask(LET)", _
"Invalid IP Subnet Address"
End If
End Property
Public Property Get IPSubnetMask()
As String
IPSubnetMask = m_IPSubnetMask
End Property
'************************************************************************
' Property NICAddress()
'
' These are the assignment functions for the NIC Address property. LET
' validates the NIC Address being assigned and raises an error back to
' the calling function if it was not a valid 48-bit NIC address. GET
' returns the 48-bit unformatted hex address in the form "1A2B3C4D5E6F"
'
'************************************************************************
Public Property Let NICAddress(
ByVal NewNicAddress
As String)
'Set the new NIC address...
m_NICAddress = ValidateNICAddress(NewNicAddress)
'And raise an error if it was not valid...
If m_NICAddress = ""
Then
Err.Raise ERROR_INVALID_NIC_ADDRESS, _
"CMagicPacket.NicAddress(
Let)", _
"Invalid Nic Address"
End If
End Property
Public Property Get NICAddress()
As String
NICAddress = m_NICAddress
End Property
'************************************************************************
' Method WakeUp()
'
' This method is called in order to send the wake-on-lan magic packet to
' the machine with the 48-bit hardware address specified in NICAdress
' residing on the IP subnet specified by the IPSubnetAddress/IPSubnetMask
' properties. It uses the winsock control that was set in the
' WinSockCtrl property to do the actual packet transfer. An error flag
' will be raised back to the caller if any of these properties are set
' incorrectly.
'
'************************************************************************
Public Sub WakeUp()
Dim ActualNICAddress
As String
'Setup error handler...
On Error GoTo Error_Handler1
'Check for valid properties before sending the packet...
ActualNICAddress = ValidateNICAddress(m_NICAddress)
If ActualNICAddress = ""
Then
Err.Raise ERROR_INVALID_NIC_ADDRESS, _
"CMagicPacket.Wakeup()", _
"The NICAddress property does not contain a " & _
"valid NIC address"
End If
If m_WinsockControl
Is Nothing Then
Err.Raise ERROR_NO_WINSOCK_REFERENCE_AVAILABLE, _
"CMagicPacket.Wakeup()", _
"The WinsockCtrl property has not been set to " & _
"a valid MS-Winsock control"
End If
'Everything is OK, so send the packet on its way...
SendMagicPacketTo m_IPSubnetAddress, m_IPSubnetMask, _
m_NICAddress, m_WinsockControl
Exit Sub
Error_Handler1:
'For now, just return the error to the caller with a modified source...
Err.Raise Err.Number, Err.Source & " <Raised From CMagicPacket.WakeUp()>", _
Err.Description, Err.HelpFile, Err.HelpContext
End Sub
'************************************************************************
' SendMagicPacketTo()
'
' Send a "Magic-packet" to a workstation that supports the "wake-on-lan"
' specification. This routine takes the IP address of the subnet on
' which the workstation to be "awakened" resides, and the 48-bit ethernet
' hardware address of the workstation's NIC. It then builds and sends a
' "magic packet" to that workstation which will wake it up (as though
' someone switched on the power).
'
'************************************************************************
Private Sub SendMagicPacketTo(IPSubnetAddress
As String, _
IPSubnetMask
As String, _
HWAddress
As String, _
WinsockCtrl
As Winsock)
'Local Variables...
Dim MagicPacketData(0
To 101)
As Byte
Dim HWAddressByteValues(0
To 5)
As Byte
Dim ByteIndex
As Byte
Dim NICAddressIndex
As Byte
'Setup error handler...
On Error GoTo Error_Handler
'First convert the Ethernet HWAddress to a byte array...
HWAddressStrToByteArray HWAddress, HWAddressByteValues()
'Now get the IP broadcast address for the IP subnet we want to use...
IPSubnetAddress = IPSubnetAddressToBroadcastAddress(IPSubnetAddress, IPSubnetMask)
'Setup the Magic-Packet synchronization byte sequence (0xFFFFFFFFFFFF)...
For ByteIndex = 0
To 5
MagicPacketData(ByteIndex) = 255
Next
'Now add the Magic-Packet HWAddress sequence (16 HW Addresses in a row)...
For NICAddressIndex = 0
To 15
For ByteIndex = 0
To 5
MagicPacketData((NICAddressIndex * 6) + ByteIndex + 6) = _
HWAddressByteValues(ByteIndex)
Next
Next
'Send a datagram containing the magic-packet data to the appropriate subnet...
m_WinsockControl.RemoteHost = IPSubnetAddress
m_WinsockControl.Protocol = sckUDPProtocol
m_WinsockControl.SendData MagicPacketData
m_WinsockControl.Close
Exit Sub
Error_Handler:
'For now, just return the error back to the caller with a modified source...
Err.Raise Err.Number, Err.Source & _
" <Raised From CMagicPacket.SendMagicPacketTo()>", _
Err.Description, Err.HelpFile, Err.HelpContext
End Sub
'************************************************************************
' ValidateNICAddress()
'
' This function takes a string and determines if it is a valid NIC
' address by checking it's length (6-hex bytes, 48-bits) and that it is
' a valid hexadecimal value (each nibble is 0-9, or A-F). If all is OK,
' the function returns a cleaned version of the address (with no
' whitespace characters and all upper case values), otherwise it returns
' a blank zero-length string.
'
' Based on this routine, all of the following addresses are valid:
'
' "1a2b3c4d5e6f" returns "1A2B3C4D5E6F"
' "1a.2b.3c.4d.5e.6f" returns "1A2B3C4D5E6F"
' "1a 2b 3c 4d 5e 6f" returns "1A2B3C4D5E6F"
' "1a2b 3c4d 5e6f" returns "1A2B3C4D5E6F" Etc....
'
'************************************************************************
Private Function ValidateNICAddress(AddressToValidate
As String)
As String
'Local Constants...
Const VALID_NIC_ADDRESS_LENGTH = 12
'Local Variables...
Dim HexCharIndex
As Long
Dim HexChar
As String
Dim InitialAddress
As String
Dim ReducedAddress
As String
'Init local variables...
ReducedAddress = ""
InitialAddress = UCase$(Trim$(AddressToValidate))
'Eliminate all non-hexadecimal characters from the address...
For HexCharIndex = 1
To Len(InitialAddress)
HexChar =
Mid$(InitialAddress, HexCharIndex, 1)
Select Case HexChar
Case "0"
To "9", "A"
To "F": ReducedAddress = ReducedAddress & HexChar
End Select
Next
'Return the appropriate value...
If Len(ReducedAddress) = VALID_NIC_ADDRESS_LENGTH
Then
ValidateNICAddress = UCase$(ReducedAddress)
Else
ValidateNICAddress = ""
End If
End Function
'************************************************************************
' ValidateIPAddress()
'
' This function takes an IP address in dotted decimal format and verifies
' that there are 4 octets of data and that the value of each octet is
' between zero and 255. This function does NOT determine whether the
' given address is legal for any particular subnetting scheme. If the
' address is valid, it will return the address itself, otherwise it will
' return an empty (zero-length) string.
'
'************************************************************************
Private Function ValidateIPAddress(AddressToValidate
As String)
As String
'Local Variables...
Dim TempStr
As String
Dim ReducedAddress
As String
Dim SplitAddress()
As String
Dim OctetIndex
As Long
Dim OctetValue
As Long
'First remove all non-decimal, non-period characters from the address...
For OctetIndex = 1
To Len(AddressToValidate)
TempStr =
Mid$(AddressToValidate, OctetIndex, 1)
Select Case TempStr
Case "0"
To "9", ".": ReducedAddress = ReducedAddress & TempStr
End Select
Next
'Split the octets into a string array for inspection...
SplitAddress = Split(ReducedAddress, "."
ReducedAddress = ""
'If there are not exactly 4 octets (0->3), return empty...
If UBound(SplitAddress()) <> 3
Then
ValidateIPAddress = ""
Exit Function
End If
'Verify that the value of each octet is between 0 and 255...
For OctetIndex = 0
To 3
TempStr = SplitAddress(OctetIndex)
OctetValue = Val(TempStr)
If Len(TempStr) = 0
Or OctetValue < 0
Or OctetValue > 255
Then
ValidateIPAddress = ""
Exit Function
End If
ReducedAddress = ReducedAddress & Format$(OctetValue, "##0"
If OctetIndex < 3
Then ReducedAddress = ReducedAddress & "."
Next
'Return the validated result...
ValidateIPAddress = ReducedAddress
End Function
'************************************************************************
' HWAddressStrToByteArray()
'
' This routine takes a hexadecimal ethernet NIC address in string format
' and converts it into a 6-element (0 to 5) array of byte values
' representing that same address. This routine is used when building
' wake-on-lan "Magic-Packets".
'
'************************************************************************
Private Sub HWAddressStrToByteArray(HexHWAddress
As String, _
ByRef HWAddressByteArray()
As Byte)
'Local Variables...
Dim ByteIndex
As Long
'Clear out the array to start...
For ByteIndex = 0
To 5
HWAddressByteArray(ByteIndex) = 0
Next
'Convert each hex double-digit to a byte in the array...
For ByteIndex = 1
To 11
Step 2
HWAddressByteArray((ByteIndex - 1) / 2) = _
Val("&H" &
Mid$(HexHWAddress, ByteIndex, 2))
Next
End Sub
'************************************************************************
' IPSubnetAddressToBCastAddress()
'
' This routine takes an IP address and it's associated subnet mask and
' returns the directed-broadcast address for that subnet. If either
' parameter is invalid the local broadcast address (255.255.255.255)
' is returned.
'
'************************************************************************
Private Function IPSubnetAddressToBroadcastAddress(IPSubnetAddress
As String, _
IPSubnetMask
As String) _
As String
'Local Variables...
Dim IPStrArray()
As String
Dim MaskStrArray()
As String
Dim BCastAddressByte
As Byte
Dim BCastAddress
As String
Dim ByteIndex
As Long
'Check for valid input...
If ValidateIPAddress(IPSubnetAddress) = ""
Or _
ValidateIPAddress(IPSubnetMask) = ""
Then
IPSubnetAddressToBroadcastAddress = "255.255.255.255"
Exit Function
End If
'Initialize the strings...
BCastAddress = ""
IPStrArray = Split(IPSubnetAddress, "."
MaskStrArray = Split(IPSubnetMask, "."
'Build the new broadcast address byte-by-byte...
For ByteIndex = 0
To 3
BCastAddressByte = Val(IPStrArray(ByteIndex))
Or _
 
Val(MaskStrArray(ByteIndex))
Xor 255)
BCastAddress = BCastAddress &
CStr(BCastAddressByte)
If ByteIndex < 3
Then BCastAddress = BCastAddress & "."
Next
'And finally return it to the calling routine...
IPSubnetAddressToBroadcastAddress = BCastAddress
End Function