关于delphi中利用IdIcmpClient空间实现ping命令

[小丢丢02]

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
IdComponent, IdRawBase, IdRawClient, IdIcmpClient, Vcl.ActnMan,
Vcl.ActnColorMaps, Vcl.ExtCtrls, Vcl.ComCtrls;

type
TForm1 = class(TForm)
ICMP: TIdIcmpClient;
edtHost: TEdit;
btnPing: TButton;
btnStop: TButton;
Info: TListBox;
stat1: TStatusBar;
procedure btnPingClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure ICMPReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
private

public
{ Public declarations }
end;

var
Form1: TForm1;
i,b,s : Integer;

implementation

{$R *.dfm}

procedure TForm1.btnPingClick(Sender: TObject);
begin
b := 0; //标记掉包数量
i := 0; //记录ping的总次数
s := 0; //执行ping操作
Info.Clear;
ICMP.Host := edtHost.Text;
while (i<100000) and (s=0) do
begin
Application.ProcessMessages;
i := i+1;
ICMP.Ping; //执行ping
if (i= 10) and (b=10) then //若前10次均ping失败则结束本次ping
s := 1;
end;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
s := 1; //停止ping操作
end;

procedure TForm1.ICMPReply(ASender: TComponent;const AReplyStatus: TReplyStatus);
var
FMsg: string;
Tm: integer;
begin
with ICMP.ReplyStatus do
FMsg := 'Reply from'+' '+edthost.Text;
FMsg := FMsg+' '+'Byte='+IntTostr(AReplyStatus.BytesReceived); //返回的字节
FMsg := FMsg+' '+'TTL='+IntTostr(AReplyStatus.TimeToLive); //返回生存时间
Tm:= AReplyStatus.MsRoundTripTime; //返回执行时间
if Tm<1 then Tm:=1;
FMsg := FMsg+' '+ 'Time='+IntToStr(Tm)+'ms';
Info.Items.Add(FMsg);
if (AReplyStatus.BytesReceived=0) or (AReplyStatus.TimeToLive=0) then
begin
b := b+1; //记录掉包数量
info.ItemIndex := info.Items.Count-1;
end;
if Info.Count>20 then info.Clear;
if i mod 100 = 0 then stat1.SimpleText:='Lost：'+
IntToStr(b)+'/'+IntToStr(i)+'='+copy (FloatToStr(b/i*1000),1,4)+'‰';
//ping满100次显示一次掉包数
end;

end.
ping的时候出错，这是什么原因呢

[随随便便写]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
  IdIcmpClient, ExtCtrls, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    Memo1: TMemo;
    Button2: TButton;
    Memo2: TMemo;
    Edit3: TEdit;
    UpDown1: TUpDown;
    Button3: TButton;
    Timer1: TTimer;
    IdIcmpClient1: TIdIcmpClient;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure IdIcmpClient1Reply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  Timer1.Interval := UpDown1.Position * 1000; //设置循环时间
  Timer1.Enabled := True; //开始循环
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //通常在窗体建立的时候我们可以设置一些组件的属性。
  Memo1.ScrollBars := ssVertical; //显示垂直滚动条
  Memo1.Color := clBlack;
  Memo1.Font.Color := clWhite;
  Memo2.Font.Color := clRed;
  Memo2.ScrollBars := ssVertical;
  Timer1.Enabled := False;
  UpDown1.Associate := Edit2; //关联到Edit2
  UpDown1.Min := 1; //从1秒开始
  UpDown1.Position := 5; //默认5秒
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled := False;
  Button1.Enabled := True;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  try
    IdIcmpClient1.Host := Edit1.Text;
    IdIcmpClient1.Ping; //开始Ping操作
  except
    Timer1.Enabled := False; //非法错误停止循环
    Button1.Enabled := True;
  end;
end;

procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime: string;
  AMemo: TMemo; //当前添加内容的Memo组件
begin
  if (AReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'
  else
    sTime := '=';
  //超时Memo2显示，正常状态Memo1显示
  if (AReplyStatus.MsRoundTripTime > StrToIntDef(Edit3.Text, 1000)) then
    AMemo := Memo2 else
    AMemo := Memo1;
  AMemo.Lines.Add(Format('%s Reply from %s: bytes=%d time%s%dms TTL=%d', [
    DatetimeToStr(now),
      AReplyStatus.FromIpAddress,
      AReplyStatus.BytesReceived,
      sTime,
      AReplyStatus.MsRoundTripTime,
      AReplyStatus.TimeToLive
      ]));
end;

end.

看这个源码吧。

[s11ss]

不停的ping啊？一点延时都没有！

[oushengfen]

路过，学习一下。

[sxper]

怎么把这个放到一个线程中间去

[lyhoo163]

S:='ping -n 20 192.168.1.100'; WinExec( pchar(S),SW_SHOW); 这样，也可以。

[Pensiasan]

XE5 ping出现 10040错误信息

[虚月]

我也是在xe5执行ping的时候出现Error 10040 的错误，找了好几久都没找到问题 只是发现出现那错误的时候应该是能ping的通，ping的通的时候不会出错！

[虚月]

是ping不通的时候正常超时！

[远东999]

XE5下出现这个问题，一直没解决，加上参数： ICMP.ping('12345678901234567890123456789012',4); 当能拼通时正常，拼不通时内存异常，晕死

[远东999]

拼不通时出现：access violation at oxoo4052ed:read of address ox3433322c.

[远东999]

XE5下出现这个问题，一直没解决，加上参数： ICMP.ping('12345678901234567890123456789012',4); 当能拼通时正常，拼不通时内存异常，晕死 我用一个ICMP实例，拼不同的IP就会出现内存冲突的异常 每拼一个IP都得创建一个ICMP才行。