function TFrmSet.PingHost(HostIP: String): Boolean;
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;
TIcmpCreateFile = function:THandle;stdcall;
TIcmpCloseHandle= function(IcmpHandle:THandle):Boolean;stdcall;
TIcmpSendEcho=function(IcmpHandle:THandle;
DestinationAddress: DWORD;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
):DWord;stdcall;
var
hICMP:THandle;
hICMPdll:THandle;
IcmpCreateFile:TIcmpCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho:TIcmpSendEcho;
pIPE:PIcmpEchoReply;// ICMP Echo reply buffer
FIPAddress:DWORD;
FSize:DWORD;
FTimeOut:DWORD;
BufferSize:DWORD;
pReqData,pRevData:PChar;
MyString:string;
begin
Result:=False;
hICMPdll:=LoadLibrary('icmp.dll');
if hICMPdll=0 then exit;
@ICMPCreateFile:=GetProcAddress(hICMPdll,'IcmpCreateFile');
@IcmpCloseHandle:=GetProcAddress(hICMPdll,'IcmpCloseHandle');
@IcmpSendEcho:=GetProcAddress(hICMPdll, 'IcmpSendEcho');
hICMP := IcmpCreateFile;
if (hICMP=INVALID_HANDLE_VALUE) then exit;
FIPAddress:=inet_addr(PChar(HostIP));
MyString := 'Hello,World'; //send data buffer
pReqData:=PChar(MyString);
FSize:=40; //receive data buffer
BufferSize:=SizeOf(TICMPEchoReply)+FSize;
GetMem(pIPE,BufferSize);
FillChar(pIPE^,SizeOf(pIPE^), 0);
GetMem(pRevData,FSize);
pIPE^.Data:=pRevData;
FTimeOut:=4000;
try
Result:=IcmpSendEcho(hICMP, FIPAddress,pReqData,
Length(MyString),nil,pIPE,BufferSize,FTimeOut)>0;
finally
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPdll);
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;