使用WaitForMultipleObjects等待多个线程

时间：2011-07-28 23:44:48

标签： multithreading delphi delphi-xe

我正在使用WaitForMultipleObjects函数等待几个线程的最终确定，但是我做错了，因为结果不是预期的

请参阅此示例代码

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  end;

  TFoo = class(TThread)
  private
    Factor: Double;
    procedure ShowData;
  protected
    procedure Execute; override;
    constructor Create(AFactor : Double);
  end;


var
  Form1: TForm1;

implementation

Uses
 Math;

{$R *.dfm}

{ TFoo }

constructor TFoo.Create(AFactor: Double);
begin
  inherited Create(False);
  Factor := AFactor;
  FreeOnTerminate := True;

end;

procedure TFoo.Execute;
const
  Max=100000000;
var
  i : Integer;
begin
  inherited;
  for i:=1 to Max do
    Factor:=Sqrt(Factor);

  Synchronize(ShowData);
end;

procedure TFoo.ShowData;
begin
  Form1.Memo1.Lines.Add(FloatToStr(Factor));
end;

procedure TForm1.Button1Click(Sender: TObject);
const
 nThreads=5;
Var
 tArr  : Array[1..nThreads]  of TFoo;
 hArr  : Array[1..nThreads]  of THandle;
 i     : Integer;
 rWait : Cardinal;
begin
  for i:=1  to nThreads do
   begin
     tArr[i]:=TFoo.Create(Pi*i);
     hArr[i]:=tArr[i].Handle;
   end;

  repeat
    rWait:= WaitForMultipleObjects(nThreads, @hArr, True, 100);
    Application.ProcessMessages;
  until rWait<>WAIT_TIMEOUT;
  //here I want to show this message when all the threads are terminated    
  Memo1.Lines.Add('Wait done');
end;

end.

这是演示应用的当前输出

1
Wait done
1
1
1
1

但我想要这样的东西

1
1
1
1
1
Wait done

如何使用WaitForMultipleObjects函数等待所有线程终止？

9 个答案:

答案 0 :(得分：10)

修复：删除FreeOnTerminate。

当您仍需要句柄时，您的代码会导致线程被释放。这是一个很大的错误，您可以在代码中的其他位置获取访问冲突，或者从WaitFormMultipleObjects返回错误返回代码。

当释放TThread时，TThread.handle变为无效，这会提前终止你的等待循环，因为句柄不再有效。如果您在后台释放后尝试访问TThread，您也可能会遇到访问访问冲突，因此我认为最好有意识地释放它们，并且在已知时间。

使用线程句柄作为事件句柄工作正常，但是当它终止时不应该使用FreeOnTerminate来释放线程，因为这会过早地破坏句柄。

我也同意那些说使用Application.Processmessages进行繁忙等待循环的人非常难看。还有其他方法可以做到这一点。

unit threadUnit2;

interface

uses Classes, SyncObjs,Windows, SysUtils;

type
  TFoo = class(TThread)
  private
    FFactor: Double;
    procedure ShowData;
  protected
    procedure Execute; override;
    constructor Create(AFactor : Double);
    destructor Destroy; override;
  end;

  procedure WaitForThreads;


implementation

Uses
 Forms,
 Math;

procedure Trace(msg:String);
begin
  if Assigned(Form1) then
    Form1.Memo1.Lines.Add(msg);
end;



{ TFoo }

constructor TFoo.Create(AFactor: Double);
begin
  inherited Create(False);
  FFactor := AFactor;
//  FreeOnTerminate := True;

end;

destructor TFoo.Destroy;
begin
  inherited;
end;

procedure TFoo.Execute;
const
  Max=100000000;
var
  i : Integer;
begin
  inherited;
  for i:=1 to Max do
    FFactor:=Sqrt(FFactor);


  Synchronize(ShowData);
end;


procedure TFoo.ShowData;
begin

  Trace(FloatToStr(FFactor));
end;

procedure WaitForThreads;
const
 nThreads=5;
Var
 tArr  : Array[1..nThreads]  of TFoo;
 hArr  : Array[1..nThreads]  of THandle;
 i     : Integer;
 rWait : Cardinal;
begin
  for i:=1  to nThreads do
   begin
     tArr[i]:=TFoo.Create(Pi*i);
     hArr[i]:=tArr[i].handle; // Event.Handle;
   end;

  repeat
    rWait:= WaitForMultipleObjects(nThreads, @hArr[1],{waitAll} True, 150);
    Application.ProcessMessages;
  until rWait<>WAIT_TIMEOUT;
  Sleep(0);
  //here I want to show this message when all the threads are terminated
  Trace('Wait done');

  for i:=1  to nThreads do
   begin
     tArr[i].Free;
   end;

end;

end.

答案 1 :(得分：3)

如果您真的想了解多线程是如何工作的，那么您就是在正确的道路上 - 通过代码学习并像在此处一样提出问题。但是，如果您只想在应用程序中使用多线程，那么只要使用至少Delphi 2009，就可以使用OmniThreadLibrary以更简单的方式完成。

uses
  Math,
  OtlTask,
  OtlParallel;

function Calculate(factor: real): real;
const
  Max = 100000000;
var
  i: integer;
begin
  Result := factor;
  for i := 1 to Max do
    Result := Sqrt(Result);
end;

procedure TForm35.btnClick(Sender: TObject);
const
  nThreads = 5;
begin
  Parallel.ForEach(1, nThreads).Execute(
    procedure (const task: IOmniTask; const value: integer)
    var
      res: real;
    begin
      res := Calculate(Pi*value);
      task.Invoke(
        procedure begin
          Form35.Memo1.Lines.Add(FloatToStr(res));
        end
      );
    end
  );
  Memo1.Lines.Add('All done');
end;

答案 2 :(得分：3)

以下是发生的事情。

  1. 您的代码从WAIT_FAILED返回WaitForMultipleObjects。
  2. 调用GetLastError会导致错误代码6，句柄无效。
  3. 您传递给WaitForMultipleObjects的唯一句柄是线程句柄，其中一个线程句柄无效。
  4. 其中一个线程句柄无效的唯一方法是它是否已关闭。
  5. 正如其他人所说，您正在设置FreeOnTerminate。
    6. 来关闭句柄

    故事的寓意是从所有功能中正确检查您的返回值，让GetLastError引导您找出问题的根本原因。

答案 3 :(得分：2)

不要将这么短的超时时间作为最后一个参数传递。

根据MSDN

  

dwMilliseconds   [in]超时间隔，以毫秒为单位。即使间隔已过，该函数也会返回，即使不满足bWaitAll参数指定的条件。如果dwMilliseconds为零，则该函数将测试指定对象的状态并立即返回。如果dwMilliseconds是INFINITE，则函数的超时间隔永远不会过去。

特别注意第二句话。你告诉它等待所有的句柄，但是在100毫秒后超时。因此，请将INFINITE作为最后一个参数传递，并使用WAIT_OBJECT_0代替WAIT_TIMEOUT作为退出测试。

答案 4 :(得分：2)

每当您等待并且涉及消息时，您必须使用MsgWait ...并指定掩码来处理预期的消息

repeat
    rWait:= MsgWaitForMultipleObjects(nThreads, @hArr[1], True, INFINITE, QS_ALLEVENTS);
    Application.ProcessMessages;
 until (rWait<>WAIT_TIMEOUT) and (rWait <> (WAIT_OBJECT_0 + nThreads));

来确定nthreads

答案 5 :(得分：2)

我无法利用这个机会创建一个启动几个线程并使用消息传递将结果报告回GUI的工作示例。

将要启动的线程声明为：

type
  TWorker = class(TThread)
  private
    FFactor: Double;
    FResult: Double;
    FReportTo: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(const aFactor: Double; const aReportTo: THandle);

    property Factor: Double read FFactor;
    property Result: Double read FResult;
  end;

构造函数只设置私有成员并将FreeOnTerminate设置为 False 。这是必不可少的，因为它将允许主线程查询实例的结果。 execute方法执行计算，然后发布消息到它在构造函数中收到的句柄，说明它已完成。

procedure TWorker.Execute;
const
  Max = 100000000;
var
  i : Integer;
begin
  inherited;

  FResult := FFactor;
  for i := 1 to Max do
    FResult := Sqrt(FResult);

  PostMessage(FReportTo, UM_WORKERDONE, Self.Handle, 0);
end;

自定义UM_WORKERDONE消息的声明声明为：

const
  UM_WORKERDONE = WM_USER + 1;

type
  TUMWorkerDone = packed record
    Msg: Cardinal;
    ThreadHandle: Integer;
    unused: Integer;
    Result: LRESULT;
  end;

启动线程的表单已添加到其声明中：

  private
    FRunning: Boolean;
    FThreads: array of record
      Instance: TThread;
      Handle: THandle;
    end;
    procedure StartThreads(const aNumber: Integer);
    procedure HandleThreadResult(var Message: TUMWorkerDone); message UM_WORKERDONE;

FRunning用于防止在工作进行时单击按钮。 FThreads用于保存实例指针和创建的线程的句柄。

启动线程的过程有一个非常简单的实现：

procedure TForm1.StartThreads(const aNumber: Integer);
var
  i: Integer;
begin
  Memo1.Lines.Add(Format('Starting %d worker threads', [aNumber]));
  SetLength(FThreads, aNumber);
  for i := 0 to aNumber - 1 do
  begin
    FThreads[i].Instance := TWorker.Create(pi * (i+1), Self.Handle);
    FThreads[i].Handle := FThreads[i].Instance.Handle;
  end;
end;

乐趣在于HandleThreadResult实现：

procedure TForm1.HandleThreadResult(var Message: TUMWorkerDone);
var
  i: Integer;
  ThreadIdx: Integer;
  Thread: TWorker;
  Done: Boolean;
begin
  // Find thread in array
  ThreadIdx := -1;
  for i := Low(FThreads) to High(FThreads) do
    if FThreads[i].Handle = Cardinal(Message.ThreadHandle) then
    begin
      ThreadIdx := i;
      Break;
    end;

  // Report results and free the thread, nilling its pointer so we can detect
  // when all threads are done.
  if ThreadIdx > -1 then
  begin
    Thread := TWorker(FThreads[i].Instance);
    Memo1.Lines.Add(Format('Thread %d returned %f', [ThreadIdx, Thread.Result]));
    FreeAndNil(FThreads[i].Instance);
  end;

  // See whether all threads have finished.
  Done := True;
  for i := Low(FThreads) to High(FThreads) do
    if Assigned(FThreads[i].Instance) then
    begin
      Done := False;
      Break;
    end;
  if Done then
    Memo1.Lines.Add('Work done');
end;

...享受

答案 6 :(得分：1)

有一个条件可以满足您忽略的重复循环中的'until'条件，WAIT_FAILED：

until rWait<>WAIT_TIMEOUT; 
Memo1.Lines.Add('Wait done');

由于你的超时有点紧张，一个（或多个）线程完成并释放自己，使一个（或多个）句柄对下一个WaitForMultipleObjects无效，这导致它返回'WAIT_FAILED'，导致显示“等待完成”消息。

对于repeat循环中的每次迭代，您应该从hArr中删除已完成线程的句柄。然后再次不要忘记在任何情况下测试'WAIT_FAILED'。


修改
以下是一些示例代码，展示了如何做到这一点。这种方法的不同之处在于，它不会保留未使用的内核和RTL对象。这对于手头的样本无关紧要，但是对于许多做冗长业务的线程来说，这可能是首选。

在代码中，调用WaitForMultipleObjects并为'bWaitAll'参数传递'false'，以便能够删除线程句柄而无需使用额外的API调用来查明它是否无效。但它允许，否则代码也必须能够处理在等待调用之外完成的线程。

procedure TForm1.Button1Click(Sender: TObject);

const
  nThreads=5;

Var
  tArr  : Array[1..nThreads]  of TFoo;
  hArr  : Array[1..nThreads]  of THandle;
  i     : Integer;
  rWait : Cardinal;

  hCount: Integer;  // total number of supposedly running threads
  Flags: DWORD;     // dummy variable used in a call to find out if a thread handle is valid

  procedure RemoveHandle(Index: Integer); // Decrement valid handle count and leave invalid handle out of range
  begin
    if Index <> hCount then
      hArr[Index] := hArr[hCount];
    Dec(hCount);
  end;

begin
  Memo1.Clear;

  for i:=1  to nThreads do
   begin
     tArr[i]:=TFoo.Create(Pi*i);
     hArr[i]:=tArr[i].Handle;
   end;
   hCount := nThreads;

  repeat
    rWait:= WaitForMultipleObjects(hCount, @hArr, False, 100);

    case rWait of

      // one of the threads satisfied the wait, remove its handle
      WAIT_OBJECT_0..WAIT_OBJECT_0 + nThreads - 1: RemoveHandle(rWait + 1);

      // at least one handle has become invalid outside the wait call, 
      // or more than one thread finished during the previous wait,
      // find and remove them
      WAIT_FAILED:
        begin
          if GetLastError = ERROR_INVALID_HANDLE then
          begin
            for i := hCount downto 1 do 
              if not GetHandleInformation(hArr[i], Flags) then // is handle valid?
                RemoveHandle(i);
          end
          else
            // the wait failed because of something other than an invalid handle
            RaiseLastOSError;
        end;

      // all remaining threads continue running, process messages and loop.
      // don't process messages if the wait returned WAIT_FAILED since we didn't wait at all
      // likewise WAIT_OBJECT_... may return soon
      WAIT_TIMEOUT: Application.ProcessMessages; 
    end;

  until hCount = 0;  // no more valid thread handles, we're done

  Memo1.Lines.Add('Wait done');
end;


请注意，这是为了回答问题。我宁愿使用TThreads'OnTerminate事件递减计数器，并在它达到'0'时输出'Wait done'消息。这个，或者正如其他人所建议的那样，将等待转移到自己的线程，会更容易，也可能更干净，并且可以避免使用Application.ProcessMessages。

答案 7 :(得分：1)

我在例行程序的末尾添加了以下行：

memo1.Lines.add(intToHex(rWait, 2));
if rWait = $FFFFFFFF then
  RaiseLastOSError;

事实证明WaitForMultipleObjects失败并出现拒绝访问错误，很可能是因为部分但并非所有线程都在完成并在迭代之间自行清理。

你这里有一个棘手的问题。您需要保持消息泵运行，或者同步调用不起作用，因此您无法像Ken建议的那样传递INFINITE。但如果你正在做你目前正在做的事情，你会遇到这个问题。

解决方案是将WaitForMultipleObjects调用及其周围的代码移动到自己的线程中。它应该等待INFINITE，然后当它完成时它应该以某种方式通知UI线程让它知道它完成了。 （例如，单击按钮时，禁用按钮，然后当监视器线程完成时，它会再次启用该按钮。）

答案 8 :(得分：1)

您可以重构代码以等待一个对象而不是多个对象。

我想向您介绍一个小帮手，通常可以帮助我这样的情况。这次他的名字是 IFooMonitor ：

IFooMonitor = interface
  function WaitForAll(ATimeOut: Cardinal): Boolean;
  procedure ImDone;
end;

TFoo 和 IFooMonitor 将成为朋友：

TFoo = class(TThread)
strict private
  FFactor: Double;
  FMonitor: IFooMonitor;
  procedure ShowData;
protected
  procedure Execute; override;
public
  constructor Create(const AMonitor: IFooMonitor; AFactor: Double);
end;

constructor TFoo.Create(const ACountDown: ICountDown; AFactor: Double);
begin
  FCountDown := ACountDown;
  FFactor := AFactor;
  FreeOnTerminate := True;
  inherited Create(False);// <- call inherited constructor at the end!
end;

当 TFoo 完成他的工作时，它会告诉他的新朋友：

procedure TFoo.Execute;
const
  Max = 100000000;
var
  i: Integer;
begin
  for i := 1 to Max do
    FFactor := Sqrt(FFactor);

  Synchronize(ShowData);

  FMonitor.ImDone(); 
end;

现在我们可以重构事件处理程序，如下所示：

procedure TForm1.Button1Click(Sender: TObject);
const
  nThreads = 5;
var
 i: Integer;
 monitor: IFooMonitor;
begin
  monitor := TFooMonitor.Create(nThreads); // see below for the implementation.

  for i := 1 to nThreads do
    TFoo.Create(monitor, Pi*i);

  while not monitor.WaitForAll(100) do
    Application.ProcessMessages;

  Memo1.Lines.Add('Wait done');
end;

这就是我们如何实施 IFooMonitor ：

uses
  SyncObjs;

TFooMonitor = class(TInterfacedObject, IFooMonitor)
strict private
  FCounter: Integer;
  FEvent: TEvent;
  FLock: TCriticalSection;
private
  { IFooMonitor }
  function WaitForAll(ATimeOut: Cardinal): Boolean;
  procedure ImDone;
public
  constructor Create(ACount: Integer);
  destructor Destroy; override;   
end;

constructor TFooMonitor.Create(ACount: Integer);
begin
  inherited Create;
  FCounter := ACount;
  FEvent := TEvent.Create(nil, False, False, '');
  FLock := TCriticalSection.Create;
end;

procedure TFooMonitor.ImDone;
begin
  FLock.Enter;
  try
    Assert(FCounter > 0);
    Dec(FCounter);
    if FCounter = 0 then
      FEvent.SetEvent;
  finally
    FLock.Leave
  end;
end;

destructor TFooMonitor.Destroy;
begin
  FLock.Free;
  FEvent.Free;
  inherited;
end;

function TFooMonitor.WaitForAll(ATimeOut: Cardinal): Boolean;
begin
  Result := FEvent.WaitFor(ATimeOut) = wrSignaled 
end;
相关问题
最新问题