Delphi 版的 Ping

uses IdIcmpClient;{ Delphi 版的 Ping }
function DPingIP(const strIP: string; const intLinkTimeOut: Integer): Boolean;
varicmp: TIdIcmpClient;rpss: TReplyStatus;
beginicmp := TIdIcmpClient.Create(nil);tryicmp.Host           := strIP;icmp.ReceiveTimeout := intLinkTimeOut;tryicmp.Ping;rpss   := icmp.ReplyStatus;Result := not(rpss.ReplyStatusType = rsTimeOut);exceptResult := False;end;finallyicmp.Free;end;
end;

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

typeTShowMethod = procedure(str: string) of object;function RunDosCommand(const cmd: string; CallBackShowRealMessage: TShowMethod = nil): string;
varhReadPipe, hWritePipe: THandle;si                   : STARTUPINFO;lsa                  : SECURITY_ATTRIBUTES;pi                   : PROCESS_INFORMATION;cchReadBuffer        : DWORD;pOutStr              : PAnsiChar;res, strCMD          : string;
beginstrCMD                   := '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) thenExit;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) thenExit;while (True) dobeginif not PeekNamedPipe(hReadPipe, pOutStr, 1, @cchReadBuffer, nil, nil) thenBreak;if cchReadBuffer <> 0 thenbeginif not ReadFile(hReadPipe, pOutStr^, 4096, cchReadBuffer, nil) thenBreak;pOutStr[cchReadBuffer] := chr(0);if @CallBackShowRealMessage <> nil thenCallBackShowRealMessage(string(pOutStr));res := res + String(pOutStr);endelse if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) thenBreak;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;
varstrResult: String;
beginstrResult := RunDosCommand('ping ' + strIP, nil);Result    := Pos('请求超时', strResult) = 0;
end;

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

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

哈哈哈。

Delphi 版的 Ping相关推荐

通过崩溃地址找错误行数之Delphi版
通过崩溃地址找错误行数之Delphi版 2009-5-11 17:42:35 来源: 转载作者:网络访问:360 次被顶:2 次字号:[大中小] 核心提示:什么是 MAP 文件?简单地讲, ...
从内存中加载DLL Delphi版(转)
源:从内存中加载DLL DELPHI版原文 : http://www.2ccc.com/article.asp?articleid=5784 MemLibrary.pas //从内存中加载DLL D ...
WinAPI【远程注入】利用远程线程注入DLLDelphi版
{ WinAPI[远程注入]利用远程线程注入DLLDelphi版} (okwary) 小叹的学习园地 ( SDK文档里是这样描述的:进程是一个正在运行的程序,它拥有自己的地址空间,拥有自己的 ...
Delphi 版的IIF函数
Delphi 版的IIF函数不少编程语言都有 IIF 函数,我们也可以构造自己的IIF函数: // ------------------------------------------------- ...
NeHe的OpenGL教程7（Bang翻译Delphi版）－如何使用光源
NeHe的OpenGL教程7(Bang翻译Delphi版)-如何使用光源在这一课里,我将教会你如何用光源照亮立方体的六个面,如下图: 将下图放在应用程序data目录下,起名NeHe.bmp prog ...
NeHe的OpenGL教程8（Bang翻译Delphi版）－如何制作立体透明效果
NeHe的OpenGL教程8(Bang翻译Delphi版)-如何制作立体透明效果在这一课里,我将教会你如何制作立体透明效果,如下图: 将下图放在应用程序data目录下,起名NeHe.bmp prog ...
OpenGL教程8（Bang翻译Delphi版）－如何制作立体透明效果 .
OpenGL教程8(Bang翻译Delphi版)-如何制作立体透明效果在这一课里,我将教会你如何制作立体透明效果,如下图: 将下图放在应用程序data目录下,起名NeHe.bmp program l ...
Delphi 版 everything、光速搜索代码
近日没啥事情,研究了一下 everything.光速搜索原理.花了一个礼拜时间,终于搞定. 废话不多说,直接上代码: unit uMFTSearchFile; {dbyoung@sina.com201 ...
《Delphi 版 everything、光速搜索代码》关于获取文件全路径 GetFullFileName 函数的优化
<Delphi 版 everything.光速搜索代码>,文章中关于获取文件全路径的函数:GetFullFileName,有一个地方值得优化. 就是有多个文件,它们可能属于同一个目录. 譬 ...

Delphi 版的 Ping

Delphi 版的 Ping相关推荐

最新文章

热门文章