Multithreading Delphi（XE2）Indy（10）多线程Ping_Multithreading_Delphi_Ping_Indy_Tthread

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

multithreading delphi

Multithreading Delphi（XE2）Indy（10）多线程Ping,multithreading,delphi,ping,indy,tthread,Multithreading,Delphi,Ping,Indy,Tthread,我有一个房间，里面有60台计算机/设备（40台计算机和20台基于Windows CE的示波器），我想知道哪台计算机和每台设备都在使用ping。首先，我编写了一个标准的ping（见这里），它现在运行良好，但在大多数计算机脱机时需要很长时间所以我试图写一个多线程Ping，但我很难做到。我在互联网上只看到很少的例子，没有人能满足我的需要，这就是为什么我试图自己写它我使用XE2和Indy 10，表单仅由一个备忘录和一个按钮组成 unit Main; interface uses Winapi

我有一个房间，里面有60台计算机/设备（40台计算机和20台基于Windows CE的示波器），我想知道哪台计算机和每台设备都在使用ping。首先，我编写了一个标准的ping（见这里），它现在运行良好，但在大多数计算机脱机时需要很长时间

所以我试图写一个多线程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启动了一个工作基础。我将他的答案标记为“已接受的答案”，但是用户应该参考这个开源项目（所有的学分都属于他），因为它肯定会在将来扩展和更新。

我没有尝试你的代码，所以这都是假设性的，但我认为你弄乱了线程，得到了经典的

竞争条件。我重申我的建议，使用异步调用
或OmniThreadLibrary
——它们简单得多，可以省去“自食其力”的尝试
制造螺纹是为了尽量减少主螺纹负载。线程构造函数应该尽可能少地记住参数。就我个人而言，我将idICMP创建移到了.Execute
方法中。如果出于任何原因，它希望创建其内部同步对象，如窗口和消息队列或信号或其他什么，我希望它已经发生在新生成的线程中
在.Execute中使用“inherited；”没有任何意义。最好把它拿走
沉默所有异常是一种糟糕的风格。你可能有错误，但没有办法知道。您应该将它们传播到主线程并显示它们。OTL和AC在这方面帮助您，而对于tThread，您必须手动执行
异常逻辑有缺陷。若抛出异常—若并没有设置成功的Ping—那个么为什么要等待响应呢？循环应该在发出ping的同一try-except帧内进行
您的doOnPingReply
在fIdIcmpClient.Free
之后执行，但仍访问fIdIcmpClient的内部。试过换衣服，免费的还是零？
这是在释放死指针后使用它的一个典型错误。
正确的方法是：

5.1. 在doOnPingReply


5.2. 或者在调用Synchronize
和idICMP.Free
之前，将所有相关数据从doOnPingReply
复制到TThread的私有成员变量（并且只在doOnPingReply中使用这些变量）
5.3. 仅在销毁之前在TMyThread.in内执行fIdIcmpClient.Free
或TMyThread.Destroy
。毕竟，如果您选择在构造函数中创建对象，那么您应该在匹配的语言构造函数-析构函数中释放它

由于您没有保留对线程对象的引用，因此循环在未终止时似乎是多余的。只需要做一个普通的永久循环，然后调用break

前面提到的循环需要CPU，就像自旋循环一样。请拨打Sleep（0）或Yield（）内部循环，为其他线程提供更好的工作机会。不要在此处与操作系统调度器协同工作-您不在速度关键路径上，没有理由在此处进行自旋锁定


总的来说，我认为：

4和5是您的关键bug
1和3作为一个潜在的陷阱，可能会影响，也可能不会。你最好“谨慎行事”，而不是做冒险的事情，调查它们是否有效
2和7-风格不好，2关于语言，7关于平台
6或者你有扩展应用程序的计划，或者你违反了雅格尼原则，不知道
坚持使用复杂的TThread而不是OTL或AsyncCalls—策略性错误。不要把车放在跑道上，使用简单的工具


有趣的是，FreeAndNil
可能会暴露并使之变得明显，而讨厌FreeAndNil的人则声称它“隐藏”了bug。
根本问题是ping是无连接的流量。如果您有多个TIdIcmpClient
对象同时ping网络，则一个TIdIcmpClient
实例可以收到实际上属于另一个TIdIcmpClient
实例的回复。通过检查SequenceId
值，您试图在线程循环中说明这一点，但您没有考虑到TIdIcmpClient
已经在内部执行了相同的检查。它以循环方式读取网络回复，直到收到预期的回复，或者直到出现ReceiveTimeout
。如果它收到一个它不期望的回复，它只会丢弃该回复。因此，如果一个TIdIcmpClient
实例丢弃了另一个TIdIcmpClient
实例所期望的回复，那么您的代码将不会处理该回复，而另一个TIdIcmpClient
可能会收到另一个TIdIcmpClient
的回复，以此类推。通过添加Sleep（），您正在减少（但不是elim）
  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;

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