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;

Publicado el: 2003-11-08