www.pudn.com > ceshi.rar > ping.pas, change:2002-06-21,size:3968b


 
unit ping; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  Grids,  winsock, StdCtrls; 
 
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; 
                           RequestData: Pointer; 
                           RequestSize: Word; 
                           RequestOptions: PIPOptionInformation; 
                           ReplyBuffer: Pointer; 
                           ReplySize: DWord; 
                           Timeout: DWord): DWord; stdcall; 
 
type 
  TForm1 = class(TForm) 
    StringGrid1: TStringGrid; 
    Edit1: TEdit; 
    Button1: TButton; 
    Label1: TLabel; 
    procedure FormCreate(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private declarations } 
  hICMP: THANDLE; 
  IcmpCreateFile : TIcmpCreateFile; 
  IcmpCloseHandle:TIcmpCloseHandle; 
  IcmpSendEcho: TIcmpSendEcho; 
  line:integer; 
 
  public 
    { Public declarations } 
  hICMPdll: HMODULE; 
  end; 
 
var 
  Form1: TForm1; 
implementation 
 
{$R *.DFM} 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  hICMPdll := LoadLibrary('icmp.dll'); 
  @ICMPCreateFile:= GetProcAddress(hICMPdll, 'IcmpCreateFile'); 
  @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle'); 
  @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho'); 
  hICMP := IcmpCreateFile; 
  StringGrid1.Cells[0,0]:=' '; 
  StringGrid1.Cells[1,0]:='返回地址'; 
  StringGrid1.cells[2,0]:='返回数据包大小'; 
  StringGrid1.Cells[3,0]:='RTT(Round-Trip-Time)'; 
  line:=1; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  IPOpt:TIPOptionInformation; 
  FIPAddress:DWORD; 
  pReqData,pRevData:PChar; 
  pIPE:PIcmpEchoReply; 
  FSize: DWORD; 
  MyString:string; 
  FTimeOut:DWORD; 
  BufferSize:DWORD; 
begin 
  if Edit1.Text <> '' then 
  begin 
    FIPAddress:=inet_addr(PChar(Edit1.Text)); 
    if Fipaddress=INADDR_NONE then 
     Messagebox(self.handle,'地址无效','Ping32',64) 
    else 
    begin 
        FSize:=80; 
        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 :=500; 
        IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE, 
        BufferSize, FTimeOut); 
        try 
          try 
            if pReqData^ = pIPE^.Options.OptionsData^ then 
              with StringGrid1 do 
              begin 
                if line>1 then rowcount:=line+1; 
                cells[0,line]:=inttoStr(line); 
                cells[1,line]:=Edit1.Text; 
                cells[2,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 TForm1.FormDestroy(Sender: TObject); 
begin 
  icmpclosehandle(hicmp); 
  freelibrary(hicmpdll); 
end; 
 
end.