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:IPOptionInformation;
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: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,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;
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:IPOptionInformation;
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: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,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;
在ping之前﹐設一個標志﹐標志為真時繼續執行。并調用ProcessMessages函數或將ping的函數另建一個線程。
如果將ping的函數另建一個線程的話﹐你也可以不設標志而在按下按鈕的時候將此ping的線程Kill掉....