unit pinger;

interface

uses windows, winsock;

function ping(host:string):integer;

implementation

type	
  ip_option_information = packed record
    Ttl: byte;
    Tos: byte;
    Flags: byte;
    OptionsSize: byte;
    OptionsData: Pointer;
  end;	

  icmp_echo_reply = packed record	
    Address: u_long;
    Status: u_long;
    RTTime: u_long;
    DataSize: u_short;
    Reserved: u_short;
    Data: Pointer;
    Options: ip_option_information;
  end;	

  PIPINFO = ^ip_option_information;	
  PVOID = Pointer;	

function IcmpCreateFile() : THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile';	
function IcmpCloseHandle(IcmpHandle : THandle): BOOL; stdcall; external 'ICMP.DLL'  name 'IcmpCloseHandle';	
function IcmpSendEcho(IcmpHandle: THandle; DestAddress: u_long; RequestData: PVOID;
                      RequestSize: Word; RequestOptns: PIPINFO;	ReplyBuffer: PVOID;
                      ReplySize: DWORD; Timeout: DWORD) : DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';

function ping(host:string):integer;
var	
  hIP : THandle;	
  pingBuffer : array [0..31] of Char;	
  pIpe : ^icmp_echo_reply;	
  pHostEn : PHostEnt;	
  wVersionRequested : WORD;	
  lwsaData : WSAData;	
  error : DWORD;	
  destAddress : In_Addr;	
begin
  result:=-1;
  hIP := IcmpCreateFile(); 
  GetMem(pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer));
  pIpe.Data := @pingBuffer;	
  pIpe.DataSize := sizeof(pingBuffer);	
  wVersionRequested := MakeWord(1,1);	
  error := WSAStartup(wVersionRequested,lwsaData);	
  if (error <> 0) then exit;
  pHostEn := gethostbyname(PChar(host));
  error := GetLastError();	
  if (error <> 0) then Exit;
  destAddress := PInAddr(pHostEn^.h_addr_list^)^;	
  // Посылаем ping-пакет	
  IcmpSendEcho(hIP,destAddress.S_addr,@pingBuffer,sizeof(pingBuffer),nil,pIpe,sizeof(icmp_echo_reply)+sizeof(pingBuffer),5000);
  error := GetLastError();	
  if (error <> 0) then Exit;
  // Смотрим некоторые из вернувшихся данных	
  result:=pIpe.RTTime;
  IcmpCloseHandle(hIP);	
  WSACleanup();	
  FreeMem(pIpe);	
end;

end.
