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.

Hug

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 – Kenon

@Remy It must take a lot of guts to respond calmly to someone who doesn't want to use your pride and joy :-/ – Pantheon

@JerryDodge I'm well aware that TIdIcmpClient only works with admin rights, and it is not uncommon to want to ping without them. – Kenon

@Remy, why does Indy require elevated privileges for pinging? – Fellow

@Fellow 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. – Kenon

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/ – Isogamete

Answer 1

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.

Myalgia

I tried your unit, it was a fine version of IcmpSendEcho usage, thanks. – Creek

Answer 2

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;

Fellow

Answer 3

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.

Hierophant

How can I solve this error: F2613 Unit 'Sockets' not found. – Espinal

Try this one: #37409439 – Hierophant

'Sockets' is not required in the uses clause (at least it isn't in Delphi 10.2). Try deleting it and recompiling. – Rosinski