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

  • 主题发起人 主题发起人 zhuifeng
  • 开始时间 开始时间
Z

zhuifeng

Unregistered / Unconfirmed
GUEST, unregistred user!
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:DWORD;
pReqData,pRevData:PChar;
pIPE:PIcmpEchoReply;// ICMP Echo reply buffer
FSize: DWORD;
MyString:string;
FTimeOut:DWORD;
BufferSize:DWORD;
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)；
也出现上述错误提示。

请教各位高手程序错在什么地方？应该怎样修改？
 
ics里面有个ping的控件，你可以参考一下原码
 
我看你的源码，好像是《delphi案例分析》上的，你可能是抄错了吧。
 
我也搞不清楚，原码是别人给我的，
ics 是什么东东 ，不好意思，我是新手，没听过。
《delphi案例分析》在什么地方可以看到？
 
这个程序我在运行的时候出现错误：
*.exe raised exception class Eaccessviolation with message:
"access violation at address 00000000 ,read of address 00000000"

请问是什么原因？
 
你的代码我没有细看，不过看到出错信息第一感觉就是你试图去访问没有分配内存的
一段内存空间，就类似于一个类你还没有create出来你就去用它了，不知道对不对，
仅供参考。
 
win9.x or 2k?
 
有一种简单的办法是将命令写到文件中比如:myping.bat
然后在程序中让这个程序运行!!
一般DOS中的命令都能用的!!
就是这个方法太简单了点

 
　　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:DWORD;

　　 pReqData,pRevData:PChar;

　　 pIPE:PIcmpEchoReply;// ICMP Echo reply buffer

　　 FSize: DWORD;

　　 MyString:string;

　　 FTimeOut:DWORD;

　　 BufferSize:DWORD;

　　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;
 
你 可 以 在 http://www.rtfm.be/fpiette/indexuk.htm下
载 Internet Component Suite， 这 是 个 免 费 的 Internet控 件 包 ， 包 括 Ping功 能 ， 并 提 供
了 全 部 源 程 序 。
 
我的机子是win2k。不过不应该是操作系统的问题，。

 
还是用Delphi6自带的ping程序吧，可以ping域名和IP。很好用的！
有现成的不用，何必重复这些工作呢。
在/Demos/Indy/PingGUI
 
我试了你的程序，在2000下是对的，没有出错信息。
 
调用API函数ICMP？
 
我的机子是win2k server ，
to samxu：在你的机子上是好的吗？怎么在我的机子上就不行呢？
 
to chur:你给的网址 我找不到ics 啊。另外这个网站是什么文的，我看不懂
 
天哪！好像这么一点点就可以了：
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: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;

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:DWORD;
pReqData,pRevData:PChar;
pIPE:PIcmpEchoReply;// ICMP Echo reply buffer 　　
FSize: DWORD;
MyString:string;
FTimeOut:DWORD;
BufferSize:DWORD;
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.
 
接受答案了.
 
您必须登录或注册才可回复。

Similar threads

Z
请问在delphi中怎样实现ping命令的功能？(10分)
回复
11
查看
148
zhuifeng
Z
G
这段代码为何不能ping通由sygate代理出去的ip????????????????????????(100分)
回复
9
查看
774
wjiachun
W
J
在w2k和NT中，怎样实现对口地址的读写？类似c语言的outportb功能(100分)
回复
7
查看
209
janestory
J
Z
在delphi中怎样实现 ping 命令的功能？(50分)
回复
5
查看
466
zhuifeng
Z
P
用Dos的“net time //218.17.xx.xx”这个命令得到主机的时间，在Delphi中怎样实现! (100分)
回复
7
查看
260
paf
P
后退
顶部