学院首页>网络编程>其它编程>Delphi编程实现Ping操作

Delphi编程实现Ping操作

作者: 来源: 添加时间:2006-5-21 20:45:46
在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.


站内搜索