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

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.

3 Answers

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.

Use the Windows API.

Something like this crude translation from: (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;

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.