如何在关闭应用程序之前等待所有匿名线程终止？

Question

我遇到了一个尴尬的问题。在我的应用程序中，我经常这样做

TThread.createAnonymousThread(
  procedure
    ....
  end).start

我遇到的问题是，当我关闭我的应用程序的主窗体时，有时在 Tform.destroy 完成后，其中一些 AnonymousThread 仍然存在。在我的 Tform.destroy 中，他们是否有一种方法可以等待所有那些 AnonymousThread（在整个应用程序的任何地方都创建了一点）在继续之前成功终止？

我发现这种方式可以列出所有运行线程（来自 How can I get a list with all the threads created by my application）：

program ListthreadsofProcess;

{$APPTYPE CONSOLE}

uses
  PsAPI,
  TlHelp32,
  Windows,
  SysUtils;

function GetTthreadsList(PID:Cardinal): Boolean;
var
  SnapProcHandle: THandle;
  NextProc      : Boolean;
  TThreadEntry  : TThreadEntry32;
begin
  SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); //Takes a snapshot of the all threads
  Result := (SnapProcHandle <> INVALID_HANDLE_VALUE);
  if Result then
  try
    TThreadEntry.dwSize := SizeOf(TThreadEntry);
    NextProc := Thread32First(SnapProcHandle, TThreadEntry);//get the first Thread
    while NextProc do
    begin
      if TThreadEntry.th32OwnerProcessID = PID then //Check the owner Pid against the PID requested
      begin
        Writeln('Thread ID      '+inttohex(TThreadEntry.th32ThreadID,8));
        Writeln('base priority  '+inttostr(TThreadEntry.tpBasePri));
        Writeln('');
      end;

      NextProc := Thread32Next(SnapProcHandle, TThreadEntry);//get the Next Thread
    end;
  finally
    CloseHandle(SnapProcHandle);//Close the Handle
  end;
end;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  GettthreadsList(GetCurrentProcessId); //get the PID of the current application
  //GettthreadsList(5928);
  Readln;
end.

但看起来在这个列表中有一些线程并不是我的代码真正创建的，而且这些线程永远不会关闭。例如，对于空白项目，这是线程列表：

Answer 1

从进程中读取所有线程，然后尝试找出要等待的线程，这听起来很痛苦。

如果您真的不想存储匿名线程的引用（顺便说一句，它不应该是 FreeOnTerminate，因为如果线程在您等待它之前结束，那会导致悬空引用）然后构建一个包装器围绕 TThread.CreateAnonymousThread 或 TTask.Run 进行内部存储并封装 WaitFor。您甚至可以花哨并添加一个额外的组密钥，这样您就可以创建并等待不同的 threads/tasks 集而不是全部。

Answer 2

推入 thread-safe 列表 CreateAnonymousThread 返回的 TThread 引用，确保在线程终止时保持同步并实现您自己的 WaitForAll。

或者，考虑使用TTask class for a simple parallel threads management. It have already implemented WaitForAll方法。

示例代码取自 Delphi help:

procedure TForm1.MyButtonClick(Sender: TObject);
var 
  tasks: array of ITask; 
  value: Integer; 
begin 
  Setlength (tasks ,2); 
  value := 0; 

 tasks[0] := TTask.Create (procedure () 
  begin 
   sleep(3000);
   TInterlocked.Add (value, 3000); 
  end); 
 tasks[0].Start; 

 tasks[1] := TTask.Create (procedure () 
   begin 
   sleep (5000);
   TInterlocked.Add (value, 5000);
 end); 
 tasks[1].Start; 

 TTask.WaitForAll(tasks); 
 ShowMessage ('All done: ' + value.ToString); 
end;

Answer 3

您面临的核心问题并非来自匿名线程本身，而是来自 self-destroying 个匿名线程 - 那些设置了 FreeOnTerminate 的线程。

为了在线程上等待，您需要引用线程或其句柄（Windows 平台）。因为您正在处理 self-destroying 个线程，所以引用线程不是一种选择，因为一旦您启动线程，您就不再被允许触及该引用。

Delphi RTL 不会在应用程序关闭期间对自毁匿名线程执行任何清理，因此这些线程将在您的应用程序主窗体被销毁后被 OS 杀死，因此您的问题。

一种允许您等待匿名线程的解决方案，它不需要任何复杂的内务处理和维护任何类型的列表，并且还需要对代码进行最少的更改，只需简单的查找和替换，正在使用 TCountdownEvent 来计算线程数。

这需要将 TThread.CreateAnonymousThread 替换为构造自定义线程 class TAnoThread.Create（如果您愿意，可以添加静态工厂方法，而不是直接调用构造函数），其行为与匿名线程，除了它的实例将被计算在内，您将能够等待所有此类线程完成运行ning.

type
  TAnoThread = class(TThread)
  protected
    class var
      fCountdown: TCountdownEvent;
    class constructor ClassCreate;
    class destructor ClassDestroy;
  public
    class procedure Shutdown; static;
    class function WaitForAll(Timeout: Cardinal = INFINITE): TWaitResult; static;
  protected
    fProc: TProc;
    procedure Execute; override;
  public
    constructor Create(const aProc: TProc);
  end;

class constructor TAnoThread.ClassCreate;
begin
  fCountdown := TCountdownEvent.Create(1);
end;

class destructor TAnoThread.ClassDestroy;
begin
  fCountdown.Free;
end;

class procedure TAnoThread.Shutdown;
begin
  fCountdown.Signal;
end;

class function TAnoThread.WaitForAll(Timeout: Cardinal): TWaitResult;
begin
  Result := fCountdown.WaitFor(Timeout);
end;

constructor TAnoThread.Create(const aProc: TProc);
begin
  inherited Create(True);
  fProc := aProc;
  FreeOnTerminate := True;
end;

procedure TAnoThread.Execute;
begin
  if fCountdown.TryAddCount then
    try
      fProc;
    finally
      fCountdown.Signal;
    end;
end;

然后您可以在表单析构函数或任何其他适当的地方添加以下代码并等待所有匿名线程完成运行ning。

destructor TForm1.Destroy;
begin
  TAnoThread.Shutdown;
  while TAnoThread.WaitForAll(100) <> wrSignaled do
    CheckSynchronize;
  inherited;
end;

原理如下：倒计时事件以值为1创建，当该值达到0时，事件将发出信号。要启动关闭，您可以调用 Shutdown 方法来减少初始计数。您不能多次调用此方法，因为它会弄乱计数。

当匿名线程Execute方法启动时，它会首先尝试增加计数。如果它不能这样做，则意味着倒计时事件已经发出信号并且线程将终止而不调用其匿名方法，否则匿名方法将运行并且在它完成后计数将减少。

如果匿名线程使用 TThread.Synchronize 调用，您不能只调用 WaitForAll 因为从主线程调用它会死锁。为了在等待线程完成时防止死锁，您需要调用 CheckSynchronize 来处理挂起的同步请求。

此解决方案计算 TAnoThread class 的所有线程，无论它们是否 self-destroying。这可以很容易地更改为仅计算已设置 FreeOnTerminate 的那些。

此外，当您调用 Shutdown 并且您仍然有一些运行ning 线程时，新线程仍将能够在该点启动，因为甚至没有发出倒计时信号。如果您想从那时起阻止新线程，您将需要添加一个布尔标志，以指示您已启动关闭过程。

如何在关闭应用程序之前等待所有匿名线程终止？

How to wait that all anonymous thread are terminated before closing the app?

delphi