Delphi(XE2)Indy(10)多线程Ping

HpT*_*erm 11 delphi multithreading ping indy tthread

我有一个有60台计算机/设备的房间(40台计算机和20台基于Windows CE的示波器),我想知道哪个和每个人都在使用ping.首先我写了一个标准的ping(请参阅此处Delphi Indy Ping错误10040),现在工作正常,但大多数计算机脱机时需要很长时间.

所以我要做的就是编写一个MultiThread Ping,但我很挣扎.我在互联网上看到的例子很少,没有人能满足我的需求,这就是为什么我自己尝试写这个例子.

我使用XE2和Indy 10,表单只包含备忘录和按钮.

unit Main;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, Vcl.Forms,
  IdIcmpClient, IdGlobal, Vcl.StdCtrls, Vcl.Controls;

type
  TMainForm = class(TForm)
    Memo1: TMemo;
    ButtonStartPing: TButton;
    procedure ButtonStartPingClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TMyPingThread = class(TThread)
  private
    fIndex : integer;
    fIdIcmpClient: TIdIcmpClient;
    procedure doOnPingReply;
  protected
    procedure Execute; override;
  public
    constructor Create(index: integer);
  end;

var
  MainForm: TMainForm;
  ThreadCOunt : integer;

implementation

{$R *.dfm}

constructor TMyPingThread.Create(index: integer);
begin
  inherited Create(false);

  fIndex := index;
  fIdIcmpClient := TIdIcmpClient.Create(nil);
  fIdIcmpClient.ReceiveTimeout := 200;
  fIdIcmpClient.PacketSize := 24;
  fIdIcmpClient.Protocol := 1;
  fIdIcmpClient.IPVersion := Id_IPv4;

  //first computer is at adresse 211
  fIdIcmpClient.Host := '128.178.26.'+inttostr(211+index-1);

  self.FreeOnTerminate := true;
end;

procedure TMyPingThread.doOnPingReply;
begin
  MainForm.Memo1.lines.add(inttostr(findex)+' '+fIdIcmpClient.ReplyStatus.Msg);
  dec(ThreadCount);

  if ThreadCount = 0 then
    MainForm.Memo1.lines.add('--- End ---');
end;

procedure TMyPingThread.Execute;
begin
  inherited;

  try
    fIdIcmpClient.Ping('',findex);
  except
  end;

  while not Terminated do
  begin
    if fIdIcmpClient.ReplyStatus.SequenceId = findex then Terminate;
  end;

  Synchronize(doOnPingReply);
  fIdIcmpClient.Free;
end;

procedure TMainForm.ButtonStartPingClick(Sender: TObject);
var
  i: integer;
  myPing : TMyPingThread;
begin
  Memo1.Lines.Clear;

  ThreadCount := 0;
  for i := 1 to 40 do
  begin
    inc(ThreadCount);
    myPing := TMyPingThread.Create(i);
    //sleep(10);
  end;
end;

end.
Run Code Online (Sandbox Code Playgroud)

我的问题是,当我取消注释"sleep(10)"时它似乎"工作",并且"似乎"没有它就不能工作.这肯定意味着我错过了我写的线程中的一点.

换一种说法.当Sleep(10)在代码中时.每次我点击按钮检查连接结果都是正确的.

没有睡眠(10),它正在"大部分"工作,但有时结果是错误的,在离线计算机上给我一个ping回音,在线计算机上没有ping回应,因为ping回复没有分配给正确线.

欢迎任何评论或帮助.

-----编辑/重要-----

作为对此问题的一般跟进,@ Darian Miller 在此处 启动了Google Code项目https://code.google.com/p/delphi-stackoverflow/,这是一个工作基础.我将他的回答标记为"已接受的答案",但是用户应该参考这个开源项目(所有信用都属于他),因为它将来肯定会得到扩展和更新.

Rem*_*eau 11

根本问题是ping是无连接流量.如果您有多个TIdIcmpClient对象同时ping网络,则一个TIdIcmpClient实例可以接收实际属于另一个TIdIcmpClient实例的回复.您试图通过检查SequenceId值来考虑线程循环中的那个,但是您没有考虑到TIdIcmpClient内部已经进行了相同的检查.它在循环中读取网络回复,直到它收到预期的回复,或直到ReceiveTimeout发生.如果它收到回复,它没有预期,它只是丢弃该回复.所以,如果一个TIdIcmpClient实例丢弃的答复是另一个TIdIcmpClient例子期待,即回复不会被你的代码进行处理,而其他TIdIcmpClient可能会收到其他TIdIcmpClient的答复代替,等等.通过添加Sleep(),您正在减少(但不是消除)ping将相互重叠的机会.

对于你正在尝试做的事情,你将无法使用TIdIcmpClient原样并行运行多个ping,抱歉.它根本就不是为此而设计的.它无法以您需要的方式区分回复数据.您必须序列化线程,因此一次只能调用一个线程TIdIcmpClient.Ping().

如果序列化ping不是您的选择,您可以尝试将部分TIdIcmpClient源代码复制到您自己的代码中.运行41个线程 - 40个设备线程和1个响应线程.创建一个所有线程共享的单个套接字.让每个设备线程使用该套接字准备并将其各自的ping请求发送到网络.然后让响应线程连续读取来自同一套接字的回复,并将它们路由回适当的设备线程进行处理.这是一个更多的工作,但它将为您提供您正在寻找的多平行并行性.

如果您不想解决所有问题,另一种方法是使用已支持同时ping多台计算机的第三方应用程序,例如FREEPing.

  • Windows遇到了我描述的同样问题.如果您打开多个命令提示符窗口并运行Windows的"ping"实用程序,它也可能会受到多个实例干扰彼此的回复.在您自己的代码中,如果您通过单个套接字发送ping请求,并且有一个线程读取来自该套接字的所有回复,则不会遇到重叠问题. (2认同)

Dar*_*ler 5

雷米(Remy)解释了这些问题...我想在印地(Indy)中做一会儿,所以我发布了一个可能的解决方案,我将其整合到一个新的Google Code项目中,而不必在此处进行过多评论。这是最棘手的事情,如果您需要集成一些更改,请告诉我:https : //code.google.com/p/delphi-vault/

这段代码有两种方法可以Ping ...如您的示例中所示的多线程客户端,或者使用简单的回调过程。为Indy10和更高版本的Delphi写。

您的代码最终将使用TThreadedPing子孙定义了SynchronizedResponse方法:

  TMyPingThread = class(TThreadedPing)
  protected
    procedure SynchronizedResponse(const ReplyStatus:TReplyStatus); override;
  end;
Run Code Online (Sandbox Code Playgroud)

为了触发一些客户端线程,代码变为:

procedure TfrmThreadedPingSample.butStartPingClick(Sender: TObject);
begin
  TMyPingThread.Create('www.google.com');
  TMyPingThread.Create('127.0.0.1');
  TMyPingThread.Create('www.shouldnotresolvetoanythingatall.com');
  TMyPingThread.Create('127.0.0.1');
  TMyPingThread.Create('www.microsoft.com');
  TMyPingThread.Create('127.0.0.1');
end;
Run Code Online (Sandbox Code Playgroud)

线程响应在同步方法中调用:

procedure TMyPingThread.SynchronizedResponse(const ReplyStatus:TReplyStatus);
begin
  frmThreadedPingSample.Memo1.Lines.Add(TPingClient.FormatStandardResponse(ReplyStatus));
end;
Run Code Online (Sandbox Code Playgroud)