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.