Question

我有一个拥有60台计算机/设备的房间（40台计算机和20台基于Windows CE的示波器），我想知道哪个，每个人都使用ping。首先我写了一个标准的ping（参见这里Delphi Indy Ping Error 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）在代码中时。每次我点击按钮检查连接时结果都是正确的。

没有睡眠（10），它正在“大部分”工作，但有时结果是错误的，在离线计算机上给我一个ping回音，在线计算机上没有ping回应，因为没有分配ping回复到正确的线程。

欢迎任何评论或帮助。

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

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

Answer 1

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

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

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

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

Answer 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;

Answer 3

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

使线程最小化主线程负载。线程构造函数应该记住参数的最小工作。就个人而言，我已将idICMP创建转移到.Execute方法中。如果由于任何原因它想要创建其内部同步对象，如窗口和消息队列或信号或其他什么，我希望它已经发生在新的衍生线程中。
“继承”没有任何意义在.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。或者在调用doOnPingReply和Synchronize之前将所有相关数据从idICMP.Free复制到TThread的私有成员变量（并且仅在doOnPingReply中使用这些变量） 5.3。只在fIdIcmpClient.Free或TMyThread.BeforeDestruction内TMyThread.Destroy。毕竟，如果您选择在构造函数中创建对象 - 那么您应该在匹配的语言构造中释放它 - 析构函数。
由于您没有保留对线程对象的引用 - While not Terminated循环似乎是多余的。只需通常永远循环并打电话给休息。
前面提到的循环很耗费CPU，就像自旋循环一样。请在内部循环中调用Sleep(0);或Yield();，以便为其他线程提供更好的工作机会。不要在这里使用agaisnt OS调度程序 - 您不在速度关键路径中，没有理由在此处spinlock。

总的来说，我认为：

4和5是你的关键错误
1和3作为潜在的问题可能会影响或者可能不会影响。你最好'安全'而不是做冒险的事情，并调查他们是否会工作。
2和7 - 糟糕的风格，2关于语言和7关于平台
6要么你有计划扩展你的应用程序，要么你打破了YAGNI原则，不知道。
坚持使用复杂的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 }
.
.
.

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

4 个答案: