How to ping an IP address in Delphi 10.1 without using Indy components?

Question

How to ping an IP address (or by server name) in Delphi 10.1 without using Indy components? TIdICMPClient works with elevated privileges but I want to do it as a normal user.

You can only ping an IP address, so you would have to resolve the IP via DNS if you have a hostname instead. Once you have an IP, you can use `IcmpSendEcho()` on Windows. On OSX, and maybe also Linux, you can use a UDP socket to send/receive ICMP echo packets without needing admin rights — Remy Lebeau, Apr 27 '17 at 21:13
@Remy It must take a lot of guts to respond calmly to someone who doesn't want to use your pride and joy :-/ — Jerry Dodge, Apr 27 '17 at 21:33
@JerryDodge I'm well aware that `TIdIcmpClient` only works with admin rights, and it is not uncommon to want to ping without them. — Remy Lebeau, Apr 27 '17 at 23:32
@Remy, why does Indy require elevated privileges for pinging? — Johan, Apr 28 '17 at 10:11
@Johan because Indy implements ICMP manually using a RAW socket, and RAW sockets require admin rights on modern OSes. When `TIdIcmpClient` was first written, Windows was the only OS supported, and Microsoft hadn't locked down the use of RAW sockets yet. — Remy Lebeau, Apr 28 '17 at 15:22
A few years ago I wrote a ping method using WMI And Delphi. Try this https ://theroadtodelphi.com/2011/02/02/making-a-ping-with-delphi-and-the-wmi/ — RRUZ, Apr 28 '17 at 21:47

Adriaan Greybe · Answer 1 · 2019-12-17T13:25:17.507

The other answers had some things missing from them.

Here is a complete unit that does the trick:

unit Ping2;

interface

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

implementation

uses Windows, SysUtils, WinSock;

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;
  end;

  PEchoReply = ^TEchoReply;

var
  WSAData: TWSAData;

procedure Startup;
begin
  if WSAStartup($0101, WSAData) <> 0 then
    raise Exception.Create('WSAStartup');
end;

procedure Cleanup;
begin
  if WSACleanup <> 0 then
    raise Exception.Create('WSACleanup');
end;

function PingHost(const HostName: AnsiString;
  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
  Startup;
  e := gethostbyname(PAnsiChar(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;
  Cleanup;
end;

end.

You can call it with a click event like this:

procedure TForm1.button1Click(Sender: TObject);
begin
  if PingHost('172.16.24.2') then
    ShowMessage('WORKED')
  else
    ShowMessage('FAILED');
end;

Remember to add the "Ping2" unit in your uses list.

I tried your unit, it was a fine version of `IcmpSendEcho` usage, thanks. — Armin Taghavizad, Apr 11 '21 at 21:25

score 3 · Answer 2 · edited May 10 '17 at 17:21

Use the Windows API.

Something like this crude translation from: https://msdn.microsoft.com/en-us/library/windows/desktop/aa366050(v=vs.85).aspx
Should do the trick.

var
  ICMPFile: THandle;
  IpAddress: ULONG;
  SendData: array[0..31] of AnsiChar;
  ReplyBuffer: PICMP_ECHO_REPLY;
  ReplySize: DWORD;
  NumResponses: DWORD;
begin
  IpAddress:= inet_addr('127.0.0.1');
  SendData := 'Data Buffer';

  IcmpFile := IcmpCreateFile;
  if IcmpFile <> INVALID_HANDLE_VALUE then
    try
      ReplySize:= SizeOf(ICMP_ECHO_REPLY) + SizeOf(SendData);
      GetMem(ReplyBuffer, ReplySize);
      try
        NumResponses := IcmpSendEcho(IcmpFile, IPAddress, @SendData, SizeOf(SendData),
                      nil, ReplyBuffer, ReplySize, 1000);
        if (NumResponses <> 0) then begin
          Writeln(Format('Received %d icmp message responses', [NumResponses]));
          Writeln('Information from the first response:');
          Writeln(Format('Received from %s', [inet_ntoa(in_addr(ReplyBuffer.Address))]));
          Writeln(Format('Data: %s', [PAnsiChar(ReplyBuffer.Data)]));
          Writeln(Format('Status = %d', [ReplyBuffer.Status]));
          WriteLn(Format('Roundtrip time = %d milliseconds',[ReplyBuffer.RoundTripTime]));
        end else begin
          WriteLn('Call to IcmpSendEcho failed');
          WriteLn(Format('IcmpSendEcho returned error: %d', [GetLastError]));
        end;
      finally
        FreeMem(ReplyBuffer);
      end;
    finally
      IcmpCloseHandle(IcmpFile);
    end
  else begin
    Writeln('Unable to open handle');
    Writeln(Format('IcmpCreateFile returned error: %d', [GetLastError]));
  end;

score 3 · Answer 3 · answered Feb 08 '19 at 12:01

Here is a Delphi unit which does the ping with a timeout:

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.

Try this one: https://stackoverflow.com/questions/37408939/delphi-cant-find-units-in-the-library-path — Michael Hutter, Aug 22 '19 at 04:57

How to ping an IP address in Delphi 10.1 without using Indy components?

3 Answers3