那些遇到过的问题

Delphi:在应用程序退出时杀死线程？

HJa*_*Jay 7 delphi multithreading

背景:我需要检查一堆网络驱动器或远程计算机是否可用.由于每个都DirectoryExists()需要大量时间直到潜在的超时,我在单独的线程中执行检查.最终用户可能会在某些检查仍在运行时关闭应用程序.由于DirectoryExists()块,我没有机会使用经典while not Terminated方法.

procedure TMyThread.Execute;
begin
  AExists := DirectoryExists(AFilepath);
end;
Run Code Online (Sandbox Code Playgroud)

问题1:当应用程序退出时,某些线程是否仍在运行是否存在问题？Windows会简单地整理一下我就是这样吗？在IDE内部,我收到了未释放对象的通知,但在IDE之外它似乎很平静.

问题2:在这种情况下是否有可能终止这样的简单线程TerminateThread或者这可能是有害的？

问题3:我通常从OnTerminate()事件中的线程获取结果,然后让线程FreeOnTerminate.如果我想自己释放它们,我什么时候应该这样做？我可以在它的OnTerminate事件中释放一个线程,或者这有点太早了？一个线程如何通知我,如果没有,它会被完成OnTerminate？

Rem*_*eau 6

当应用程序退出时,某些线程仍在运行是否存在问题？

可能,是的.这取决于DirectoryExists()退出后代码的作用.您最终可能会尝试访问不再存在的内容.

Windows会简单地整理一下我就是这样吗？

为确保正确清理所有内容,您有责任终止自己的线程.当主VCL线程完成运行时,它将调用ExitProcess(),这将强制终止仍在运行的任何辅助线程,这将不允许它们自己清理,或者通知任何加载的DLL它们正从线程分离.

是否可以使用TerminateThread终止这样的简单线程,或者这在这种情况下是否有潜在危害？

TerminateThread()总是有潜在危害.千万不要用它.

我通常从OnTerminate()事件中的Threads获取结果,然后让线程FreeOnTerminate.

如果主要消息循环在线程终止之前退出,那将无效.默认情况下,TThread.OnTerminate通过调用来触发事件TThread.Synchronize().主消息循环停止运行后,将无法处理待处理的Synchronize()请求,除非您在应用程序出口处运行自己的循环以调用RTL的CheckSynchronize()过程,直到所有线程完全终止.

如果我想自己释放它们,我什么时候应该这样做？

在您的应用想退出之前.

我可以在其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;
Run Code Online (Sandbox Code Playgroud) 

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;
Run Code Online (Sandbox Code Playgroud)

或者:

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;
Run Code Online (Sandbox Code Playgroud)

Ser*_*yuz 5

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

从字面上看，这个问题有点畸形。这是因为 afterExitProcess被调用（这是 Delphi 应用程序默认结束的方式），没有线程正在运行。

“某些线程没有机会完成是否是一个问题”这个问题的答案取决于这些线程未能完成的内容。您必须仔细分析线程代码，但一般来说这可能容易出错。


Windows 会简单地在我之后进行整理吗？在 IDE 内部，我收到未释放对象的通知，但在 IDE 外部，它看起来很平静。

当进程地址空间被破坏时，操作系统将回收分配的内存，当进程句柄表被破坏时，所有对象句柄将被关闭，所有加载的库的入口点将被调用DLL_PROCESS_DETACH。我找不到任何相关文档，但我还假设挂起的 IO 请求将被调用取消。

但这一切并不意味着不会出现任何问题。例如，涉及进程间通信或同步对象时，事情可能会变得混乱。文档详细介绍了ExitProcess这样一个示例：如果线程在释放某个库在分离时尝试获取的锁之前消失，则会出现死锁。这篇博文给出了另一个具体的例子，如果一个线程试图进入一个被另一个已经终止的线程孤立的关键部分，则退出的进程将被操作系统强制终止。

虽然在退出时放弃资源释放可能是有意义的，特别是如果清理需要花费相当多的时间，但对于一个重要的应用程序来说，可能会出错。ExitProcess一个强大的策略是在调用之前清理所有内容。OTOH，如果您发现自己处于已被调用的情况ExitProcess，例如进程由于终止而与您的 dll 分离，那么几乎唯一安全的做法就是留下所有内容并返回 - 所有其他 dll 可能已经被卸载并且所有其他线程都终止。


是否可以使用 TerminateThread 终止此类简单线程，或者在这种情况下这可能有害吗？

TerminateThread建议仅在最极端的情况下使用，但由于问题有一个粗体“THIS”，因此应该检查代码的实际用途。查看 RTL 代码，我们可以看到最糟糕的情况是使文件句柄保持打开状态，而该句柄仅供读取。这在进程终止时不是问题，因为句柄很快就会关闭。


我通常从 OnTerminate() 事件中的线程获取结果，然后让线程 FreeOnTerminate。如果我想自己释放它们，我应该什么时候做？

唯一严格的规则是在它们执行完毕之后。选择可能会以应用程序的设计为指导。不同的是，您将无法使用FreeOnTerminate，并且您将保留对线程的引用以便能够释放它们。在我为回答这个问题而进行的测试用例中，当计时器触发时，已完成的工作线程将被释放，有点像垃圾收集器。


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

在其自己的事件处理程序之一中释放对象会导致在释放的实例内存上进行操作的风险。该文档特别警告组件不要这样做，但通常这适用于所有类。

即使您想忽略警告，这也会陷入僵局。尽管处理程序在Execute返回后被调用，OnTerminate但仍然与 ThreadProc 同步。如果您尝试在处理程序中释放线程，它将导致主线程等待该线程完成 - 这是等待主线程从 中返回OnTerminate，这是一个死锁。


如果不使用 OnTerminate，线程如何通知我它已完成？

OnTerminate可以很好地通知线程已完成其工作，尽管您可以使用其他方法，例如使用同步对象或对过程进行排队或发布消息等。还值得注意的是，可以等待线程句柄，这TThread.WaitFor就是。



在我的测试程序中，我尝试根据各种退出策略来确定应用程序终止时间。所有测试结果都取决于我的测试环境。

终止时间是从OnClose调用 VCL 表单的处理程序时开始测量的，一直到ExitProcessRTL 调用之前为止。另外，此方法没有考虑需要多长时间ExitProcess，我认为当存在悬空线程时，这会有所不同。但无论如何我都没有尝试去测量它。

工作线程查询不存在的主机上是否存在目录。这是我能想到的最长等待时间。每个查询都在一个新的不存在的主机上，否则DirectoryExists立即返回。

计时器启动并收集工作线程。根据 IO 查询所花费的时间（大约 550 毫秒），计时器间隔会影响任何给定时间的线程总数。我在大约 10 个线程上进行了测试，计时器间隔为 250 毫秒。

各种调试输出允许跟踪 IDE 事件日志中的流程。


  • 我的第一个测试是留下工作线程 - 只需退出应用程序即可。我测量的时间是30-65ms。同样，这可能会导致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;
Run Code Online (Sandbox Code Playgroud)

此代码假定除非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.
Run Code Online (Sandbox Code Playgroud)

归档时间：

查看次数：

1004 次

最近记录：

7 年，8 月 前
delphi - 在关闭应用程序时终止所有线程(TThread) 4
更多相关链接
相关归档
如果我在同一个类上同步两个方法,它们可以同时运行吗？ 143
如何可靠地重现此python代码中的竞争条件？ 29
如何在Delphi中模拟下拉表单？ 18
使用Delphi利用GPGPU技术？ 15
什么是线程(什么是线程)？ 7
C#:如果操作首先完成,则使用RegisterWaitForSingleObject 7
Delphi XE4"找不到类"但编译得很好 7
在Python 3中发送多个HTTP请求的最佳方法是什么？ 7
在Docker for Windows中运行正常的Win32应用程序 5
禁用表单上升到顶部 4
难疑归档
JavaScript中使用"严格"做什么,背后的原因是什么？ 7339
应该在JavaScript比较中使用哪个等于运算符(== vs ===)？ 5666
在JavaScript中深度克隆对象的最有效方法是什么？ 5181
如何格式化JavaScript日期 1945
垂直对齐图像旁边的文字？ 1881
使用pip升级所有包 1859
如何在HTTP POST请求中发送参数？ 1396
如何将键/值对添加到JavaScript对象？ 1270
检查jQuery中是否存在元素 1209
使用Twitter Bootstrap 3将列居中 1109