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

根本问题是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。

我没有尝试你的代码，所以这都是假设，但我认为你搞砸了线程并获得了经典 race condition。我重申我的建议使用 AsyncCalls 要么 OmniThreadLibrary  - 它们更简单，并且可以节省你几次“射击自己的脚”的尝试。

1. 线程用于最小化主线程负载。线程构造函数应该记住参数的最小工作。就个人而言，我已经将idICMP的创作转移到了 .Execute 方法。如果由于任何原因它想要创建其内部同步对象，如窗口和消息队列或信号或其他什么，我希望它已经发生在一个新的衍生线程中。

2. 对“继承”没有任何意义;在.Execute。更好地删除它。

3. 消除所有异常是不好的风格。您可能有错误 - 但无法了解它们。您应该将它们传播到主线程并显示它们。 OTL和AC可以为您提供帮助，而对于tThread，您必须手动完成。 如何在不调用.Sync的情况下处理AsyncCalls函数中抛出的异常？

4. 异常逻辑存在缺陷。抛出异常没有意义 - 如果没有设置成功的Ping - 那么为什么要等待响应呢？你循环应该在发出ping的同一个try-except帧内。

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

6. 因为你没有保留对线程对象的引用 - 那 While not Terminated 循环似乎多余。只需通常永远循环和呼叫休息。

7. 前面提到的循环是CPU饥饿的，它就像自旋循环。请打电话 Sleep(0); 要么 Yield(); 内部循环让其他线程更有机会完成他们的工作。不要在这里使用agaisnt OS调度程序 - 你不是一个速度关键的路径，没有理由 spinlock 这里。

总的来说，我认为：

• 4和5是你的关键错误
• 1和3作为潜在的问题可能会影响或者可能不会影响。你最好'安全'而不是做冒险的事情，并调查他们是否会工作。
• 2和7--糟糕的风格，2关于语言和7关于平台
• 6要么你有计划扩展你的应用程序，要么你打破了YAGNI原则，不知道。
• 坚持使用复杂的TThread而不是OTL或AsyncCalls - 战略错误。你不是把车放在跑道上，使用简单的工具。

有趣，这是bug的例子 FreeAndNil 可能暴露并显而易见，而FreeAndNil-haters声称它“隐藏”了错误。

// 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 }
.
.
.