unit ping;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,winsock,
StdCtrls, Grids;
type
PIPOptionInformation=^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte;
TOS: Byte;
Flags: Byte;
OptionsSize: Byte;
OptionsData: PChar;
end;
type 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;RequestDa
ta: Pointer;RequestSize: Word;RequestOptions: PIPOptionInformation;ReplyBuffer
: Pointer;ReplySize: DWord;Timeout: DWord): DWord; stdcall;
type
Tfrmping = class(TForm)
echogrid: TStringGrid;
ipaddr: TEdit;
Label1: TLabel;
ping: TButton;
procedure FormCreate(Sender: TObject);
procedure pingClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
hICMP: THANDLE;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
line:integer;
{ Private declarations }
public
hICMPdll: HMODULE;{ Public declarations }
end;
var
frmping: Tfrmping;
implementation
{$R *.DFM}
procedure Tfrmping.FormCreate(Sender: TObject);
begin
hICMPdll := LoadLibrary('icmp.dll');
@ICMPCreateFile:= GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
hICMP := IcmpCreateFile;
echogrid.Cells[0,0]:='返回地址';
echogrid.cells[1,0]:='返回数据包大小';
echogrid.Cells[2,0]:='状态';
echogrid.Cells[3,0]:='RTT(Round-Trip-Time)';
line:=1;
end;
procedure Tfrmping.pingClick(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 iPaddr.Text <> '' then
begin
FIPAddress:=inet_addr(PChar(ipaddr.Text));
if Fipaddress=INADDR_NONE then Messagebox(self.handle,'地址无效
','Ping32',64)
else
begin
FSize:=40;
BufferSize:=SizeOf(TICMPEchoReply)+FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := 'Argen Ping32 Sending Message.';
pReqData := PChar(MyString);
FillChar(IPOpt, Sizeof(IPOpt), 0);
IPOpt.TTL:= 64;
FTimeOut :=10000;
IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE,
BufferSize, FTimeOut);
try
try
if pReqData^ = pIPE^.Options.OptionsData^ then
with echogrid do
begin
if line>1 then rowcount:=line+1;
cells[0,line]:=ipaddr.Text;
cells[1,line]:=inttoStr(pIPE^.DataSize);
cells[3,line]:=IntToStr(pIPE^.RTT);
row:=rowcount-1;
line:=line+1;
end;
except
Messagebox(self.handle,'目标不可到','Ping32',64)
end;
finally
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
end;
end;
procedure Tfrmping.FormDestroy(Sender: TObject);
begin
icmpclosehandle(hicmp);
freelibrary(hicmpdll);
end;
end.