Delphi: 应用程序退出时如何终止线程?

8
背景:我需要检查一些网络驱动器或远程计算机是否可用。由于每个 DirectoryExists() 都需要很长时间才能潜在超时,因此我在单独的线程中执行检查。可能会发生这样的情况,即当一些检查仍在运行时,最终用户关闭应用程序。由于 DirectoryExists() 是阻塞的,我无法使用经典的 while not Terminated 方法。
procedure TMyThread.Execute;
begin
  AExists := DirectoryExists(AFilepath);
end;

问题1:应用程序退出时仍有一些线程在运行,这会是个问题吗?Windows会为我清理掉它们吗?在IDE中,我会收到未释放对象的通知,但在IDE之外看起来似乎很平静。
问题2:是否可以使用TerminateThread终止这种简单的线程,或者在这种情况下这样做可能会有害?
问题3:我通常在OnTerminate()事件中从线程中取得结果,并且在完成后将线程标记为FreeOnTerminate。如果我想自己释放它们,那么我应该在什么时候释放呢?我能在线程的OnTerminate事件中释放它们吗,还是说这样有点太早了?如果不用OnTerminate,线程要如何通知我它已经完成了呢?

你需要在这些线程中进行任何整理吗?如果不需要,那就退出进程。我认为,Remy这次指引你的方向是错误的。 - David Heffernan
这是一个关于Delphi如何在关闭程序时终止所有线程(TThread)的stackoverflow问题链接:https://dev59.com/UUjSa4cB1Zd3GeqPHKm7希望对您有所帮助。 - Carlos Henrique
如果您在线程中使用辅助进程并等待它们完成,则可以避免所有这些问题。即使进程仍在运行,也可以使用WaitForMultipleObjects()在设置了关闭事件时退出线程。 - mghie
2个回答

9
当应用程序退出时,一些线程仍在运行是否是问题?
可能是的。这取决于DirectoryExists()退出后您的代码执行了什么操作。您可能会尝试访问不再存在的内容。
Windows会自动清理吗?
为确保所有内容都得到适当清除,您需要负责终止自己的线程。当主VCL线程完成运行时,它将调用ExitProcess(),该函数将强制终止任何仍在运行的辅助线程,这将不允许它们进行清理或通知任何已加载的DLL它们正在从线程中分离。
在此情况下,是否可以使用TerminateThread终止这些简单的线程,还是这可能会有害? TerminateThread()始终可能具有危险性,永远不要使用。
我通常会在OnTerminate()事件中获取线程结果,并在线程结束后释放线程。
如果主消息循环在线程终止之前已退出,则这样做将无效。默认情况下,TThread.OnTerminate事件通过调用TThread.Synchronize()触发。一旦主消息循环停止运行,除非您在应用程序退出时运行自己的循环来调用RTL的CheckSynchronize()过程直到所有线程完全终止,否则将没有任何东西来处理挂起的Synchronize()请求。
如果我想自己释放它们,应该在什么时候释放?
在应用程序想要退出之前。
我可以在OnTerminate事件中释放线程吗?
不行。这是不安全的,因为在由该对象触发的事件处理程序退出后,RTL仍需要访问该对象。
话虽如此,由于您没有一种安全地终止线程的方法,我建议在仍有线程运行时不允许应用程序退出。当用户请求退出应用程序时,请检查是否有线程正在运行,如果有,则向用户显示繁忙的UI,等待所有线程终止,然后退出应用程序。
constructor TMyThread.Create(...);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  ...
end;

procedure TMyThread.Execute;
begin
  ...
  if Terminated then Exit;
  AExists := DirectoryExists(AFilepath);
  if Terminated then Exit;
  ...
end;

type
  TMainForm = class(TForm)
    ...
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    ...
  private
    ThreadsRunning: Integer;
    procedure StartAThread;
    procedure ThreadTerminated(Sender: TObject);
    ...
  end;

...

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ThreadsRunning = 0 then Exit;

  // signal threads to terminate themselves...

  if CheckWin32Version(6) then
    ShutdownBlockReasonCreate(Handle, 'Waiting for Threads to Terminate');

  try
    // display busy UI to user ...

    repeat    
      case MsgWaitForMultipleObjects(1, System.Classes.SyncEvent, False, INFINITE, QS_ALLINPUT) of
        WAIT_OBJECT_0   : CheckSynchronize;
        WAIT_OBJECT_0+1 : Application.ProcessMessages;
        WAIT_FAILED     : RaiseLastOSError;
      end;
    until ThreadsRunning = 0;

    // hide busy UI ...
  finally
    if CheckWin32Version(6) then
      ShutdownBlockReasonDestroy(Handle);
  end;
end;

procedure TMainForm.StartAThread;
var
  Thread: TMyThread;
begin
  Thread := TMyThread.Create(...);
  Thread.OnTerminate := ThreadTerminated;
  Thread.Start;
  Inc(ThreadsRunning);
end;

procedure TMainForm.ThreadTerminated(Sender: TObject);
begin
  Dec(ThreadsRunning);
  ...
end;

或者:

type
  TMainForm = class(TForm)
    ...
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    ...
  private
    ThreadsRunning: Integer;
    WaitingForClose: Boolean;
    procedure StartAThread;
    procedure ThreadTerminated(Sender: TObject);
    ...
  end;

...

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := (ThreadsRunning = 0);
  if CanClose or WaitingForClose then Exit;

  // signal threads to terminate themselves...

  WaitingForClose := True;

  // display busy UI to user ...

  if CheckWin32Version(6) then
    ShutdownBlockReasonCreate(Handle, 'Waiting for Threads to Terminate');
end;

procedure TMainForm.StartAThread;
var
  Thread: TMyThread;
begin
  Thread := TMyThread.Create(...);
  Thread.OnTerminate := ThreadTerminated;
  Thread.Start;
  Inc(ThreadsRunning);
end;

procedure TMainForm.ThreadTerminated(Sender: TObject);
begin
  Dec(ThreadsRunning);

  ...

  if WaitingForClose and (ThreadsRunning = 0) then
  begin
    WaitingForClose := False;

    // hide busy UI ...

    if CheckWin32Version(6) then
      ShutdownBlockReasonDestroy(Handle);

    Close;
  end;
end;

我对“_该进程将不会完全退出[...]_”感到困惑。除非我们讨论的不是VCL应用程序,否则它只会在自身上调用ExitProcess,直接终止所有正在运行的线程。 - Günther the Beautiful
@Remy Lebeau:感谢您详细的回答。不过我并不太理解"MsgWaitForMultipleObjects"。有哪些事件会结束等待呢? - HJay
@Günther:这也是困扰我的问题。我原以为在 VCL 应用程序退出时,Windows 会自动整理并终止和清理所有线程和占用的内存。但不同来源中有许多相互矛盾的信息。 - HJay
@GünthertheBeautiful 我已经修正了关于退出进程的部分。 - Remy Lebeau
@HJay 阅读 MsgWaitForMultipleObjects 文档 - Remy Lebeau

5

一些线程在应用程序退出时仍在运行是否有问题?

字面意义上理解这个问题有点不完整。这是因为在默认情况下,Delphi 应用程序结束后会调用 ExitProcess,此时没有线程在运行。

回答“一些线程没有完成是否有问题”的问题取决于这些线程未能完成的内容。您需要仔细分析线程代码,但一般来说,这可能容易出错。


Windows会自动清理我的内存,就这样了吗?在IDE中我会收到未释放对象的通知,但在IDE外看起来就像是平静的。

当进程地址空间被销毁时,操作系统将回收已分配的内存,当进程句柄表被销毁时,所有对象句柄将被关闭,所有加载的库的入口点将被调用,并带有 DLL_PROCESS_DETACH。我找不到任何关于此的文档,但我也认为挂起的IO请求将被调用以取消。

但这并不意味着没有问题。例如,涉及进程间通信或同步对象时,情况可能会变得混乱。文档中的ExitProcess详细介绍了一个例子:如果一个线程在分离时消失前未释放一个库试图获取的锁,则会出现死锁。博客文章提供了另一个具体示例,在该示例中,如果一个线程尝试进入已被另一个已终止的线程孤立的临界区域,则操作系统会强制终止退出进程。
虽然在退出时放弃资源释放可能是有道理的,特别是如果清理需要相当长的时间,但对于一个非平凡应用程序来说,这样做可能会出现问题。一个健壮的策略是在调用 ExitProcess 之前清理所有内容。另一方面,如果你发现自己处于已经调用 ExitProcess 的情况下,例如进程由于终止而从你的 dll 中分离,那么唯一安全的做法就是将所有东西留下并返回 - 每个其他的 dll 都可能已经被卸载,每个其他的线程都已经终止。


在这种情况下,使用TerminateThread终止这样简单的线程是否可能是有害的?

TerminateThread建议仅在极端情况下使用,但由于问题有一个加粗的“THIS”,应该检查代码的实际作用。查看RTL代码,我们可以看到最糟糕的情况是留下一个文件句柄,只用于读取访问。在进程终止时,这不是问题,因为句柄很快就会关闭。


我通常从OnTerminate()事件的线程结果中获取并在之后使用FreeOnTerminate释放这些线程。如果我想自己释放它们,那么应该在什么时候释放呢?
唯一严格的规则是在它们执行完成之后。选择可能会受到应用程序设计的指导。不同的是,您将无法使用FreeOnTerminate,并且您将保留对线程的引用以便能够释放它们。在我为回答这个问题而工作的测试用例中,已完成的工作线程在定时器触发时被释放,有点像垃圾收集器。


我可以在OnTerminate事件中释放一个线程吗?还是说这有点太早了?

在对象的一个事件处理程序中释放该对象会导致操作已释放实例内存的风险。文档 特别警告组件不要这样做,但总体来说,这适用于所有类。

即使您想忽略警告,这也会造成死锁。虽然处理程序在 Execute 返回后调用,但 OnTerminate 仍然从 ThreadProc 同步。如果您尝试在处理程序中释放线程,它将导致主线程等待线程完成 - 而线程正在等待主线程从 OnTerminate 返回,这是一个死锁。


如果不使用OnTerminate,线程将如何通知我它已完成?

OnTerminate 可以用于通知线程已完成其工作,但您也可以使用其他方式,如使用同步对象、排队过程或发布消息等。值得注意的是,可以等待线程句柄,这就是 TThread.WaitFor 的作用。




在我的测试程序中,我尝试确定应用程序终止时间,这取决于各种退出策略。所有的测试结果都依赖于我的测试环境。
终止时间从VCL表单的OnClose处理程序被调用开始计算,到RTL调用ExitProcess之前结束。此外,该方法不考虑ExitProcess花费的时间,我认为当有悬挂线程时会有所不同。但无论如何,我都没有尝试去衡量它。
工作线程查询不存在主机上的目录。这是我能想到的等待时间最长的情况。每个查询都在一个新的不存在的主机上,否则DirectoryExists会立即返回。
一个定时器启动并收集工作线程。根据IO查询所需的时间(大约为550ms),定时器间隔影响任何给定时间的线程总数。我使用250ms的定时器间隔测试了大约10个线程。
各种调试输出允许在IDE的事件日志中跟踪流程。


  • 我的第一个测试是放弃工作线程 - 只是退出应用程序。我测量的时间是30-65毫秒。同样,这可能导致 ExitProcess 本身需要更长的时间。

  • 接下来,我使用 TerminateThread 终止线程。这需要140-160毫秒。我认为,如果可以计算出 ExitProcess 的时间,那么上一个测试结果实际上更接近这个时间。但我没有证据证明这一点。

  • 接下来,我测试了在运行线程上取消IO请求,然后将它们留在后面。这显着减少了泄漏内存的数量,在大多数情况下完全消除了泄漏。虽然取消请求是异步的,但几乎所有的线程都会立即返回并找到时间来完成。无论如何,这需要160-190毫秒。

我应该在这里指出,DirectoryExists 中的代码存在缺陷,至少在XE2中是如此。函数要做的第一件事就是调用 GetFileAttributes。如果返回值是 INVALID_FILE_ATTRIBUTES,则表示函数失败。这是RTL处理失败的方式:

function DirectoryExists(const Directory: string; FollowLink: Boolean = True): Boolean;
...
  ...
  Result := False;
  Code := GetFileAttributes(PChar(Directory));

  if Code <> INVALID_FILE_ATTRIBUTES then
  begin
    ...
  end
  else
  begin
    LastError := GetLastError;
    Result := (LastError <> ERROR_FILE_NOT_FOUND) and
      (LastError <> ERROR_PATH_NOT_FOUND) and
      (LastError <> ERROR_INVALID_NAME) and
      (LastError <> ERROR_BAD_NETPATH);
  end;
end;

此代码假定除非 GetLastError 返回上述错误代码之一,否则目录存在。这种推理是有缺陷的。事实上,当您取消IO请求时,GetLastError 返回文档中的 ERROR_OPERATION_ABORTED (995),但是无论目录是否存在,DirectoryExists 都返回 true。

  • 等待线程完成而不取消IO需要 330-530 毫秒。这完全消除了内存泄漏。

  • 取消IO请求,然后等待线程完成需要 170-200 毫秒。当然,这里也没有内存泄漏。考虑到任何选项中都没有显着的时间差异,这将是我选择的选项。

我使用的测试代码如下:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls,
  generics.collections;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
    FThreads: TList<TThread>;
  end;

var
  Form1: TForm1;

implementation

uses
  diagnostics;

{$R *.dfm}

type
  TIOThread = class(TThread)
  private
    FTarget: string;
  protected
    constructor Create(Directory: string);
    procedure Execute; override;
  public
    destructor Destroy; override;
  end;

constructor TIOThread.Create(Directory: string);
begin
  FTarget := Directory;
  inherited Create;
end;

destructor TIOThread.Destroy;
begin
  inherited;
  OutputDebugString(PChar(Format('Thread %d destroyed', [ThreadID])));
end;

procedure TIOThread.Execute;
var
  Watch: TStopwatch;
begin
  OutputDebugString(PChar(Format('Thread Id: %d executing', [ThreadID])));
  Watch := TStopwatch.StartNew;
  ReturnValue := Ord(DirectoryExists(FTarget));
  Watch.Stop;
  OutputDebugString(PChar(Format('Thread Id: %d elapsed time: %dms, return: %d',
      [ThreadID, Watch.Elapsed.Milliseconds, ReturnValue])));
end;

//-----------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
  FThreads := TList<TThread>.Create;
  Timer1.Interval := 250;
  Timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FThreads.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ShareName: array [0..12] of Char;
  i: Integer;
  H: THandle;
begin
  for i := FThreads.Count - 1 downto 0 do
    if FThreads[i].Finished then begin
      FThreads[i].Free;
      FThreads.Delete(i);
    end;

  for i := Low(ShareName) to High(ShareName) do
    ShareName[i] := Chr(65 + Random(26));
  FThreads.Add(TIOThread.Create(Format('\\%s\share', [string(ShareName)])));
  OutputDebugString(PChar(Format('Possible thread count: %d', [FThreads.Count])));
end;

var
  ExitWatch: TStopwatch;

// not declared in XE2
function CancelSynchronousIo(hThread: THandle): Bool; stdcall; external kernel32;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i: Integer;
  Handles: TArray<THandle>;
  IOPending: Bool;
  Ret: DWORD;
begin
  ExitWatch := TStopwatch.StartNew;
//  Exit;

  Timer1.Enabled := False;

{
  for i := 0 to FThreads.Count - 1 do
    TerminateThread(FThreads[i].Handle, 0);
  Exit;
//}

  if FThreads.Count > 0 then begin

    SetLength(Handles, FThreads.Count);
    for i := 0 to FThreads.Count - 1 do
      Handles[i] := FThreads[i].Handle;

//{
    OutputDebugString(PChar(Format('Cancelling at most %d threads', [Length(Handles)])));
    for i := 0 to Length(Handles) - 1 do
      if GetThreadIOPendingFlag(Handles[i], IOPending) and IOPending then
          CancelSynchronousIo(Handles[i]);
//}
//{
    Assert(FThreads.Count <= MAXIMUM_WAIT_OBJECTS);
    OutputDebugString(PChar(Format('Will wait on %d threads', [FThreads.Count])));

    Ret := WaitForMultipleObjects(Length(Handles), @Handles[0], True, INFINITE);
    case Ret of
      WAIT_OBJECT_0: OutputDebugString('wait success');
      WAIT_FAILED: OutputDebugString(PChar(SysErrorMessage(GetLastError)));
    end;
//}
    for i := 0 to FThreads.Count - 1 do
      FThreads[i].Free;
  end;
end;

procedure Exiting;
begin
  ExitWatch.Stop;
  OutputDebugString(PChar(
      Format('Total exit time:%d', [ExitWatch.Elapsed.Milliseconds])));
end;

initialization

  ReportMemoryLeaksOnShutdown := True;
  ExitProcessProc := Exiting;

end.

哇,多么惊人的答案啊。非常感谢您做出卓越的解释和非常有用的代码示例所付出的努力。关于DirectoryExists在错误情况下的缺陷,我想知道在我的场景中,是否可以简单地使用 Code := GetFileAttributes(PChar(Path)); AExists := (Code and FILE_ATTRIBUTE_DIRECTORY <> 0) and (Code <> INVALID_FILE_ATTRIBUTES); 或者在目录存在的情况下会不会有任何错误?我之前不知道 CancelSynchronousIo ,这是一个很好的解决方案,可以解决长时间阻塞(通常在我们的网络中长达2250毫秒)的问题。 - HJay
不客气。我想可能会有其他类型的IO故障。我认为我会复制并修改该函数,以便在GetFileAttributes失败且GetLastError返回RTL代码中未指定的任何其他内容时引发或返回错误。 - Sertac Akyuz

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接