delphi 测试ping

type
  TForm1 = class(TForm)
    idcmpclnt1: TIdIcmpClient;
    cxbtn1: TcxButton;
    cxbtn2: TcxButton;
    pnl1: TPanel;
    edtHost: TcxTextEdit;
    cxm1: TcxMemo;
    cxText_count: TcxTextEdit;
    procedure cxbtn1Click(Sender: TObject);
    procedure cxbtn2Click(Sender: TObject);
    procedure idcmpclnt1Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);
  private
    { Private declarations }
    b, i, s: Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.cxbtn1Click(Sender: TObject); //执行Ping操作
begin
  b := 0; //掉包数量
  i := 0; //Ping的总次数
  s := 0; //执行(s=0)或停止(s=1)标志
  cxm1.Clear; //清除上次Ping的信息

  idcmpclnt1.Host := edtHost.Text;   //设置IP
  while (i < 100000) and (s = 0) do
  begin //最多执行10万次Ping操作
    Application.ProcessMessages;
    i := i + 1;
    idcmpclnt1.Ping; //执行Ping
   //若前10次Ping都失败则结束Ping

    if (i = 10) and (b = 10) then
      s := 1;
  end;
end;

procedure TForm1.cxbtn2Click(Sender: TObject); //停止Ping操作
begin
  s := 1; //置Ping操作停止标志
end;

procedure TForm1.idcmpclnt1Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);
var
  Msg: string;
  Tm: integer;
begin
  with AReplyStatus do
  begin
    Msg := 'Reply from ' + edtHost.Text;
    Msg := Msg + ' bytes=' + IntToStr(BytesReceived); //返回字节数
    Msg := Msg + ' TTL=' + IntToStr(TimeToLive); //返回生存时间
    Tm := MsRoundTripTime; //返回执行时间

    if Tm < 1 then
      Tm := 1;
    Msg := Msg + ' time=' + IntToStr(Tm) + 'ms';
    cxm1.Lines.Add(Msg); //保存信息

    if (BytesReceived = 0) or (TimeToLive = 0) then
    begin //无数据返回
      b := b + 1; //记录掉包数量
      cxText_count.text := IntToStr(b); //记录掉包数
    end;

    if i mod 100 = 0 then  //每Ping到100次显示一次掉包情况
      pnl1.Caption := 'Lost：' + IntToStr(b) + '/' + IntToStr(i) + '=' + copy(FloatToStr(b / i * 1000), 1, 4) + '‰';

  end;
end;