Delphi編程實現Ping操作

在Delphi中使用TidIcmpClIEnt控件可以非常簡單的實現圖形界面的Ping！
　　新建一個工程，命名為PingGUI.dpr，窗口命名為“frmPing”，加入如下組件：
　　    lstReplIEs: TListBox;
　　    ICMP: TIdIcmpClIEnt;
　　    Panel1: TPanel;
　　    btnPing: TButton;
　　    edtHost: TEdit;
　　    spnPing: TSpinEdit;
　　    Label1: TLabel;
　　
　　完整源代碼如下：
　　unit Main;

　　interface

　　uses
　　  Windows, Messages, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
　　  SysUtils, Classes, IdIcmpClIEnt, IDBaseComponent, IdComponent, IdRawBase, IdRawClIEnt,
　　  Spin;

　　
　　type
　　  TfrmPing = class(TForm)
　　    lstReplIEs: TListBox;
　　    ICMP: TIdIcmpClIEnt;
　　    Panel1: TPanel;
　　    btnPing: TButton;
　　    edtHost: TEdit;
　　    spnPing: TSpinEdit;
　　    Label1: TLabel;
　　    procedure btnPingClick(Sender: TObject);
　　    procedure ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
　　  private
　　  public
　　  end;

　　var
　　  frmPing: TfrmPing;

　　implementation
　　{$R *.DFM}

　　procedure TfrmPing.btnPingClick(Sender: TObject);
　　var
　　  i: integer;
　　begin
　　  ICMP.OnReply := ICMPReply;
　　  ICMP.ReceiveTimeout := 1000;
　　  btnPing.Enabled := False; try
　　    ICMP.Host := edtHost.Text;
　　    for i := 1 to spnPing.Value do begin
　　      ICMP.Ping;
　　      Application.ProcessMessages;
　　    end;
　　  finally btnPing.Enabled := True; end;
　　end;

　　procedure TfrmPing.ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
　　var
　　  sTime: string;
　　begin
　　  // TODO: check for error on ping reply (ReplyStatus.MsgType?)
　　  if (ReplyStatus.MsRoundTripTime = 0) then
　　    sTime := '<1'
　　  else
　　    sTime := '=';

　　  lstReplIEs.Items.Add(Format('%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',
　　    [ReplyStatus.BytesReceived,
　　    ReplyStatus.FromIpAddress,
　　    ReplyStatus.SequenceId,
　　    ReplyStatus.TimeToLive,
　　    sTime,
　　    ReplyStatus.MsRoundTripTime]));
　　end;