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地址                            字節(jié)數(shù)             返回時間（毫秒         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.