高分：如何用Delphi程式实现Ping的功能？（在线,OK立即给分)

[peterzhou20]

如何用Delphi程式实现Ping的功能？

[zawload]

unit PingClass;

interface

uses
Classes, Windows, WinSock, ScktComp, MMSystem;

Type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = Packed Record
TTL: Byte;
TOS: Byte;
Flags: Byte;
OptionsSize: Byte;
OptionsData: PChar;
End;

PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = Packed Record
Address: DWORD;
Status: DWORD;
RTT: DWORD;
DataSize: Word;
Reserved: Word;
Data: Pointer;
Options: TIPOptionInformation;
End;

Const PING_DLL = 'icmp.dll';

function TIcmpCreateFile: THandle; stdcall; external PING_DLL name 'IcmpCreateFile';
function TIcmpCloseHandle(IcmpHandle: THandle): Boolean; stdcall; external PING_DLL name 'IcmpCloseHandle';
function TIcmpSendEcho(IcmpHandle:THandle; DestinationAddress:DWORD;
RequestData: Pointer; RequestSize: Word;
RequestOptions: PIPOptionInformation; ReplyBuffer: Pointer;
ReplySize: DWord; Timeout: DWord ):DWord; stdcall; external PING_DLL name 'IcmpSendEcho';


type
TPing = class(TThread)
private
{ Private declarations }
hICMP: THANDLE;
hCSocket: TClientSocket;
protected
procedure Execute; override;
procedure INI_PING;
procedure _INI_PING;
Function PING(Add, Msg: String; TimeOut: DWord): Boolean;
Procedure CheckPing;
Public
constructor Create(CSocket: TClientSocket);
destructor Destroy; override;
end;

implementation

constructor TPing.Create(CSocket: TClientSocket);
begin
hCSocket := CSocket;
INI_PING;
inherited Create(True);
end;

procedure TPing.Execute;
Begin
{ Place thread code here }
While Not Terminated Do Begin
Synchronize(CheckPing); //异部执行
Sleep(5000);
End;
end;

procedure TPing._INI_PING;
begin
TIcmpCloseHandle(hICMP);
end;

procedure TPing.INI_PING;
begin
hICMP := TIcmpCreateFile;
end;

function TPing.PING(Add, Msg: String; TimeOut: DWord): Boolean;
var
IPOpt: TIPOptionInformation;
pIPE: PIcmpEchoReply;
FSize: DWORD;
FIPAddress: DWORD;

pReqData, pRevData: PChar;
BufferSize: DWORD;
Begin
Result := False;
FIPAddress := inet_addr(PChar(Add));
FSize := 40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData, FSize);
GetMem(pIPE, BufferSize);

FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
pReqData := PChar(Msg);

FillChar(IPOpt, Sizeof(IPOpt), 0);
IPOpt.TTL := 64;

TIcmpSendEcho(hICMP, FIPAddress, pReqData, FSize, @IPOpt, pIPE, BufferSize, TimeOut);
If pIPE.DataSize > 0 Then
If String(pIPE.Options.OptionsData) = Msg Then
Result := True;
FreeMem(pRevData);
FreeMem(pIPE);
end;

destructor TPing.Destroy;
begin
inherited Destroy;
_INI_PING;
end;

procedure TPing.CheckPing;
Var
ConnectTT: Boolean;
begin
ConnectTT := Ping(hCSocket.Address, 'Test Connect CDXX', 4000);
If ConnectTT Then
Begin
If Not hCSocket.Active Then //如果没连通
hCSocket.Active := True; //连通
End Else Begin
PlaySound(Nil, 0, SND_PURGE);
PlaySound(PChar('s3.wav'), 0, SND_ASYNC or SND_FILENAME);
If hCSocket.Active Then
hCSocket.Active := False;
End;
end;

end.

[zawload]

这是一段的ping 功能的程序,修改一下就可以用了!