请问在delphi中怎样实现ping命令的功能？(10分)

zhuifeng · 2001-11-14

我的 ping程序在运行的时候报错：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 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;

TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
PingEdit: TEdit;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
hICMP: THANDLE;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
hICMPdll: HMODULE;
begin
hICMPdll := LoadLibrary('icmp.dll');
@ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll,'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
hICMP := IcmpCreateFile;
Memo1.Text := '';
Memo1.Lines.Add('目的IP地址字节数返回时间(毫秒)');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
IPOpt:TIPOptionInformation;// IP Options for packet to send
FIPAddress

WORD;
pReqData,pRevData

Char;
pIPE

IcmpEchoReply;// ICMP Echo reply buffer
FSize: DWORD;
MyString:string;
FTimeOut

WORD;
BufferSize

WORD;
begin
if PingEdit.Text <> '' then
begin
FIPAddress := inet_addr(PChar(PingEdit.Text));
FSize := 40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := 'Hello,World';
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
Memo1.Lines.Add(PChar(PingEdit.Text) + ' ' + IntToStr(pIPE^.DataSize) + ' ' +IntToStr(pIPE^.RTT));
except
Memo1.Lines.Add('Cant resolve host!');
FreeMem(pRevData);
FreeMem(pIPE);
Exit;
end;
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
end.

这个程序我在运行的时候出现错误：
*.exe raised exception class Eaccessviolation with message:
"access violation at address 00000000 ,read of address 00000000"
我设置了breakpoint，结果发现运行到这一步：
IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE, BufferSize, FTimeOut)；
也出现上述错误提示。

请教各位高手程序错在什么地方？应该怎样修改？

luyear · 2001-11-14

参考一下这个帖子：http://www.delphibbs.com/delphibbs/dispq.asp?lid=524059

iapollo · 2001-11-15

用D6吧！自带ICMP控件，且Demos目录下有例子！

zhuifeng · 2001-11-15

ping命令的程序在运行时出现错误：
*.exe raised exception class Eaccessviolation with message:
"access violation at address 00000000 ,read of address 00000000"

请问是什么原因？

chenliang_fly · 2001-11-16

发信人: strayli (stray), 信区: Delphi
标题: Delphi编程实现Ping操作
发信站: BBS 水木清华站 (Sat Oct 17 20:52:52 1998) WWW-POST

作　　张泰立　　使用过网络的用户都熟悉“Ping”这个指令，它是一个DOS下的可
执行文件，一般用
它来检查网络连接的好坏程度。其基本原理是利用TCP/IP协议包中ICMP协议中的一个功

能，即向所指定的计算机发送一个请求，收到请求的计算机返回一个应答，借此来判断
该
计算机是否在网上运行或者检查网络连接是否稳定可靠。在Ping程序执行过程中，双方
计算机所耗费的资源都很少，因此，它是一个非常实用的工具。
　　我们可以通过编程来实现“Ping”操作，对其加以改进，使之具有Windows的界面
风格，显示比DOS更加直观。
　　首先，对编程中需要的动态链接库作一简要说明：在Windows的System目录下，你
可以找到Icmp.dll文件，该动态链接库提供了ICMP协议的所有功能，我们的编程就建立
在　　对该动态链接库的调用上。
　　Icmp.dll文件内的调用函数说明如下：　　1、IcmpCreateFile 　　打开一个句
柄，通过该句柄你可以发送ICMP的请求回送报文。
　　2、IcmpCloseHandle 　　关闭你通过IcmpCreateFile函数打开的句柄。　　3、
IcmpSendEcho
　　通过你打开的句柄发送ICMP请求，在超时或应答报文接收后返回。其参数基本上和

它的帧结构一致，可参看下面的程序部分，其具体含意你可以参看有关ICMP协议的书籍
。　　初步了解了上述的三个函数后，我们就可以开始编程了。
　　首先，我们的程序运行后应该有如图1所示的基本功能。为此，我们可先在Delphi的
窗口中放入右上图中所示的控件，如按钮、编辑框和文本显示框等。
　　（G72.JPG）　　例程运行示意图　　然后，在程序的开始部分（FormCreate）
对WinSocket进行初始化，其作用是申明
使用的版本信息，同时调入Icmp.dll库。　　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;
DWORD;
　　 RequestData: Pointer; 　　 RequestSize: Word;
　　 RequestOptions: PIPOptionInformation; 　　 ReplyBuffer: Pointer;
　　 ReplySize: DWord; 　　 Timeout: DWord 　　 ): DWord; stdcall;
　　 TMyPing = class(TForm) 　　 Panel1: TPanel; 　　 Label1: TLabel;
　　 PingEdit: TEdit; 　　 ExeBtn: TButton; 　　 Button2: TButton;
　　 Button3: TButton; 　　 StatusShow: TMemo;
　　 procedure Button3Click(Sender: TObject);
　　 procedure FormCreate(Sender: TObject);
　　 procedure ExeBtnClick(Sender: TObject); 　　 private
　　 { Private declarations } 　　 hICMP: THANDLE;
　　 IcmpCreateFile : TIcmpCreateFile; 　　 IcmpCloseHandle:
TIcmpCloseHandle;
　　 IcmpSendEcho: TIcmpSendEcho; 　　 public 　　 { Public declarations }
　　end;
　　procedure TMyPing.FormCreate(Sender: TObject); 　　var 　　 WSAData:
TWSAData;
　　 hICMPdll: HMODULE; 　　begin ? 　　 // Load the icmp.dll stuff
　　 hICMPdll := LoadLibrary('icmp.dll');
　　 @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
　　 @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
　　 @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
　　 hICMP := IcmpCreateFile; 　　 StatusShow.Text := '';
　　 StatusShow.Lines.Add('目的IP地址字节数返回时间(毫秒)'); 　　end;
　　接下来，就要进行如下所示的Ping操作的实际编程过程了。
　　procedure TMyPing.ExeBtnClick(Sender: TObject); 　　var
　　 IPOpt:TIPOptionInformation;// IP Options for packet to send
　　 FIPAddress

WORD; 　　 pReqData,pRevData

Char;
　　 pIPE

IcmpEchoReply;// ICMP Echo reply buffer 　　 FSize: DWORD;
　　 MyString:string; 　　 FTimeOut

WORD; 　　 BufferSize

WORD; 　　
begin
　　 if PingEdit.Text <> '' then 　　 begin
　　 FIPAddress := inet_addr(PChar(PingEdit.Text)); 　　 FSize := 40;
　　 BufferSize := SizeOf(TICMPEchoReply) + FSize; 　　 GetMem(pRevData,FSiz
e);
　　 GetMem(pIPE,BufferSize); 　　 FillChar(pIPE^, SizeOf(pIPE^), 0);
　　 pIPE^.Data := pRevData; 　　 MyString := 'Hello,World';
　　 pReqData := PChar(MyString); 　　 FillChar(IPOpt, Sizeof(IPOpt), 0);
　　 IPOpt.TTL := 64; 　　 FTimeOut := 4000;
　　 IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),
@IPOpt, pIPE, BufferSize, FTimeOut);
　　 if pReqData^ = pIPE^.Options.OptionsData^ then 　　 begin
　　 StatusShow.Lines.Add(PChar(PingEdit.Text) + ' '
+IntToStr(pIPE^.DataSize) + ' ' +IntToStr(pIPE^.RTT)); 　　 end;
　　 FreeMem(pRevData); 　　 FreeMem(pIPE); 　　 end 　　end;
FreeMem(pRevData); 　　 FreeMem(pIPE); 　　 end 　　end;
　　通过上面的编程，我们就实现了Ping功能的界面操作。实际上，ICMP协议的功能还
有很　　多，都可以通过对Icmp.dll的函数调用来实现。

zhuifeng · 2001-11-16

这篇文章我已经看过了，我的程序基本是和他的一样的，只是
用来显示结果的方式不一样。

hcw · 2002-01-18

可是问题还是没有解决啊？！！

小虫~ · 2002-01-18

程序应该是正确的啊,检查你的icmp.dll是否正确,拷几个不同版本的dll到你的运行目录在
试试看!

arnew · 2002-01-18

procedure TForm1.Button1Click(Sender: TObject);
var
NetAddress: u_long;
hFile,ret: dword;
msg: string;
preturn: icmp_echo_reply;
begin
NetAddress := inet_addr(pchar(Edit1.text));
hFile:=IcmpCreateFile;
IF hFile = 0 then exit;
msg := 'Hello';
ret:=IcmpSendEcho(hFile,NetAddress,msg,Length(msg),0,preturn,282,200);
IcmpCloseHandle(hfile);
if ret > 0 then
showmessage('ok')
else
showmessage('fail');
end;

yhuds · 2002-01-31

用清华大学出版社的windows网络编程之delphi篇中的例子5，他的控件响音速度太慢，
我的时钟1秒1ping ,ping 2次后ping 另外一个ip地址，结果响音全乱了，我用delphi6.
有没有响应快的控件呀？一般都只要几十ms 呀！！

浪潮一号 · 2002-01-31

使用过网络的用户都熟悉“Ping”这个指令，它是一个DOS下的可执行文件，一般用它来检查网络连接的好坏程度。其基本原理是利用TCP/IP协议包中ICMP协议中的一个功能，即向所指定的计算机发送一个请求，收到请求的计算机返回一个应答，借此来判断该计算机是否在网上运行或者检查网络连接是否稳定可靠。在Ping程序执行过程中，双方计算机所耗费的资源都很少，因此，它是一个非常实用的工具。

　　我们可以通过编程来实现“Ping”操作，对其加以改进，使之具有Windows的界面风格，显示比DOS更加直观。

　　首先，对编程中需要的动态链接库作一简要说明：在Windows的System目录下，你可以找到Icmp.dll文件，该动态链接库提供了ICMP协议的所有功能，我们的编程就建立在对该动态链接库的调用上。

　　Icmp.dll文件内的调用函数说明如下：

　　1、IcmpCreateFile

　　打开一个句柄，通过该句柄你可以发送ICMP的请求回送报文。

　　2、IcmpCloseHandle

　　关闭你通过IcmpCreateFile函数打开的句柄。

　　3、IcmpSendEcho

　　通过你打开的句柄发送ICMP请求，在超时或应答报文接收后返回。其参数基本上和它的帧结构一致，可参看下面的程序部分，其具体含意你可以参看有关ICMP协议的书籍。

　　初步了解了上述的三个函数后，我们就可以开始编程了。

　　首先，我们的程序运行后应该有如图1所示的基本功能。为此，我们可先在Delphi的窗口中放入右上图中所示的控件，如按钮、编辑框和文本显示框等。

　　（G72.JPG）

　　例程运行示意图

　　然后，在程序的开始部分（FormCreate）对WinSocket进行初始化，其作用是申明使用的版本信息，同时调入Icmp.dll库。

　　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;

　　 TMyPing = class(TForm)

　　 Panel1: TPanel;

　　 Label1: TLabel;

　　 PingEdit: TEdit;

　　 ExeBtn: TButton;

　　 Button2: TButton;

　　 Button3: TButton;

　　 StatusShow: TMemo;

　　 procedure Button3Click(Sender: TObject);

　　 procedure FormCreate(Sender: TObject);

　　 procedure ExeBtnClick(Sender: TObject);

　　 private

　　 { Private declarations }

　　 hICMP: THANDLE;

　　 IcmpCreateFile : TIcmpCreateFile;

　　 IcmpCloseHandle: TIcmpCloseHandle;

　　 IcmpSendEcho: TIcmpSendEcho;

　　 public

　　 { Public declarations }

　　end;

　　procedure TMyPing.FormCreate(Sender: TObject);

　　var

　　 WSAData: TWSAData;

　　 hICMPdll: HMODULE;

　　begin

　　 WSAStartup($101, WSAData);

　　 // Load the icmp.dll stuff

　　 hICMPdll := LoadLibrary('icmp.dll');

　　 @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');

　　 @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');

　　 @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');

　　 hICMP := IcmpCreateFile;

　　 StatusShow.Text := '';

　　 StatusShow.Lines.Add('目的IP地址字节数返回时间(毫秒)');

　　end;

　　接下来，就要进行如下所示的Ping操作的实际编程过程了。

　　procedure TMyPing.ExeBtnClick(Sender: TObject);

　　var

　　 IPOpt:TIPOptionInformation;// IP Options for packet to send

　　 FIPAddress

WORD;

　　 pReqData,pRevData

Char;

　　 pIPE

IcmpEchoReply;// ICMP Echo reply buffer

　　 FSize: DWORD;

　　 MyString:string;

　　 FTimeOut

WORD;

　　 BufferSize

WORD;

　　begin

　　 if PingEdit.Text <> '' then

　　 begin

　　 FIPAddress := inet_addr(PChar(PingEdit.Text));

　　 FSize := 40;

　　 BufferSize := SizeOf(TICMPEchoReply) + FSize;

　　 GetMem(pRevData,FSize);

　　 GetMem(pIPE,BufferSize);

　　 FillChar(pIPE^, SizeOf(pIPE^), 0);

　　 pIPE^.Data := pRevData;

　　 MyString := 'Hello,World';

　　 pReqData := PChar(MyString);

　　 FillChar(IPOpt, Sizeof(IPOpt), 0);

　　 IPOpt.TTL := 64;

　　 FTimeOut := 4000;

　　 IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);

　　 if pReqData^ = pIPE^.Options.OptionsData^ then

　　 begin

　　 StatusShow.Lines.Add(PChar(PingEdit.Text) + ' ' +IntToStr(pIPE^.DataSize) + ' ' +IntToStr(pIPE^.RTT));

　　 end;

　　 FreeMem(pRevData);

　　 FreeMem(pIPE);

　　 end

　　end;

zhuifeng · 2002-06-18

接受答案了.

请问在delphi中怎样实现ping命令的功能？(10分)

zhuifeng

Unregistered / Unconfirmed

luyear

Unregistered / Unconfirmed

iapollo

Unregistered / Unconfirmed

zhuifeng

Unregistered / Unconfirmed

chenliang_fly

Unregistered / Unconfirmed

zhuifeng

Unregistered / Unconfirmed

hcw

Unregistered / Unconfirmed

小虫~

Unregistered / Unconfirmed

arnew

Unregistered / Unconfirmed

yhuds

Unregistered / Unconfirmed

浪潮一号

Unregistered / Unconfirmed

zhuifeng

Unregistered / Unconfirmed

Similar threads