uses Winsock; 
 
type 
 
  ICMP_ECHO_REPLY = packed record 
    Address, Status, RoundTripTime: Cardinal; 
    DataSize: WORD; 
    Reserved: Integer; 
    Data: Pointer; 
    Dummy: Int64; 
  end; 
 
function IcmpCreateFile: THandle; stdcall; external 'icmp.dll'; 
 
function IcmpCloseHandle(icmpHandle: THandle): boolean; 
  stdcall; external 'icmp.dll' 
 
function IcmpSendEcho(IcmpHandle: THandle; DestinationAddress: TInAddr; 
  RequestData: Pointer; RequestSize: Smallint; RequestOptions: pointer; 
  ReplyBuffer: Pointer; ReplySize: DWORD; 
  Timeout: DWORD): DWORD; stdcall; external 'icmp.dll'; 
 
function StringToAddr(IP: string; var IA: TInAddr): boolean; 
var 
  wsad: TWSAData; 
  HE: PHostEnt; 
begin 
  Result := false; 
  if WSAStartup(MAKEWORD(2, 0), wsad) <> 0 then exit; 
  try 
    HE := GetHostByName(PChar(IP)); 
    if HE <> nil then 
      copymemory(@IA.S_un_b, HE^.h_addr_list^, 4) 
    else begin 
      WSACleanup; 
      exit; 
    end; 
  except 
    WSACleanup; 
    exit; 
  end; 
  WSACleanup; 
  Result := true; 
end; 
 
function Ping(IAdd: string; TimeOut: Cardinal; var tm: Cardinal): DWord; 
var 
  h: THandle; 
  IPA: TInAddr; 
  p, x: integer; 
  Reply: ICMP_ECHO_REPLY; 
  s: array[0..3] of string; 
begin 
  result := $FFFFFFFF; 
  while (IAdd <> '') and (IAdd[1] = '\') do delete(IAdd, 1, 1); 
  if IAdd <> '' then begin 
    if copy(IAdd, 1, 7) = 'http://' then 
      IAdd := Copy(IAdd, 8, maxint); 
    if IAdd[1] in ['0'..'9'] then try 
      for x := 0 to 3 do begin 
        p := pos('.', IAdd); 
        if p = 0 then s[x] := inttostr(strtoint(IAdd)) else 
          s[x] := inttostr(strtoint(copy(IAdd, 1, p - 1))); 
        IAdd := copy(IAdd, p + 1, maxint); 
      end; 
      IAdd := s[0] + '.' + s[1] + '.' + s[2] + '.' + s[3]; 
    except 
      exit; 
    end; 
    h := IcmpCreateFile; 
    if h <> INVALID_HANDLE_VALUE then begin 
      if StringToAddr(IAdd, IPA) then begin 
        IcmpSendEcho 
          (h, IPA, nil, 0, nil, @Reply, SizeOf(ICMP_ECHO_REPLY), TimeOut); 
        Result := Reply.status; 
        tm := Reply.RoundTripTime; 
      end; 
      IcmpCloseHandle(h); 
    end; 
  end; 
end; 
 
function fehler(dw: Cardinal): string; 
begin 
  case dw of 
    11001: result := 'Buffer Too Small'; 
    11002: result := 'Destination Net Unreachable'; 
    11003: result := 'Destination Host Unreachable'; 
    11004: result := 'Destination Protocol Unreachable'; 
    11005: result := 'Destination Port Unreachable'; 
    11006: result := 'No Resources'; 
    11007: result := 'Bad Option'; 
    11008: result := 'Hardware Error'; 
    11009: result := 'Packet Too Big'; 
    11010: result := 'Request Timed Out'; 
    11011: result := 'Bad Request'; 
    11012: result := 'Bad Route'; 
    11013: result := 'TimeToLive Expired Transit'; 
    11014: result := 'TimeToLive Expired Reassembly'; 
    11015: result := 'Parameter Problem'; 
    11016: result := 'Source Quench'; 
    11017: result := 'Option Too Big'; 
    11018: result := 'Bad Destination'; 
    11032: result := 'Negotiating IPSEC'; 
  else result := 'General Failure'; 
  end; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button8Click(Sender: TObject); 
var 
  tm, dw: Cardinal; 
begin 
  screen.cursor := crHourglass; 
  dw := ping('17.8.254.6', 3000, tm); 
//oder auch: 
//dw := ping('PC250', 1000, tm); 
  screen.cursor := crDefault; 
  if dw = 0 then 
    showmessage('Time: ' + inttostr(tm) + ' ms') 
  else showmessage(Fehler(dw)); 
end;