Delphi（XE2）Indy（10）多线程Ping

Question

我有一间装有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.

我的问题是，当我取消对“ sleep（10）”的注释时，它“似乎”可以工作，而如果没有注释，它似乎就无法工作。 这肯定意味着我在编写的线程中遗漏了一点。

换一种说法。 在代码中使用Sleep（10）时。 每次我单击按钮开始检查连接时，结果都是正确的。

没有sleep（10），它在大多数时间都处于工作状态，但是有时结果是错误的，这使我在脱机计算机上发出ping回声，而在联机计算机上没有ping回声，因为ping答复未分配给正确的线。

欢迎任何评论或帮助。

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

作为对该问题的一般跟进，@ Darian Miller 在此处 https://code.google.com/p/delphi-stackoverflow/启动了Google Code项目，这是一个有效的基础。 我将他的答案标记为“可接受的答案”，但是用户应参考此开源项目（所有功劳归他所有），因为将来肯定会对其进行扩展和更新。

Answer 1

根本问题是ping是无连接流量。 如果您有多个TIdIcmpClient对象同时对网络执行ping操作，则一个TIdIcmpClient实例可以收到实际上属于另一个TIdIcmpClient实例的答复。 您正在尝试通过检查SequenceId值来解决线程循环中的问题，但并未考虑TIdIcmpClient已经在内部进行了相同的检查。 它以循环方式读取网络答复，直到收到期望的答复，或者直到发生ReceiveTimeout 。 如果收到不期望的答复，它只会丢弃该答复。 因此，如果一个TIdIcmpClient实例放弃了另一个TIdIcmpClient实例期望的答复，则该答复将不会被您的代码处理，而另一个TIdIcmpClient可能会收到另一个TIdIcmpClient的答复，依此类推。 通过添加Sleep() ，您将减少（但不消除）ping相互重叠的机会。

对于您要尝试执行的操作，您将无法按TIdIcmpClient使用TIdIcmpClient来并行运行多个ping，抱歉。 它根本不是为此目的而设计的。 它没有办法按照您需要的方式区分答复数据。 您将必须序列化线程，以便一次只能有一个线程调用TIdIcmpClient.Ping() 。

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

如果您不想解决所有麻烦，另一种方法是只使用已经支持同时ping多台计算机的第三方应用程序，例如FREEPing 。

Answer 2

雷米（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;

为了触发一些客户端线程，代码变为：

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;

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

procedure TMyPingThread.SynchronizedResponse(const ReplyStatus:TReplyStatus);
begin
  frmThreadedPingSample.Memo1.Lines.Add(TPingClient.FormatStandardResponse(ReplyStatus));
end;

Answer 3

我没有尝试过您的代码，因此所有假设都是这样，但是我认为您弄乱了线程并获得了经典的race condition 。 我重申使用AsyncCalls或OmniThreadLibrary建议-它们更简单，并且可以为您省去“ OmniThreadLibrary自己的脚”的几次尝试。

1. 线程被制成以最小化主线程负载。 线程构造函数应该做最少的记住参数的工作。 我个人将idICMP创建移至.Execute方法。 如果出于某种原因，它想创建其内部同步对象，例如窗口和消息队列或信号等，我希望它已经在新的生成线程中发生。

2. “继承”没有意义。 在.Execute中 最好将其删除。

3. 沉默所有异常是不好的风格。 您可能有错误-但无法了解它们。 您应该将它们传播到主线程并显示它们。 OTL和AC可以帮助您，而对于tThread，则必须手动进行。 如何处理AsyncCalls函数中引发的异常而不调用.Sync？

4. 异常逻辑有缺陷。 如果抛出异常，就没有循环的可能-如果未设置成功的Ping-那么为什么要等待响应？ 您的循环应与发出ping的尝试帧相同。

5. 您的doOnPingReply执行doOnPingReply之后fIdIcmpClient.Free但仍访问fIdIcmpClient的内部。 尝试更改.Free for FreeAndNil吗？ 这是在释放死指针后使用死指针的经典错误。 正确的方法是：
   5.1。 要么在doOnPingReply释放对象
   5.2。 或在调用Synchronize和idICMP.Free之前将所有相关数据从doOnPingReply复制到TThread的私有成员vars中（并且仅在doOnPingReply使用这些vars）5.3。 只做fIdIcmpClient.Free内TMyThread.BeforeDestruction或TMyThread.Destroy 。 毕竟，如果您选择在构造函数中创建对象-那么您应该在匹配的语言构造-析构函数中释放它。

6. 由于您不保留对线程对象的引用，因此， While not Terminated循环似乎是多余的。 只需进行通常的永远循环并中断即可。

7. 前面提到的循环很耗CPU，就像自旋循环一样。 请致电Sleep(0); 或Yield(); 内部循环，使其他线程有更好的机会进行工作。 不要在这里使用可用的OS调度程序-您的速度并不严格，没有理由在此处进行spinlock 。

---

总的来说，我认为：

• 4和5是您的关键错误
• 1和3作为潜在陷阱可能会影响，也可能不会。 您最好“谨慎行事”，而不要做有风险的事情并调查它们是否会起作用。
• 2和7-风格不好，关于语言2，关于平台7
• 6您有扩展应用程序的计划，或者您违反了YAGNI原则，dunno。
• 坚持使用复杂的TThread而不是OTL或AsyncCalls-战略错误。 您不要在机场跑道上放菜鸟，要使用简单的工具。

---

有趣的是，这是FreeAndNil可能暴露并使其明显的错误的示例，而FreeAndNil-haters声称它“隐藏”了这些错误。

Answer 4

// This is my communication unit witch works well, no need to know its work but your
// ask   is in the TPingThread class.

UNIT UComm;

INTERFACE

USES
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, Forms, Dialogs,
  StdCtrls,IdIcmpClient, ComCtrls, DB, abcwav, SyncObjs, IdStack, IdException, 
  IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdContext,
  UDM, UCommon;

TYPE
  TNetworkState = (nsNone, nsLAN, nsNoLAN, nsNet, nsNoNet);
  TDialerStatus = (dsNone, dsConnected, dsDisconnected, dsNotSync);

  { TBaseThread }

  TBaseThread = Class(TThread)
  Private
    FEvent : THandle;
    FEventOwned : Boolean;
    Procedure ThreadTerminate(Sender: TObject); Virtual;
  Public
    Constructor Create(AEventName: String);
    Property EventOwned: Boolean Read FEventOwned;
  End;

  .
  .
  .

  { TPingThread }

  TPingThread = Class(TBaseThread)
  Private
    FReply : Boolean;
    FTimeOut : Integer;
    FcmpClient : TIdIcmpClient;
    Procedure ReplyEvent(Sender: TComponent; Const AReplyStatus: TReplyStatus);
  Protected
    Procedure Execute; Override;
    Procedure ThreadTerminate(Sender: TObject); Override;
  Public
    Constructor Create(AHostIP, AEventName: String; ATimeOut: Integer);
    Property Reply: Boolean Read FReply;
  End;

  .
  .
  .


{ =============================================================================== }

IMPLEMENTATION

{$R *.dfm}

USES
  TypInfo, WinSock, IdGlobal, UCounter, UGlobalInstance, URemoteDesktop;
  {IdGlobal: For RawToBytes function 10/07/2013 04:18 }

{ TBaseThread }

//---------------------------------------------------------
Constructor TBaseThread.Create(AEventName: String);
Begin
  SetLastError(NO_ERROR);
  FEvent := CreateEvent(Nil, False, False, PChar(AEventName));
  If GetLastError = ERROR_ALREADY_EXISTS
    Then Begin
           CloseHandle(FEvent);
           FEventOwned := False;
         End
    Else If FEvent <> 0 Then
           Begin
             FEventOwned := True;
             Inherited Create(True);
             FreeOnTerminate := True;
             OnTerminate := ThreadTerminate;
           End;
End;

//---------------------------------------------------------
Procedure TBaseThread.ThreadTerminate(Sender: TObject);
Begin
  CloseHandle(FEvent);
End;

{ TLANThread }
 .
 .
 .

{ TPingThread }

//---------------------------------------------------------
Constructor TPingThread.Create(AHostIP: String; AEventName: String; ATimeOut: Integer);
Begin
  Inherited Create(AEventName);
  If Not EventOwned Then Exit;
  FTimeOut := ATimeOut;
  FcmpClient := TIdIcmpClient.Create(Nil);
  With FcmpClient Do
  Begin
    Host := AHostIP;
    ReceiveTimeOut := ATimeOut;
    OnReply := ReplyEvent;
  End;
End;

//---------------------------------------------------------
Procedure TPingThread.Execute;
Begin
  Try
    FcmpClient.Ping;
    FReply := FReply And (WaitForSingleObject(FEvent, FTimeOut) = WAIT_OBJECT_0);
  Except
    FReply := False;
  End;
End;

//---------------------------------------------------------
Procedure TPingThread.ReplyEvent(Sender: TComponent; Const AReplyStatus: TReplyStatus);
Begin
  With AReplyStatus Do
  FReply := (ReplyStatusType = rsEcho) And (BytesReceived <> 0);
  SetEvent(FEvent);
End;

//---------------------------------------------------------
Procedure TPingThread.ThreadTerminate(Sender: TObject);
Begin
  FreeAndNil(FcmpClient);
  Inherited;
End;

{ TNetThread }
.
.
.