急求一ping程序原代码！

Question

转：    使用过网络的用户都熟悉“Ping”这个指令，它是一个DOS下的可执行文件，
一般用它来检查网络连接的好坏程度。其基本原理是利用TCP/IP协议包中ICMP协
议中的一个功能，即向所指定的计算机发送一个请求，收到请求的计算机返回一
个应答，借此来判断该计算机是否在网上运行或者检查网络连接是否稳定可靠。
在Ping程序执行过程中，双方计算机所耗费的资源都很少，因此，它是一个非常
实用的工具。  　 我们可以通过编程来实现“Ping”操作，对其加以改进，使之具有Windows的界面风格，显示比DOS更加直观。
　　首先，对编程中需要的动态链接库作一简要说明：在Windows的System目录下
，你可以找到Icmp.dll文件，该动态链接库提供了ICMP协议的所有功能，我们的
编程就建立在对该动态链接库的调用上。Icmp.dll文件内的调用函数说明如下： 
　　1、IcmpCreateFile  　　打开一个句柄，通过该句柄你可以发送ICMP的请求
回送报文。
　　2、IcmpCloseHandle  　　关闭你通过IcmpCreateFile函数打开的句柄。
　　3、IcmpSendEcho   　　通过你打开的句柄发送ICMP请求，在超时或应答报
文接收后返回。其参数基本上和它的帧结构一致，可参看下面的程序部分，其具体含意你可以参看有关ICMP协议的书籍。
  　初步了解了上述的三个函数后，我们就可以开始编程了。
　　首先，我们的程序运行后应该有如图1所示的基本功能。为此，我们可先在
Delphi的窗口中放入右上图中所示的控件，如按钮、编辑框和文本显示框等。
  　然后，在程序的开始部分（FormCreate）对WinSocket进行初始化，其作用是
申明使用的版本信息，同时调入Icmp.dll库。
  　　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:IPOptionInformation;
     　　 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 Button3Click(Sender: TObject);  　　    procedure FormCreate(Sender: TObject);
  　　    procedure ExeBtnClick(Sender: TObject);
  　　 private  　　 { Private declarations }
  　　    hICMP: THANDLE;
  　　    IcmpCreateFile : TIcmpCreateFile;
  　　    IcmpCloseHandle: TIcmpCloseHandle;
  　　    IcmpSendEcho: TIcmpSendEcho;
  　　 public  　　 { Public declarations }
  　　end;  　　
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;  　　
//接下来，就要进行如下所示的Ping操作的实际编程过程了。  　　
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,FSiz e);  　　 
  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;  　　
    通过上面的编程，我们就实现了Ping功能的界面操作。实际上，ICMP协议的功能还
有很多，都可以通过对Icmp.dll的函数调用来实现。   

Answer 1

kevin_gao大侠能说的具体点吗？我真的很急呀！而且很菜，还不是菜鸟而是比菜鸟还菜的菜蛋！

Answer 2

unit PingTst1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Ping, StdCtrls;type
  TPingTstForm = class(TForm)
    Ping1: TPing;
    Label1: TLabel;
    HostEdit: TEdit;
    PingButton: TButton;
    DisplayMemo: TMemo;
    CancelButton: TButton;
    procedure PingButtonClick(Sender: TObject);
    procedure Ping1Display(Sender: TObject; Icmp: TObject; Msg: String);
    procedure Ping1DnsLookupDone(Sender: TObject; Error: Word);
    procedure CancelButtonClick(Sender: TObject);
    procedure Ping1EchoRequest(Sender: TObject; Icmp: TObject);
    procedure Ping1EchoReply(Sender: TObject; Icmp: TObject; Error: Integer);
  private
    { D閏larations priv閑s }
  public
    { D閏larations publiques }
  end;var
  PingTstForm: TPingTstForm;implementation{$R *.DFM}{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPingTstForm.PingButtonClick(Sender: TObject);
begin
    DisplayMemo.Clear;
    DisplayMemo.Lines.Add('Resolving host ''' + HostEdit.Text + '''');
    PingButton.Enabled   := FALSE;
    CancelButton.Enabled := TRUE;
    Ping1.DnsLookup(HostEdit.Text);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPingTstForm.Ping1DnsLookupDone(Sender: TObject; Error: Word);
begin
    CancelButton.Enabled := FALSE;
    PingButton.Enabled   := TRUE;    if Error <> 0 then begin
        DisplayMemo.Lines.Add('Unknown Host ''' + HostEdit.Text + '''');
        Exit;
    end;    DisplayMemo.Lines.Add('Host ''' + HostEdit.Text + ''' is ' + Ping1.DnsResult);
    Ping1.Address := Ping1.DnsResult;
    Ping1.Ping;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPingTstForm.Ping1Display(Sender: TObject; Icmp: TObject; Msg: String);
begin
    DisplayMemo.Lines.Add(Msg);
end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPingTstForm.CancelButtonClick(Sender: TObject);
begin
    Ping1.CancelDnsLookup;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPingTstForm.Ping1EchoRequest(Sender: TObject; Icmp: TObject);
begin
    DisplayMemo.Lines.Add('Sending ' + IntToStr(Ping1.Size) + ' bytes to ' +
                          Ping1.HostName + ' (' + Ping1.HostIP + ')');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TPingTstForm.Ping1EchoReply(Sender: TObject; Icmp: TObject; Error: Integer);
begin
    if Error = 0 then
        DisplayMemo.Lines.Add('Cannot ping host (' + Ping1.HostIP + ') : ' +
                              Ping1.ErrorString)
    else
        DisplayMemo.Lines.Add('Received ' + IntToStr(Ping1.Reply.DataSize) +
                              ' bytes from ' + Ping1.HostIP +
                              ' in ' + IntToStr(Ping1.Reply.RTT) + ' msecs');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}end.

Answer 3

老大，你有TPING吗？在什么地方找的？

Answer 4

如果你是Delphi6请看这里：
C:\Program Files\Borland\Delphi6\Demos\Indy\PingGUI