[dec]

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;