11

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

所以我想做的是写一个多线程平，但我很挣扎。我在互联网上只看到很少的例子，没有人符合我的需求，这就是我尝试自己写的原因。

我使用 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 在这里https://code.google.com/p/delphi-stackoverflow/开始了一个谷歌代码项目， 这是一个工作基础。我将他的答案标记为“已接受的答案”，但用户应该参考这个开源项目（所有功劳归他所有），因为它肯定会在未来得到扩展和更新。

4

4 回答 4

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 并行性。

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

于 2012-10-13T00:16:57.903 回答
5

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;
于 2012-10-13T05:46:30.477 回答
1

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

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

  2. “继承”没有意义；在.执行。最好去掉。

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

  4. 异常逻辑有缺陷。如果抛出异常 - 如果没有设置成功的 Ping - 那么为什么要等待响应？您循环应该在与发出 ping 相同的 try-except 帧内进行。

  5. 您doOnPingReply在之后执行fIdIcmpClient.Free但访问fIdIcmpClient的内部。尝试更改 .Free for FreeAndNil 吗？这是释放死指针后使用死指针的典型错误。正确的做法是：
    5.1。doOnPingReply
    在5.2中释放对象。或在调用之前将所有相关数据复制doOnPingReply到 TThread 的私有成员变量Synchronize和（并且仅在5.3idICMP.Free中使用这些变量）。doOnPingReply只做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 原则，不知道。
  • 坚持使用复杂的 TThread 而不是 OTL 或 AsyncCalls - 战略错误。不要把车放在跑道上，使用简单的工具。

有趣的是，这是一个FreeAndNil可以暴露并显而易见的错误示例，而 FreeAndNil-haters 则声称它“隐藏”了错误。

于 2012-10-12T12:41:28.910 回答
0 
// 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 }
.
.
.
于 2013-07-11T02:35:38.080 回答