100分 求远程唤醒(WOL(Wake on Lan)程序的源代码（delphi）(100分)

求远程唤醒(WOL(Wake on Lan)程序的源代码（delphi）

给你一个 c 的吧， 这是我刚刚从dfw上找到的
,=========================================================================
,这个就是很多大哥们在网上苦苦寻找的代码。
,=========================================================================
,CMagicPacket.cls
'************************************************************************
'
' CMagicPacket - AMD Magic Packet (Wake-On-Lan) Class Module (v1.1)
' By Richard Larson, 1999/2000 - Requires VB 6.0 or better.
'
' This class encapsulates the functionality necessary to send Wake-on-Lan
' packets to WFM (Wired-For-Management) enabled computers that reside on
' an IP network.
'
'************************************************************************
'
' Version History:
'
' 1.1 - Fixed a bug that prevented IP addresses with individual octet
' values of zero from being properly validated in the
' ValidateIPAddress() function.
'
' 1.0 - Initial release to Internet.
'
'************************************************************************
'
' External Class Dependencies:
'
' This class depends on the existance of a winsock control on a form
' somewhere in the project. Each instance of this object must have a
' reference set to such a winsock control before it can be used to
' wake-up a workstation. This is accomplished via the WinsockControl
' property of the class.
'
'************************************************************************
'
' To create this class, open a new VB6 project and add a class module to
' it. Name the class module "CMagicPacket" and then paste this code
' snippet into it. Then save the class and add it to any project that
' needs this functionality.
'
' To use an object of this class, you must provide an MS Winsock control
' on one of your forms and then set the WinSockControl property to it as
' a reference. Then you simply set the NICAddress, IPSubnetAddress and
' IPSubnetMask properties of the new object and call the wakeup method.
'
' Example:
'
' Dim WOL_WS as CMagicPacket
' Set WOL_WS = New CMagicPacket
' With WOL_WS
' .WinsockCtrl=Winsock1
' .NICAddress="0008d7aa4e24"
' .IPSubnetAddress="172.17.1.0"
' .IPSubnetMask="255.255.255.0"
' .WakeUp
' End With
' Set WOL_WS=Nothing
'
' If the IPSubnetAddress or IPSubnetMask properties are left blank
' (or are determined to be invalid), the packet will be broadcast on
' the IP subnet local to the workstation that the object is running on.
'
'************************************************************************

'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 &amp; " <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 &amp; _
" <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 &amp; 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 &amp; 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 &amp; Format$(OctetValue, "##0")
If OctetIndex < 3 Then ReducedAddress = ReducedAddress &amp; "."
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("&amp;H" &amp; 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 &amp; CStr(BCastAddressByte)
If ByteIndex < 3 Then BCastAddress = BCastAddress &amp; "."

Next

'And finally return it to the calling routine...
IPSubnetAddressToBroadcastAddress = BCastAddress

End Function

//老问题了，抄给你一些代码

//------------------------------------------------------------------------------
function GetStrFormMacHex(StrHex:string): String;
function HexToInt(Hex: String): Integer;
var
I, Res: Integer;
ch: Char;
begin
Res := 0;
for I := 0 to Length(Hex) - 1 do
begin
ch := Hex[I + 1];
if (ch >= '0') and (ch <= '9') then
Res := Res * 16 + Ord(ch) - Ord('0')
else if (ch >= 'A') and (ch <= 'F') then
Res := Res * 16 + Ord(ch) - Ord('A') + 10
else if (ch >= 'a') and (ch <= 'f') then
Res := Res * 16 + Ord(ch) - Ord('a') + 10
else raise Exception.Create('Error: not a Hex String');
end;
Result := Res;
end;

var
Temp: String;
I: Integer;
begin
for I := 0 to Length(StrHex) div 2 - 1 do
begin
Temp := Copy(StrHex, I * 2 + 1, 2);
Result := Result + String(Char(HexToInt(Temp)));
end;
end;
//------------------------------------------------------------------------------
procedure UDPSend(SendCode: String);
var
SendMStream:TMemoryStream;
begin
SendMStream:=TMemoryStream.Create;
try
NMUDP1.ReportLevel:=1;
NMUDP1.RemoteHost:=GetBoardAddr(GetLocalIP);
NMUDP1.RemotePort:=7010;
SendMStream.Write(SendCode[1],length(SendCode));
NMUDP1.SendStream(SendMStream);
finally
SendMStream.Free;
end;
end;

//------------------------------------------------------------------------------
procedure TfrmServer.btnWakeClick(Sender: TObject);
var
SendCode:string;
TempStr:string;
strMac:string;
strSet:string;
i,j:integer;
begin
if LstView.SelCount<=0 then exit;
for j:=0 to LstView.Items.Count-1 do begin
if LstView.Items[j].Selected then begin
strMac:=LstView.Items[j].SubItems[0];
if Length(strMac)=12 then begin
SendCode:=StringofChar(#255,6); // 前导为6个FF
TempStr:='';
strSet:=GetStrFormMacHex(strMac); // 将MAC地址转化为字符

for i:=0 to 15 do
begin
TempStr:=TempStr + strSet; // 将转化的MAC地址重复16次
end;

SendCode:=SendCode+TempStr; // 连接字符
UDPSend(SendCode); // 发送字符
Sleep(30); // 停留延时
end else begin
Raise Exception.Create('无效的MAC地址！');
end;
end;
end;
end;

to 爱元元的哥哥, 我用的时候UDPSend出错如何解决呢？
我很菜的

错误总有提示吧[]

to 爱元元的哥哥
procedure UDPSend(SendCode: String);
错误提示：Undeclared identifier: 'UDPSend'

to chshanghai：
用VB的代码冒充C也太明显了吧[?]
[8D][8D][8D][8D]

to: ww1234ww
Undeclared identifier: 'UDPSend'
未申明这个函数，你是不是没有包含该函数所在的单元，或则，写错了名字啊

呵呵，这么久还没有解决啊，代码都给你啦呀！

下面的需要对方的MAC,和IP地址阿,你看能不能用
WSocket是ICS的控件
function WakeUpComputer(AMacAddr, AIPAddr : PChar) : Boolean; stdcall;
var
MagicStr, BroadcastAddr : string;
i, Dot : Integer;
strMacAddr, strIPAddr : string;
WSocket : TWSocket;
begin
MagicStr := '';
strMacAddr := StrPas(AMacAddr);
strIPAddr := StrPas(AIPAddr);
for i := 1 to 16 do
begin
MagicStr := MagicStr + string(Char(StrToInt('0x' + Copy(strMacAddr, 1, 2))))
+ string(Char(StrToInt('0x' + Copy(strMacAddr, 3, 2))))
+ string(Char(StrToInt('0x' + Copy(strMacAddr, 5, 2))))
+ string(Char(StrToInt('0x' + Copy(strMacAddr, 7, 2))))
+ string(Char(StrToInt('0x' + Copy(strMacAddr, 9, 2))))
+ string(Char(StrToInt('0x' + Copy(strMacAddr, 11, 2))));
end;
MagicStr := StringOfChar(#255,6) + MagicStr;

BroadcastAddr := '';
for i := 0 to 2 do
begin
Dot := Pos('.', strIPAddr);
BroadcastAddr := BroadcastAddr + Copy(strIPAddr, 1, Dot);
Delete(strIPAddr, 1, Dot);
end;
BroadcastAddr := BroadcastAddr + '255';

//dmShare.UDPSendStr(BroadcastAddr, C_IsActivePort, MagicStr);
WSocket := TWSocket.Create(nil);
try
with WSocket do
begin
Close;
Proto := 'UDP';
Port := '7911';
Addr := BroadcastAddr;
Connect;
SendStr(MagicStr);
end;
finally
WSocket.Close;
WSocket.Free;
end;

Result := True;
end;

ip地址可不是在后面加.255就行的！
有可能是nnn.nnn.nnn.255
有可能是nnn.nnn.255.255
有可能是nnn.nnn.1.255等等！