使用WaitForMultipleObjects等待多个线程

Sal*_*dor 10 delphi multithreading 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.
Run Code Online (Sandbox Code Playgroud)

这是演示应用程序的当前输出

1
Wait done
1
1
1
1
Run Code Online (Sandbox Code Playgroud)

但是我想要这样的东西

1
1
1
1
1
Wait done
Run Code Online (Sandbox Code Playgroud)

我必须使用该 WaitForMultipleObjects函数等待所有线程终止?

War*_* P 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.
Run Code Online (Sandbox Code Playgroud)

  • 1,在WaitForMultipleObjecs中没有访问冲突,它要么失败又返回WAIT_FAILED或成功并返回其他值之一.在任何情况下它都不会引发AV.2,错误不是在需要句柄时释放线程.错误在于使用无效句柄.OP可以选择保留线程,尽管它们不再需要,或者避免将无效句柄传递给WaitForMultipleObjects. (2认同)