Postada em 28/07/2008 01:34 hs
rsrsrs, cara eu estava precisando de um código desse tipo, e eu consegui....rsrsrs
é simples, cole o código abaixo em um módulo
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
Private m_WinsockControl As Control
Private m_NICAddress As String
Private m_IPSubnetAddress As String
Private m_IPSubnetMask As String
Public Property Let WinsockControl(ByRef RefWinsock As Control)
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
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
Set m_WinsockControl = RefWinsock
End Property
Public Property Let IPSubnetAddress(ByVal NewAddress As String)
m_IPSubnetAddress = ValidateIPAddress(NewAddress)
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
Public Property Let IPSubnetMask(ByVal NewMask As String)
m_IPSubnetMask = ValidateIPAddress(NewMask)
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
Public Property Let NICAddress(ByVal NewNicAddress As String)
m_NICAddress = ValidateNICAddress(NewNicAddress)
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
Public Sub WakeUp()
Dim ActualNICAddress As String
On Error GoTo Error_Handler1
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
SendMagicPacketTo m_IPSubnetAddress, m_IPSubnetMask, _
m_NICAddress, m_WinsockControl
Exit Sub
Error_Handler1:
Err.Raise Err.Number, Err.Source & " <Raised From CMagicPacket.WakeUp()>", _
Err.Description, Err.HelpFile, Err.HelpContext
End Sub
Private Sub SendMagicPacketTo(IPSubnetAddress As String, _
IPSubnetMask As String, _
HWAddress As String, _
WinsockCtrl As Winsock)
Dim MagicPacketData(0 To 101) As Byte
Dim HWAddressByteValues(0 To 5) As Byte
Dim ByteIndex As Byte
Dim NICAddressIndex As Byte
On Error GoTo Error_Handler
HWAddressStrToByteArray HWAddress, HWAddressByteValues()
IPSubnetAddress = IPSubnetAddressToBroadcastAddress(IPSubnetAddress, IPSubnetMask)
For ByteIndex = 0 To 5
MagicPacketData(ByteIndex) = 255
Next
For NICAddressIndex = 0 To 15
For ByteIndex = 0 To 5
MagicPacketData((NICAddressIndex * 6) + ByteIndex + 6) = _
HWAddressByteValues(ByteIndex)
Next
Next
m_WinsockControl.RemoteHost = IPSubnetAddress
m_WinsockControl.Protocol = sckUDPProtocol
m_WinsockControl.SendData MagicPacketData
m_WinsockControl.Close
Exit Sub
Error_Handler:
Err.Raise Err.Number, Err.Source & _
" <Raised From CMagicPacket.SendMagicPacketTo()>", _
Err.Description, Err.HelpFile, Err.HelpContext
End Sub
Private Function ValidateNICAddress(AddressToValidate As String) As String
Const VALID_NIC_ADDRESS_LENGTH = 12
Dim HexCharIndex As Long
Dim HexChar As String
Dim InitialAddress As String
Dim ReducedAddress As String
ReducedAddress = ""
InitialAddress = UCase$(Trim$(AddressToValidate))
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
If Len(ReducedAddress) = VALID_NIC_ADDRESS_LENGTH Then
ValidateNICAddress = UCase$(ReducedAddress)
Else
ValidateNICAddress = ""
End If
End Function
Private Function ValidateIPAddress(AddressToValidate As String) As String
Dim TempStr As String
Dim ReducedAddress As String
Dim SplitAddress() As String
Dim OctetIndex As Long
Dim OctetValue As Long
For OctetIndex = 1 To Len(AddressToValidate)
TempStr = Mid$(AddressToValidate, OctetIndex, 1)
Select Case TempStr
Case "0" To "9", ".": ReducedAddress = ReducedAddress & TempStr
End Select
Next
SplitAddress = Split(ReducedAddress, ".")
ReducedAddress = ""
If UBound(SplitAddress()) <> 3 Then
ValidateIPAddress = ""
Exit Function
End If
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
ValidateIPAddress = ReducedAddress
End Function
Private Sub HWAddressStrToByteArray(HexHWAddress As String, _
ByRef HWAddressByteArray() As Byte)
Dim ByteIndex As Long
For ByteIndex = 0 To 5
HWAddressByteArray(ByteIndex) = 0
Next
For ByteIndex = 1 To 11 Step 2
HWAddressByteArray((ByteIndex - 1) / 2) = _
Val("&H" & Mid$(HexHWAddress, ByteIndex, 2))
Next
End Sub
Private Function IPSubnetAddressToBroadcastAddress(IPSubnetAddress As String, _
IPSubnetMask As String) _
As String
Dim IPStrArray() As String
Dim MaskStrArray() As String
Dim BCastAddressByte As Byte
Dim BCastAddress As String
Dim ByteIndex As Long
If ValidateIPAddress(IPSubnetAddress) = "" Or _
ValidateIPAddress(IPSubnetMask) = "" Then
IPSubnetAddressToBroadcastAddress = "255.255.255.255"
Exit Function
End If
BCastAddress = ""
IPStrArray = Split(IPSubnetAddress, ".")
MaskStrArray = Split(IPSubnetMask, ".")
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
IPSubnetAddressToBroadcastAddress = BCastAddress
End Function
E este outro código vc coloca em um form, o código pode ficar em command ou em qualquer objeto que vc queira usar pra chamar a função.... observações: vc precisa ter o endereço MAC do pc q vc quer ligar e a placa mãe dele tem q suportar WakeOn Lan e estar configurada para o mesmo.
Dim WOL_WS As CMagicPacket
Set WOL_WS = New CMagicPacket
With WOL_WS
'Adicione um controle winsock sem configuração, ele soh serve pra fazer a chamada.
.WinsockControl = Winsock1
'Aqui vai o IP do computador, no meu projeto deixei um campo pra digitar o endereço de IP
.IPSubnetAddress = ccrpIPAddress1.Text
'Na mascara de subRede é o mesmo processo.
.IPSubnetMask = ccrpIPAddress2.Text
'Aqui você coloca o endereço MAC da Placa de rede do PC que vc quer Ligar, no form que eu fiz ele
'obtem o endeço MAC através do Winsock, quando o computador esta ligado e é a primeira vez que
'ele roda o cliente, o Programa cliente envia o IP, Endereço de SubRede, endereço MAC e mais
'algumas informações.
.NICAddress = Text1
.WakeUP
End With
Set WOL_WS = Nothing
Espero que tenha ajudado! Abraço a todos...........
|
