Ping2.pas

Ping2.pas

unit Ping2;

interface

function PingHost(const HostName:string;TimeoutMS:cardinal=500):boolean;

implementation

uses Windows, SysUtils, WinSock, Sockets;

function IcmpCreateFile:THandle; stdcall; external 'iphlpapi.dll';
function IcmpCloseHandle(icmpHandle:THandle):boolean; stdcall; external 'iphlpapi.dll'
function IcmpSendEcho(IcmpHandle:THandle;DestinationAddress:In_Addr;RequestData:Pointer;
  RequestSize:Smallint;RequestOptions:pointer;ReplyBuffer:Pointer;ReplySize:DWORD;
  Timeout:DWORD):DWORD; stdcall; external 'iphlpapi.dll';

type
  TEchoReply=packed record
    Addr:in_addr;
    Status:DWORD;
    RoundTripTime:DWORD;
    //DataSize:
    //Reserved:
    //Data:pointer;
    //Options:
  end;
  PEchoReply=^TEchoReply;

function PingHost(const HostName:string;TimeoutMS:cardinal=500):boolean;
const
  rSize=$400;
var
  e:PHostEnt;
  a:PInAddr;
  h:THandle;
  d:string;
  r:array[0..rSize-1] of byte;
  i:cardinal;
begin
  //assert WSAStartup called
  e:=gethostbyname(PChar(HostName));
  if e=nil then RaiseLastOSError;
  if e.h_addrtype=AF_INET then pointer(a):=e.h_addr^ else raise Exception.Create('Name doesn''t resolve to an IPv4 address');

  d:=FormatDateTime('yyyymmddhhnnsszzz',Now);

  h:=IcmpCreateFile;
  if h=INVALID_HANDLE_VALUE then RaiseLastOSError;
  try
    i:=IcmpSendEcho(h,a^,PChar(d),Length(d),nil,@r[0],rSize,TimeoutMS);
    Result:=(i<>0) and (PEchoReply(@r[0]).Status=0);
  finally
    IcmpCloseHandle(h);
  end;
end;

end.