Форум программистов [Powered by Invision Power Board]

Код

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^)^;
  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.