Esta funcion no es completamente funcional. Algunas veces no funciona con HostName, sólo con direcciones IP.
La función "IcmpCLoseHandle()" no funciona del todo bien en máquinas con Windows NT, si alguien sabe porque por favor háganmelo saber.
Código Delphi
[-]
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;