unit uPing;

interface

uses

  WinSock, Windows;

type

  PIPOptionInformation = ^TIPOptionInformation;

  TIPOptionInformation = packed record

    TTL: Byte;

    TOS: Byte;

    Flags: Byte;

    OptionsSize: Byte;

    OptionsData: PChar;

  end;

  PIcmpEchoReply = ^TIcmpEchoReply;

  TIcmpEchoReply = packed record

    Address: DWORD;

    Status: DWORD;

    RTT: DWORD;

    DataSize: Word;

    Reserved: Word;

    Data: Pointer;

    Options: TIPOptionInformation;

  end;

  TIcmpCreateFile = function: THandle; stdcall;

  TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;

  TIcmpSendEcho = function(IcmpHandle: THandle; DestinationAddress: DWORD;

    RequestData: Pointer; RequestSize: Word;

    RequestOptions: PIPOptionInformation; ReplyBuffer: Pointer;

    ReplySize: DWORD; Timeout: DWORD): DWORD; stdcall;

function PingHost(HostIP: String): Boolean;

implementation

function PingHost(HostIP: String): Boolean;

var

  hICMP: THandle;

  hICMPdll: THandle;

  IcmpCreateFile: TIcmpCreateFile;

  IcmpCloseHandle: TIcmpCloseHandle;

  IcmpSendEcho: TIcmpSendEcho;

  pIPE: PIcmpEchoReply; // ICMP   Echo   reply   buffer

  FIPAddress: DWORD;

  FSize: DWORD;

  FTimeOut: DWORD;

  BufferSize: DWORD;

  pReqData, pRevData: PAnsiChar;

  MyString: string;

begin

  Result := False;

  hICMPdll := LoadLibrary('icmp.dll');

  if hICMPdll = 0 then

    exit;

  @IcmpCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');

  @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');

  @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');

  hICMP := IcmpCreateFile;

  if (hICMP = INVALID_HANDLE_VALUE) then

    exit;

  FIPAddress := inet_addr(PAnsiChar(HostIP));

  MyString := 'Hello,World'; // send   data   buffer

  pReqData := PAnsiChar(MyString);

  FSize := 40; // receive   data   buffer

  BufferSize := SizeOf(TIcmpEchoReply) + FSize;

  GetMem(pIPE, BufferSize);

  FillChar(pIPE^, SizeOf(pIPE^), 0);

  GetMem(pRevData, FSize);

  pIPE^.Data := pRevData;

  FTimeOut := 1000;

  try

    Result := IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), nil,

      pIPE, BufferSize, FTimeOut) > 0;

  finally

    IcmpCloseHandle(hICMP);

    FreeLibrary(hICMPdll);

    FreeMem(pRevData);

    FreeMem(pIPE);

  end;

end;

end.