如何在Delphi 10.1中不使用Indy组件ping一个IP地址？

Question

如何在Delphi 10.1中ping一个IP地址(或服务器名称)而不使用Indy组件？TIdICMPClient需要高级权限才能使用，但我想以普通用户的身份执行。

- ssh

---

你只能ping一个IP地址，如果你有一个主机名，那么你必须通过DNS解析IP。一旦你有了一个IP地址，在Windows上你可以使用IcmpSendEcho()。在OSX上，也许还有Linux上，你可以使用UDP套接字发送/接收ICMP回显数据包而不需要管理员权限。 - Remy Lebeau

@Remy 必须要有很大的勇气才能平静地回应那些不想使用你的骄傲和喜悦的人 :-/ - Jerry Dodge

@JerryDodge 我很清楚 TIdIcmpClient 只能在管理员权限下工作，而且想要在没有管理员权限的情况下进行ping操作并不罕见。 - Remy Lebeau

@Remy，为什么使用Indy进行ping操作需要提升权限？ - Johan

因为Indy使用原始套接字（RAW socket）手动实现ICMP，而现代操作系统中使用原始套接字需要管理员权限。当编写TIdIcmpClient时，Windows是唯一支持的操作系统，而微软还没有限制使用原始套接字。 - Remy Lebeau

几年前，我使用 WMI 和 Delphi 编写了一个 ping 方法。请尝试访问 https://theroadtodelphi.com/2011/02/02/making-a-ping-with-delphi-and-the-wmi/。 - RRUZ

Answer 1

其他答案中有一些遗漏的地方。

这里是一个完整的单元，可以完成这个任务：

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"单元。

- Adriaan Greybe

---

我尝试了你的单元，这是一个很好的 IcmpSendEcho 使用版本，谢谢。 - Armin Taghavizad

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.

- Michael Hutter

---

我该如何解决这个错误：F2613 找不到单元“Sockets”。 - Yousef Albakoush

试试这个：https://dev59.com/fJffa4cB1Zd3GeqP6lpj - Michael Hutter

Answer 3

使用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;

- Johan