|
看了好多次有网友的提出关于用delphi实现ping的问题，今天又看到了；
所以就将这个功能写成一个类，并且提供一个函数方便大家的使用！
函数
procedure pinghost(ip:string;var info:string);
ip:目标ＩＰ地址；
info:ping了以后产生的信息(1)或(2)；
(1)成功信息
ip 发送测试的字符数 返回时间
(2)出错信息
Can not find host!
使用
uses ping;
procedure TForm1.Button1Click(Sender: TObject);
var
str:string;
ping:Tping;
begin
ping:=Tping.create ;//一定要初试化哦
ping.pinghost(''''127.0.0.1'''',str);
memo1.Lines.Add(str);
ping.destroy ;
end;
[ping.pas]
(*作者：e梦缘*）
unit ping;
interface
uses
Windows, SysUtils, Classes, Controls, Winsock,
StdCtrls;
type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte;
TOS: Byte;
Flags: Byte;
OptionsSize: Byte;
OptionsData: PChar;
end;
PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: DWORD;
Status: DWORD;
RTT: DWORD;
DataSize: Word;
Reserved: Word;
Data: Pointer;
Options: TIPOptionInformation;
end;
TIcmpCreateFile = function: THandle; stdcall;
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
TIcmpSendEcho = function(IcmpHandle:THandle;
DestinationAddress: DWORD;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
): DWord; stdcall;
Tping =class(Tobject)
private
{ Private declarations }
hICMP: THANDLE;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
public
procedure pinghost(ip:string;var info:string);
constructor create;
destructor destroy;override;
{ Public declarations }
end;
var
hICMPdll: HMODULE;
implementation
constructor Tping.create;
begin
inherited create;
hICMPdll := LoadLibrary(''''icmp.dll'''');
@ICMPCreateFile := GetProcAddress(hICMPdll, ''''IcmpCreateFile'''');
@IcmpCloseHandle := GetProcAddress(hICMPdll,''''IcmpCloseHandle'''');
@IcmpSendEcho := GetProcAddress(hICMPdll, ''''IcmpSendEcho'''');
hICMP := IcmpCreateFile;
end;
destructor Tping.destroy;
begin
FreeLibrary(hIcmpDll);
inherited destroy;
end;
procedure Tping.pinghost(ip:string;var info:string);
var
// IP Options for packet to send
IPOpt:TIPOptionInformation;
FIPAddress:DWORD;
pReqData,pRevData:PChar;
// ICMP Echo reply buffer
pIPE:PIcmpEchoReply;
FSize: DWORD;
MyString:string;
FTimeOut:DWORD;
BufferSize:DWORD;
begin
if ip <> '''''''' then
begin
FIPAddress := inet_addr(PChar(ip));
FSize := 40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := ''''Test Net - Sos Admin'''';
pReqData := PChar(MyString);
FillChar(IPOpt, Sizeof(IPOpt), 0);
IPOpt.TTL := 64;
FTimeOut := 4000;
try
IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE, BufferSize, FTimeOut);
if pReqData^ = pIPE^.Options.OptionsData^ then
info:=ip+ '''' '''' + IntToStr(pIPE^.DataSize) + '''' '''' +IntToStr(pIPE^.RTT);
except
info:=''''Can not find host!'''';
FreeMem(pRevData);
FreeMem(pIPE);
Exit;
end;
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
end.
[网络技术]为什么能ping通IP地址，却不能访问对方电脑 [Delphi程序]编程动动手，Ping程序“跟你走”！[原创]
[Delphi程序]我写了个 Ping 模块 很实用！ [Delphi程序]使用 ShellExecute 来进行 Ping 操作!
[Web开发]Asp.net编写的PING工具 [SyBase]Linux学习笔记－网络相关ping finger nslookup ne…
[MySql]使linux系统对ping不反应 [Sql Server]SQL Ping的工具
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
