interface
uses
Winsock;
type
IPINFO = record
Ttl: Char;
Tos: Char;
IPFlags: Char;
OptSize: Char;
Options: ^Char;
end;
ICMPECHO = record
Source: longInt;
Status: longInt;
RTTime: longInt;
DataSize: ShortInt;
Reserved: ShortInt;
pData: ^Variant;
i_ipinfo: IPINFO;
end;
TIcmpCreateFile = function(): Integer; stdcall;
TIcmpCloseHandle = procedure(var handle: Integer); stdcall;
TIcmpSendEcho = function(var handle: Integer; endereco:DWORD;
buffer:variant; tam:WORD;
IP:IPINFO; ICMP:ICMPECHO;
tamicmp:DWORD; tempo:DWORD):DWORD; stdcall;
function PingTo(vHost: String; vList: TStrings = nil): Boolean;
implementation
function PingTo(vHost: String; vList: TStrings = nil): Boolean;
var
HNDicmp, hndFile,
x, Retorno: Integer;
wsadt: wsadata;
icmp: Icmpecho;
Host : PHostEnt;
Destino: In_addr;
Endereco: ^DWORD;
IP: IpInfo;
dwRetorno: DWORD;
IcmpCreateFile: TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
begin
Result := False;
try
HNDicmp := LoadLibrary('ICMP.DLL');
if( HNDicmp <> 0 )then begin
@IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');
if( (@IcmpCreateFile = nil) or (@IcmpCloseHandle = nil)
or (@IcmpSendEcho = nil) )then begin
Raise Exception.Create('Error ICMP');
FreeLibrary(HNDicmp);
end;
end;
Retorno := WSAStartup($0101,wsadt);
if( Retorno <> 0 )then begin
Raise Exception.Create('No es posible cargar WinSock');
WSACleanup();
FreeLibrary(HNDicmp);
end;
Destino.S_addr := inet_addr(Pchar(vHost));
if( Destino.S_addr = 0 )then begin
Host := GetHostbyName(PChar(vHost));
end
else begin
Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);
end;
if( Host = nil )then begin
Raise Exception.Create('Host no encontrado');
WSACleanup();
FreeLibrary(HNDicmp);
Exit;
end;
if( assigned(vList) ) then
vList.Add('Ping a ' + vHost);
Endereco := @Host.h_addr_list;
HNDFile := IcmpCreateFile();
for X := 0 to 4 do begin
Ip.Ttl := char(255);
Ip.Tos := char(0);
Ip.IPFlags := char(0);
Ip.OptSize := char(0);
Ip.Options := nil;
dwRetorno := IcmpSendEcho(HNDFile, Endereco^,
null, 0, Ip, Icmp,
sizeof(Icmp), DWORD(5000));
Destino.S_addr := icmp.source;
if( assigned(vList) ) then
vList.Add('Ping ' + vHost);
end;
try
IcmpCLoseHandle(HNDFile);
except
end;
Result := True;
finally
FreeLibrary(HNDicmp);
WSACleanup();
end;
end;