ping 程序

>>ping 程序
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, winsock;

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: PIPOptionInformation;
                  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 FormCreate(Sender: TObject);
    procedure ExeBtnClick(Sender: TObject);
  private
    { Private declarations }
    hICMP: THANDLE;
    IcmpCreateFile : TIcmpCreateFile;
    IcmpCloseHandle: TIcmpCloseHandle;
    IcmpSendEcho: TIcmpSendEcho; 
  public
    { Public declarations }
  end;


var
  MyPing: TMyPing;

implementation

{$R *.DFM}

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;

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,FSize);
          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;