Delphi 版的 Ping

uses IdIcmpClient;

{ Delphi 版的 Ping }
function DPingIP(const strIP: string; const intLinkTimeOut: Integer): Boolean;
var
  icmp: TIdIcmpClient;
  rpss: TReplyStatus;
begin
  icmp := TIdIcmpClient.Create(nil);
  try
    icmp.Host           := strIP;
    icmp.ReceiveTimeout := intLinkTimeOut;
    try
      icmp.Ping;
      rpss   := icmp.ReplyStatus;
      Result := not(rpss.ReplyStatusType = rsTimeOut);
    except
      Result := False;
    end;
  finally
    icmp.Free;
  end;
end;

补充：
  2019-08-15
  经在实际项目中使用发现，此函数存在问题。
  当网络中有多个网段时，也就是跨网段(这在实际项目中，比较常见)。
  或者虚拟机中，此函数返回 IP 不存在，但用 Windows 的 Ping 是可以通过的。
  看来还是老老实实用 Windows 的 Ping 吧。
  调用 Windows 下的 Ping 命令，根据返回结果是否包含 “请求超时”，来确认 IP 是否存在。
  函数如下：

type
  TShowMethod = procedure(str: string) of object;

function RunDosCommand(const cmd: string; CallBackShowRealMessage: TShowMethod = nil): string;
var
  hReadPipe, hWritePipe: THandle;
  si                   : STARTUPINFO;
  lsa                  : SECURITY_ATTRIBUTES;
  pi                   : PROCESS_INFORMATION;
  cchReadBuffer        : DWORD;
  pOutStr              : PAnsiChar;
  res, strCMD          : string;
begin
  strCMD                   := 'cmd.exe /k ' + cmd;
  pOutStr                  := AllocMem(5000);
  lsa.nLength              := SizeOf(SECURITY_ATTRIBUTES);
  lsa.lpSecurityDescriptor := nil;
  lsa.bInheritHandle       := True;
  if not CreatePipe(hReadPipe, hWritePipe, @lsa, 0) then
    Exit;

  FillChar(si, SizeOf(STARTUPINFO), 0);
  si.cb          := SizeOf(STARTUPINFO);
  si.dwFlags     := (STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);
  si.wShowWindow := SW_HIDE;
  si.hStdOutput  := hWritePipe;

  if not CreateProcess(nil, PChar(strCMD), nil, nil, True, 0, nil, nil, si, pi) then
    Exit;

  while (True) do
  begin
    if not PeekNamedPipe(hReadPipe, pOutStr, 1, @cchReadBuffer, nil, nil) then
      Break;

    if cchReadBuffer <> 0 then
    begin
      if not ReadFile(hReadPipe, pOutStr^, 4096, cchReadBuffer, nil) then
        Break;

      pOutStr[cchReadBuffer] := chr(0);
      if @CallBackShowRealMessage <> nil then
        CallBackShowRealMessage(string(pOutStr));
      res := res + String(pOutStr);
    end
    else if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) then
      Break;

    Sleep(10);

    Application.ProcessMessages;
  end;
  pOutStr[cchReadBuffer] := chr(0);

  CloseHandle(hReadPipe);
  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(hWritePipe);
  FreeMem(pOutStr);
  Result := res;
end;

function DPingIP(const strIP: string): Boolean;
var
  strResult: String;
begin
  strResult := RunDosCommand('ping ' + strIP, nil);
  Result    := Pos('请求超时', strResult) = 0;
end;

你也可以声明 TShowMethod 回调过程，将 Ping 的实时返回消息输出到 Memo 中。
 

程序员就应该和测试美眉搞好关系。
我要换位置，和测试美眉做在一起。

哈哈哈。