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;

end.

出处： zahui 日期： 2005-12-19