如何在不使用Indy组件的情况下ping Delphi 10.1中的IP地址？

Question

如何在不使用Indy组件的情况下在Delphi 10.1中ping IP地址（或按服务器名称）？ TIdICMPClient使用提升的特权，但我想以普通用户的身份进行。

Answer 1

使用Windows API。

类似于这样的粗略翻译，来源：https://msdn.microsoft.com/en-us/library/windows/desktop/aa366050(v=vs.85).aspx应该可以解决问题。

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;

Answer 2

这里是一个Delphi单元，它以超时执行ping操作：

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.

Answer 3

其他答案缺少一些内容。

这里是完成技巧的完整单元：

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.

您可以通过如下单击事件来调用它：

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

记住要在uses列表中添加“ Ping2”单元。