Delphi实现PING功能

ping

有些时候需要写个自己的ping工具,可以参考以下代码。


unit PING;  
interface  
  
uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,  
  IdIcmpClient;  
  
type  
  TForm1 = class(TForm)  
    Button1: TButton;  
    Edit1: TEdit;  
    Label1: TLabel;  
    Memo1: TMemo;  
    IdIcmpClient1: TIdIcmpClient;  
    procedure Button1Click(Sender: TObject);  
    procedure IdIcmpClient1Reply(ASender: TComponent;  
      const AReplyStatus: TReplyStatus);  
  private  
    { Private declarations }  
  public  
    { Public declarations }  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.Button1Click(Sender: TObject);  
var  
  i : Integer;  
begin  
  Memo1.Lines.Clear;  
  IdIcmpClient1.Host:=   Edit1.Text;   //计算机的名称或IP地址  
  IdIcmpClient1.ReceiveTimeout:=1000;   //最大超时时间  
  Button1.Enabled   :=   false;     
  try  
    for   i:=0   to   13   do  
    begin  
      IdIcmpClient1.Ping;  
       Application.ProcessMessages   ;   //延时  
    end;  
   finally  
     Button1.Enabled   :=   true;     
   end;  
  
end;  
  
procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;  
  const AReplyStatus: TReplyStatus);  
var     
    sTime:   string;  
  begin     
    //检测Ping的回复错误     
    if   (AReplyStatus.MsRoundTripTime   =   0   )   then     
        sTime   :=   '<1'     
    else     
        sTime   :=   '=';     
    //在列表框中显示Ping消息     
    Memo1.Lines.Add(Format('Reply   from   [%s]   :   Bytes=%d   time%s%d   ms   TTL=%d',  
    [AReplyStatus.FromIpAddress,     
    AReplyStatus.BytesReceived,     
    sTime,     
    AReplyStatus.MsRoundTripTime,     
    AReplyStatus.TimeToLive]));  
end;  
  
end.  
分享到: