如何实现DOS 下的PING的效果,测试网络的连通性(附源码)

Question

有一个工作站，运行了一个接口程序，是连sql 2000的数据库。近段时间会不定时的提示“数据连接失败”，一直找不到问题，现在想用delphi做一个程序来监控网络连接状况，看看是否在提示连接失败时有网络丢包的问题发生。
现用indy的IDICMPCLIENT控件，实现ping的功能，将ping的结果记录到一个文本文件中，但是发现通过delphi的程序ping的时候总是三个连通的记录后会有一个time out，这和同时用dos中的ping的结果不一致。不知道问题在哪里。
附源码。
unit TestPing;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, IdBaseComponent, IdComponent, IdRawBase,
  IdRawClient, IdIcmpClient, ExtCtrls;type
  TForm1 = class(TForm)
    icmp: TIdIcmpClient;
    edtHost: TEdit;
    Label1: TLabel;
    info: TListBox;
    BtnPing: TBitBtn;
    BtnStop: TBitBtn;
    Label2: TLabel;
    procedure BtnPingClick(Sender: TObject);
    procedure BtnStopClick(Sender: TObject);
    procedure icmpReply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
    procedure icmpStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;   s:integer;    //全局变量
implementation{$R *.dfm}procedure TForm1.BtnPingClick(Sender: TObject);
begin
Info.Clear;
label1.Caption:='正在ping.....';
icmp.ReceiveTimeout:=1000;
icmp.OnReply:=icmpReply;s:=0; //执行(s=0)或停止(s=1)标志//清除上次Ping的信息ICMP.Host:=edtHost.Text; //置IPWhile s=0 Dobegin    ;
   ICMP.Ping; //执行Ping
     Application.ProcessMessages;end;end;procedure TForm1.BtnStopClick(Sender: TObject);
begin
  s:=1; //置Ping操作停止标志
  label1.Caption:='ping已结束';
end;procedure TForm1.icmpReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
Msg:string;
/
beginWith AReplyStatus dobegin
  if ReplyStatusType=rsTimeOut  then
  begin
     msg:='Request timed out. 发生时间：'+datetimetostr(now);
     Info.Items.Add(msg);
  end;
  else
  begin   Msg:='Reply from'+edtHost.Text;   Msg:=Msg+'   bytes='+IntToStr(BytesReceived); //返回字节数   Msg:=Msg+'   TTL='+IntToStr(TimeToLive); //返回生存时间   Tm:=MsRoundTripTime; //返回执行时间   if Tm<1 then Tmstr:='   time<1ms'
   else Tmstr:='   time='+IntToStr(Tm)+'ms';   Msg:=Msg+Tmstr;   end;   Info.Items.Add(msg); //保存信息
end;end;
end;end.

Answer 1

默认就是ping4次的，如果一直ping的话要带参数的
delphi中的网络通信控件如何设置参数，不太清楚
关注..

Answer 2

给个变通的做法.
procedure TForm1.BtnPingClick(Sender: TObject);
begin
    Info.Clear;
    label1.Caption:='正在ping.....';
    icmp.ReceiveTimeout:=1000;
    icmp.OnReply:=icmpReply;    s:=0; //执行(s=0)或停止(s=1)标志
    //清除上次Ping的信息
    ICMP.Host:=edtHost.Text; //置IP
    try
        While s=0 Do
        begin
           Sleep(1000);
           try
              ICMP.Ping; //执行Ping           finally
              Application.ProcessMessages;
              ;
           end;
        end;
    except
      Timer1.Enabled :=true;
    end;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
    Timer1.Enabled :=false;
    BtnPingClick(Sender);
end;

Answer 3

加群：37802783  ，你有一个专门实现Ping的程序。