Rede - rotina para ping

tem e funciona beleza super rapido , uso para saber se o servidor esta 

ativo e entao sincronizar os dados do ecf com o servidor

if not ChecaTCPPort(IPServidor,139,2) then

       ShowMessage('IP não e valido');

uses WinSock;

TSimpleFDSet = record

    fd_count: u_int;

    fd_array: array[0..0] of TSocket;

end;

function ChecaTCPPort(IPAddr: string; TCPPort: Word; Timeout: Integer): 

Boolean;

var

   S: TSocket;

   Addr: TSockAddrIn;

   NonBlocking: Integer;

   Sockets: TSimpleFDSet;

   Res: Integer;

   T: TTimeVal;

   function SocketsInit: Boolean;

   var

     Data: TWSAData;

   begin

     Result := WSAStartup($101, Data) = 0;

   end;

begin

   Result := False;

   s := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);

   if s = INVALID_SOCKET then begin

     if WSAGetLastError = WSANOTINITIALISED then begin

       if not SocketsInit then EXIT;

       s := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);

     end else EXIT;

   end;

   try

     NonBlocking := 1;

     if ioctlsocket(s, FIONBIO, NonBlocking) = SOCKET_ERROR then EXIT;

     FillChar(addr, SizeOf(addr), 0);

     addr.sin_family := PF_INET;

     addr.sin_port := htons(TCPPort);

     addr.sin_addr.S_addr := inet_addr(PChar(IPAddr));

     Res := connect(s, addr, SizeOf(addr));

     if Res = SOCKET_ERROR then begin

       if WSAGetLastError = WSAEWOULDBLOCK then begin

         Sockets.fd_count := 1;

         Sockets.fd_array[0] := S;

         T.tv_sec := 0;

         T.tv_usec := Timeout * 1000;

         Result := select(0, nil, @Sockets, nil, @T) = 1;

       end;

     end;

   finally

     closesocket(S);

   end;

end;

------------------------------------------------------------

usando o ICS: TPing

================================================================

.................... DELPHI 6 ................................

object ICMP: TIdIcmpClient

  ReceiveTimeout = 250

  OnReply = ICMPReply

end

var

  PingOk: Boolean;

procedure TForm1.ICMPReply(ASender: TComponent; const AReplyStatus: TReplyStatus);

begin

  PingOk := AReplyStatus.ReplyStatusType = rsEcho;

 //  PingOk := AReplyStatus.BytesReceived > 0;  NAO USE ESTE

end;

function TForm1.Pinga(const IP: string; TimeOut: Integer = 250): Boolean;

begin

  PingOk := False;

  Result := False;

  try

    ICMP.ReceiveTimeout:= TimeOut;

    ICMP.Host          := IP;

    ICMP.Ping;

    Result             := PingOk;

 // faz 2 vezes para ter certeza

    if not PingOk then 

 begin

   ICMP.Ping; 

      Result := PingOk;

 end;

  except

  end;

end;

.................... DELPHI 5 ................................

object Ping: TPing

  Address = 'abc'

  Size = 1

  Timeout = 250

  TTL = 64

  OnEchoReply = PingEchoReply

  OnDnsLookupDone = PingDnsLookupDone

end

////////////////////////////////////////////////////////////////////// COMPONENTE PING...

function TPrincipalForm.Pinga(const IP:string):Boolean;

begin

  PingOK := False;

  Ping.DnsLookup(IP);

  // Try AGAIN!

  if not PingOK then Ping.DnsLookup(IP);

  // Para cancelar o ping:   Ping1.CancelDnsLookup;

  Result := PingOk;

end;

procedure TPrincipalForm.PingDnsLookupDone(Sender: TObject; Error: Word);

begin

  if Error <> 0 then Exit;

  Ping.Address := Ping.DnsResult;

  Ping.Ping;

end;

procedure TPrincipalForm.PingEchoReply(Sender, Icmp: TObject; Error: Integer);

begin

  PingOk := not (Error = 0);

end;