ping代码求改

Question

小弟在网上搜索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;interfaceusesWindows, 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;implementationconstructor 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;
 用了用，发现还不错，因为我想得到到某ip的延迟，所以这个代码可以提供给我，
但是发现这代码win7下运行报错，无法使用，并且xp下有时也会有错误。请问有人用过这个代码吗？可以修改一下使其不在报错吗

Answer 1

你用的DELPHI什么版本啊，7里面的INDY控件里直接有这个PING

Answer 2

我用过，只是我用的是只要求ping得通与不通。
在不通的情况下进程偶尔会出错，但是我在程序里面控制了一下给避免了。
源码我也改动了一下，主要给它加了个容错。
和你的用法有点不一样。

Answer 3

报错是否与该系统下有无'icmp.dll'有关?  尝试拷贝该DLL至报错机器系统目录下看看

Answer 4

 有些禁止ping那你怎么检测网络呀  如何是想看哪个网站能打开就用别的方式