📄 unit1.pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,winsock, Buttons;
type
PIPOptionInformation=^TIPOptionInformation;
TIPOptionInformation=packed record
TTL:Byte;
TOS:Byte;
Flags:Byte;
OptionSize: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)
StatusShow: TMemo;
Panel1: TPanel;
Panel2: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
SpeedButton4: TSpeedButton;
PingEdit: TEdit;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
ExeBtn: TButton;
Edit4: TEdit;
Edit5: TEdit;
Edit7: TEdit;
BitBtn1: TBitBtn;
SpeedButton1: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton2: TSpeedButton;
BitBtn3: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure ExeBtnClick(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
hICMP:THANDLE;
IcmpCreateFile:TIcmpCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho:TIcmpSendEcho;
public
{ Public declarations }
end;
// function RegisterServiceProcess(dwProcessID, dwType: DWord) : DWord;
// stdcall; external 'user32.dll' Name 'RegisterServicesProcess';
var
MyPing: TMyPing;
PingTestStr:String;
implementation
uses Unit2;
{$R *.DFM}
procedure TMyPing.FormCreate(Sender: TObject);
Var
WSAData:TWSAData;
hICMPdll:HMODULE;
wVersionRequested:Word;
begin
wVersionRequested:=MAKEWORD(2,0);
if WSAStartup(wVersionRequested,WSAdata)=0 then
begin
hICMPdll:=LoadLibrary('icmp.dll');
@ICMPCreateFile:=GetProcAddress(hICMPdll,'IcmpCreateFile');
@IcmpCloseHandle:=GetProcAddress(hICMPdll,'IcmpCloseHandle');
@IcmpSendEcho:=GetProcAddress(hICMPdll,'IcmpSendEcho');
hICMP:=IcmpCreateFile;
StatusShow.Text:='';
StatusShow.Lines.Add('目的IP地址 字节数 返回时间(毫秒 TTL Address');
end;
PingTestStr:='%测试报文%';
end;
procedure TMyPing.ExeBtnClick(Sender: TObject);
Var
IPOpt:TIPOptionInformation;
FIPAddress:DWORD;
pReqData,pRevData:PChar;
pIPE:PIcmpEchoReply;
MyString:string;
FTimeOut:DWORD;
BufferSize,FSize:DWORD;
I:integer;
Hour, Min, Sec, MSec: 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:=PingTestStr;
pReqData:=PChar(MyString);
FillChar(IPOpt,Sizeof(IPOpt),0);
IPOpt.TTL:=StrToInt(Edit4.text);
FTimeOut:=StrToInt(Edit5.text);
Edit2.Text:=TimeToStr(Time);
For I:=1 to StrToInt(Edit1.Text) do
begin
IcmpSendEcho(hICMP,FIPAddress,pReqData,Length(MyString),
@IPOpt,pIPE,BufferSize,FTimeOut);
end;
Edit3.Text:=TimeToStr(Time);
Edit7.Text:=TimeToStr(StrToTime(Edit3.text)-StrToTime(Edit2.text));
DecodeTime(StrToTime(Edit7.Text),Hour, Min, Sec, MSec);
Edit7.Text:=IntToStr(Sec);
if pIPE^.RTT=0 then pIPE^.RTT:=1;
if pIPE^.RTT<FTimeOut then
StatusShow.Lines.Add(MyString
+' 从'+PChar(PingEdit.Text)
+' 返回'+IntToStr(pIPE^.DataSize)+'bytes;'
+'返回 <'+IntToStr(pIPE^.RTT)+'毫秒;'
+'TTL: '+IntToStr(pIPE^.Options.TTL)+';'
+'Address: '+IntToStr(pIPE^.Address))
else
StatusShow.Lines.Add(MyString
+'从'+PChar(PingEdit.Text)
+' 返回超时失败');
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
procedure TMyPing.BitBtn2Click(Sender: TObject);
Var
IPOpt:TIPOptionInformation;
FIPAddress:DWORD;
pReqData,pRevData:PChar;
pIPE:PIcmpEchoReply;
MyString:string;
FTimeOut:DWORD;
BufferSize,FSize:DWORD;
Hour, Min, Sec, MSec: 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:=PingTestStr;
pReqData:=PChar(MyString);
FillChar(IPOpt,Sizeof(IPOpt),0);
IPOpt.TTL:=StrToInt(Edit4.text);
FTimeOut:=StrToInt(Edit5.text);
Edit2.Text:=TimeToStr(Time);
Repeat
Application.ProcessMessages;
IcmpSendEcho(hICMP,FIPAddress,pReqData,Length(MyString),
@IPOpt,pIPE,BufferSize,FTimeOut);
until SpeedButton3.Down=True;
Edit3.Text:=TimeToStr(Time);
Edit7.Text:=TimeToStr(StrToTime(Edit3.text)-StrToTime(Edit2.text));
DecodeTime(StrToTime(Edit7.Text),Hour, Min, Sec, MSec);
Edit7.Text:=IntToStr(Sec);
if pIPE^.RTT=0 then pIPE^.RTT:=1;
if pIPE^.RTT<FTimeOut then
StatusShow.Lines.Add(MyString
+' 从'+PChar(PingEdit.Text)
+' 返回'+IntToStr(pIPE^.DataSize)+'bytes;'
+'返回 <'+IntToStr(pIPE^.RTT)+'毫秒;'
+'TTL: '+IntToStr(pIPE^.Options.TTL)+';'
+'Address: '+IntToStr(pIPE^.Address))
else
StatusShow.Lines.Add(MyString
+'从'+PChar(PingEdit.Text)
+' 返回超时失败');
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
procedure TMyPing.BitBtn3Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TMyPing.SpeedButton2Click(Sender: TObject);
Var
IPOpt:TIPOptionInformation;
FIPAddress:DWORD;
pReqData,pRevData:PChar;
pIPE:PIcmpEchoReply;
MyString:string;
FTimeOut:DWORD;
BufferSize,FSize:DWORD;
Hour, Min, Sec, MSec: Word;
begin
MyPing.Visible:=False;
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:='%测试报文%';
pReqData:=PChar(MyString);
FillChar(IPOpt,Sizeof(IPOpt),0);
IPOpt.TTL:=StrToInt(Edit4.text);
FTimeOut:=StrToInt(Edit5.text);
Edit2.Text:=TimeToStr(Time);
Repeat
IcmpSendEcho(hICMP,FIPAddress,pReqData,Length(MyString),
@IPOpt,pIPE,BufferSize,FTimeOut);
until SpeedButton3.Down=True;
Edit3.Text:=TimeToStr(Time);
Edit7.Text:=TimeToStr(StrToTime(Edit3.text)-StrToTime(Edit2.text));
DecodeTime(StrToTime(Edit7.Text),Hour, Min, Sec, MSec);
Edit7.Text:=IntToStr(Sec);
if pIPE^.RTT=0 then pIPE^.RTT:=1;
if pIPE^.RTT<FTimeOut then
StatusShow.Lines.Add(MyString
+' 从'+PChar(PingEdit.Text)
+' 返回'+IntToStr(pIPE^.DataSize)+'bytes;'
+'返回 <'+IntToStr(pIPE^.RTT)+'毫秒;'
+'TTL: '+IntToStr(pIPE^.Options.TTL)+';'
+'Address: '+IntToStr(pIPE^.Address))
else
StatusShow.Lines.Add(MyString
+'从'+PChar(PingEdit.Text)
+' 返回超时失败');
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
procedure TMyPing.SpeedButton4Click(Sender: TObject);
begin
PingTestStr:=InputBox('*Ping 测试*', '请输入测试报文字符:(字符不宜太长)', ' % 泉珂测试信息 % ');
end;
procedure TMyPing.FormShow(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_HIDE);
ShowWindowAsync(Application.Handle, SW_HIDE);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -