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

【问题标题】：Delphi (XE2) Indy (10) Multithread PingDelphi (XE2) Indy (10) 多线程 Ping
【发布时间】：2012-10-12 11:56:46
【问题描述】：

我有一个有 60 台计算机/设备的房间（40 台计算机和 20 台基于 Windows CE 的示波器），我想知道使用 ping 的每个人都还活着。首先，我编写了一个标准 ping（参见此处 Delphi Indy Ping Error 10040），它现在运行良好，但在大多数计算机离线时需要很长时间。

所以我想做的是写一个多线程 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) 在代码中时。每次我单击按钮检查连接时，结果都是正确的。

没有睡眠（10），它“大部分”时间都在工作，但有时结果是错误的到正确的线程。

欢迎任何意见或帮助。

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

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

【问题讨论】：

我会重复我的建议 - 放弃股票 TThread 并使用 AsyncCalls 或 OmniThreads。你的线程实现对我来说似乎大多是单线程的！
'继承的 Create(false);' - 在 ctor 完成其字段的初始化之前，这可能不会运行线程吗？
..而且，ICMP ping 没有套接字上下文等。我不相信发送 ping 的线程会收到 gnip，因此 findex 将不匹配：'ReplyStatus.SequenceId = findex' 通常是错误的。 '好像 ping 回复没有分配给正确的线程' - 是的。
@Martin 我不知道 idICMP 的实现是什么，但sample of using Windows API 建议最明显的实现不会使用线程和消息队列，而只使用回调。坦率地说，我认为如果 topicstarter 在这里放弃 Indy 并直接使用 API - 他可以轻松地通过单线程（或至少可能是双线程）应用程序实现并行 ping，这将不那么繁重，而且更简单。我不知道 Windows 会通过哪种方法以及在哪个线程/上下文中调用该回调...
+1 @Martin。非常有趣的一点。

标签： multithreading delphi ping indy tthread

【解决方案1】：

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

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

【讨论】：

感谢您的回复。你说出了我已经在想的东西。为什么我尝试在多线程中执行该操作是因为我记得在某处读到 indy 10 是多线程的，并且 SequenceID 在这里是为了识别正确的线程。但是您向我证实了我的期望：这是不可能的。另一点是不幸的是我不能使用 FREEPing，因为我需要知道我的程序的“内部”哪台计算机正在运行。
你知道 Windows 是否使用 ICMP.dll 或者他们是否重写了一些自定义的东西。我的问题如下：我在命令提示符窗口多线程中执行的 ping 是否有上下文？如果我打开 60 个 cmd 窗口并在每个窗口中启动 ping，每个窗口都会得到正确的回复吗？如果是，我可以使用 delphi 来做到这一点
Windows 遇到了与我描述的相同的问题。如果您打开多个命令提示符窗口并运行 Windows 的“ping”实用程序，它也可能会受到多个实例相互干扰的影响。在您自己的代码中，如果您通过单个套接字发送 ping 请求，并有一个线程读取来自该套接字的所有回复，您将不会遇到重叠问题。

【解决方案2】：

Remy 解释了这些问题...我想在 Indy 中做这件事已经有一段时间了，所以我发布了一个可能的解决方案，我只是将它放在一个新的 Google Code 项目中，而不是在这里发表很长的评论。这是第一次尝试，如果您有一些更改要集成，请告诉我： https://code.google.com/p/delphi-vault/

此代码有两种方法来 Ping...如您的示例中的多线程客户端，或者使用简单的回调过程。为 Indy10 及更高版本的 Delphi 编写。

您的代码最终会使用定义 SynchronizedResponse 方法的 TThreadedPing 后代：

  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;

【讨论】：

哇，你做了很多工作。很好的答案。现在我正在修改我的代码以使用您的实现。也许 2 cmets。第一个是添加/修改以在某处获得 pingReply 的布尔答案。就我而言，我只想知道是/否是计算机已连接。另一件事是您的代码可以引起很多人的兴趣，现在它特定于我的需求：defReceiveTimeout = 200;和 defIPVersion = Id_IPv4;用户应该能够更改这些值以满足他的特定需求（您尝试过 ipv6 吗？它是否有效）。
+1，很高兴为 StackOverflow 项目创建共享空间！这给我带来了一个想法，即制作我的个人项目并始终共享整个项目，因为我通常（几乎总是）测试我发布的内容，所以现在我只需将整个项目提交到该个人存储并包含一个链接到完整的项目来回答。
@Darian 我已经仔细阅读了您的代码。你能确认我理解正确吗？您代码中的主要思想是发送多个 ping 线程，但在同一过程（InternalHandelReply）中获取所有回复，使用 SequenceId 知道哪个是哪个。这种做事方式（也如雷米所说）也是对待每一个答复而不丢弃任何答复，因此全部处理？我对么？ ...
... 因为实际上结果与我的“无线程代码”并没有太大不同。在我的情况下，未连接时的 ping 响应大约为 3 秒。我期待的是在 3 秒后收到所有回复。在当前代码中，我必须等待每台计算机 3 秒，60 PC = 3 分钟，这太长了.. 我正在寻找一种方法来一次获取 40 个回复并解析它们。 @Remy 有 60 个线程都回复同一个回复线程的想法是我想要做的，所以我可以使用 sequenceID 手动解析回复（你明白我的意思吗）
请注意，我更正了数据。我有 40 台计算机和 20 台示波器（基于 Windows CE），即 60 台设备，而不是我第一次说的 40 台。

【解决方案3】：

我没有尝试你的代码，所以这都是假设的，但我认为你弄乱了线程并得到了经典的 race condition。我重申我的建议是使用 AsyncCalls 或 OmniThreadLibrary - 它们更简单，并且可以避免您尝试“射击自己的脚”。

创建线程以最小化主线程负载。线程构造函数应该做最少的记住参数的工作。我个人将 idICMP 创建移到 .Execute 方法中。如果出于任何原因它想要创建其内部同步对象，例如窗口和消息队列或信号或其他任何东西，我希望它已经在一个新的衍生线程中发生。
“继承”没有意义；在.执行。最好删除它。
沉默所有异常是不好的风格。您可能有错误 - 但无法了解它们。您应该将它们传播到主线程并显示它们。 OTL 和 AC 可以帮助您，而对于 tThread，您必须手动完成。 How to Handle Exceptions thrown in AsyncCalls function without calling .Sync?
异常逻辑有缺陷。如果抛出异常 - 如果没有设置成功的 Ping - 那么为什么要等待响应？您的循环应该在与发出 ping 相同的 try-except 帧内进行。
您的doOnPingReply 在fIdIcmpClient.Free 之后执行，但访问fIdIcmpClient 的内部。尝试更改 .Free for FreeAndNil 吗？这是释放死指针后使用死指针的典型错误。正确的做法是：
5.1。要么释放 doOnPingReply
中的对象 5.2.或在调用 Synchronize 和 idICMP.Free 之前将所有相关数据从 doOnPingReply 复制到 TThread 的私有成员变量（并且仅在 doOnPingReply 中使用这些变量） 5.3.只在TMyThread.BeforeDestruction 或TMyThread.Destroy 内做fIdIcmpClient.Free。毕竟，如果您选择在构造函数中创建对象 - 那么您应该在匹配的语言构造 - 析构函数中释放它。
由于您不保留对线程对象的引用 - While not Terminated 循环似乎是多余的。只需进行通常的永远循环并调用中断即可。
前面提到的循环很消耗 CPU，就像自旋循环一样。请在循环内调用Sleep(0); 或Yield(); 给其他线程更好的机会来完成他们的工作。不要在此处与 OS 调度程序对抗 - 您不在速度关键路径中，没有理由在此处创建 spinlock。

总的来说，我认为：

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

有趣的是，这是 FreeAndNil 可能暴露并显而易见的错误示例，而讨厌 FreeAndNil 的人则声称它“隐藏”了错误。

【讨论】：

感谢您的长回答，我会仔细阅读，我很快就要离开了，周一会检查所有内容。
您的答案分析了我的主题以及您在其中看到的错误。其他人讨论过“ping”的其他主要限制，这是这里的重点。但是，据我所知，您的评论非常重要，对此我表示感谢。在实现@Dorian 给出的代码之前，我首先用您的评论更正了我的代码。这里我必须告诉你，.FreeAndNil 不是 idICMP 的方法。唯一可用的是 .Free (??)
这不是方法 - 方法无法更改变量的值。这是一个程序。 FreeAndNil(obj);
抱歉。有趣的是，从 1.0 版开始就使用 delphi，我什至现在都不知道 FreeAndNil 的东西；-)
它在 D1 中缺少，在 D4 或 D5 左右引入

【解决方案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 }
.
.
.

【讨论】：