在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)；
也出现上述错误提示。

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

DelphiFish · 2001-11-14

ics里面有个ping的控件，你可以参考一下原码

sword_liu · 2001-11-14

我看你的源码，好像是《delphi案例分析》上的，你可能是抄错了吧。

zhuifeng · 2001-11-14

我也搞不清楚，原码是别人给我的，
ics 是什么东东，不好意思，我是新手，没听过。
《delphi案例分析》在什么地方可以看到？

zhuifeng · 2001-11-15

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

请问是什么原因？

忧郁骑士 · 2001-11-16

你的代码我没有细看，不过看到出错信息第一感觉就是你试图去访问没有分配内存的
一段内存空间，就类似于一个类你还没有create出来你就去用它了，不知道对不对，
仅供参考。

jqw · 2001-11-16

win9.x or 2k?

daxia003 · 2001-11-16

有一种简单的办法是将命令写到文件中比如:myping.bat
然后在程序中让这个程序运行!!
一般DOS中的命令都能用的!!
就是这个方法太简单了点

llwu · 2001-11-16

　　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;

chur · 2001-11-16

你可以在 http://www.rtfm.be/fpiette/indexuk.htm下
载 Internet Component Suite，这是个免费的 Internet控件包，包括 Ping功能，并提供
了全部源程序。

zhuifeng · 2001-11-16

我的机子是win2k。不过不应该是操作系统的问题，。

gongjin21 · 2001-11-25

还是用Delphi6自带的ping程序吧，可以ping域名和IP。很好用的！
有现成的不用，何必重复这些工作呢。
在/Demos/Indy/PingGUI

samxu · 2001-11-25

我试了你的程序，在2000下是对的，没有出错信息。

痞子兵 · 2001-11-25

调用API函数ICMP？

zhuifeng · 2001-12-12

我的机子是win2k server ，
to samxu：在你的机子上是好的吗？怎么在我的机子上就不行呢？

zhuifeng · 2001-12-12

to chur:你给的网址我找不到ics 啊。另外这个网站是什么文的，我看不懂

cgh0717 · 2001-12-12

天哪！好像这么一点点就可以了：
unit Mains;

interface

uses
Windows, Forms, winsock, StdCtrls, Classes,
Sysutils,Controls, ComCtrls, Buttons, Dialogs;

type
PIPOptionInformation= ^TIPOptionInformation;
TIPOptionInformation=packed record
TTL : Byte;
Tos : byte;
Flags : byte;
OptionsSize : Byte;
OptionsData : PChar;
end;

PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply=packed record
Address

Word;
Status

Word;
RTT : DWord;
DataSize:word;
Reserved:word;
Data

ointer;
Options : TIPOptionInformation;
end;

TIcmpCreateFile = function:THandle;stdcall;
TIcmpCloseHandle = function(IcmpHandle:THandle):Boolean;stdcall;

TIcmpSendEcho=function(Icmphandle:THandle;destinationAddress:dword;
RequestData

ointer; RequestSize:word;
RequestOptions

IPOptionInformation;
ReplyBuffer

ointer;ReplySize

word; TimeOut

word)

Word;stdcall;

TMainScreen = class(TForm)
StatusShow: TStatusBar;
BitBtn1: TBitBtn;
PingEdit: TEdit;
Label1: TLabel;
StatusText: TMemo;
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);

private

HIcmp : THandle;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
ICmpSendEcho : TIcmpSendEcho;
hIcmpDll : HModule; // Load the icmp.dll stuff

public

end;

var
MainScreen : TMainScreen;

implementation

{$R *.dfm}

procedure TMainScreen.FormCreate(Sender: TObject);
var
WSAData : TWSAData;
begin
hICMPdll := LoadLibrary('Icmp.dll');
@ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
hICMP := IcmpCreateFile;
StatusShow.Panels[1].Text := '';
StatusShow.Panels[1].Text := '目的IP地址字节数返回时间(毫秒)';
//接下来，就要进行如下所示的Ping操作的实际编程过程了。
StatusText.Lines.Clear;
end;

procedure TMainScreen.BitBtn1Click(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;
i : Integer;
begin

StatusText.Text := '';

if PingEdit.Text<>'' then
begin
try
FIPAddress := inet_addr(PChar(PingEdit.Text));
FSize := 200;
BufferSize := SizeOf(TICMPEchoReply) + FSize;

GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := 'Hello,World,dddddddddddddddddddd'
+ 'dddddddddddddddddddddddddddddddd';

pReqData := PChar(MyString);
FillChar(IPOpt, Sizeof(IPOpt), 0);
IPOpt.TTL := 64;
FTimeOut := 4000;
try
for I := 0 to 4 do
begin
IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),
@IPOpt, pIPE, BufferSize, FTimeOut);
if pReqData^ = pIPE^.Options.OptionsData^ then
begin
StatusText.Lines.Add(
'Replay from ' + PChar(PingEdit.Text) + ' : bytes=' +
IntToStr(pIPE^.DataSize) + ' timeout=' + Trim(Format('%8.0f',[FTimeOut/1000])) +
'ms RTT='+IntToStr(pIPE^.RTT));
end;
end;
except
MessageDlg('Host is not existing.', mtConfirmation,[mbok],0);
end;
finally
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
end;

procedure TMainScreen.FormDestroy(Sender: TObject);
begin
FreeLibrary(hIcmpDll);
end;

end.

zhuifeng · 2002-06-18

接受答案了.

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

zhuifeng

Unregistered / Unconfirmed

DelphiFish

Unregistered / Unconfirmed

sword_liu

Unregistered / Unconfirmed

zhuifeng

Unregistered / Unconfirmed

zhuifeng

Unregistered / Unconfirmed

忧郁骑士

Unregistered / Unconfirmed

jqw

Unregistered / Unconfirmed

daxia003

Unregistered / Unconfirmed

llwu

Unregistered / Unconfirmed

chur

Unregistered / Unconfirmed

zhuifeng

Unregistered / Unconfirmed

gongjin21

Unregistered / Unconfirmed

samxu

Unregistered / Unconfirmed

痞子兵

Unregistered / Unconfirmed

zhuifeng

Unregistered / Unconfirmed

zhuifeng

Unregistered / Unconfirmed

cgh0717

Unregistered / Unconfirmed

zhuifeng

Unregistered / Unconfirmed

Similar threads