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

时间:2018-03-28 18:19:59

标签: multithreading delphi

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

procedure TMyThread.Execute;
begin
  AExists := DirectoryExists(AFilepath);
end;

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

问题2:是否可以使用TerminateThread终止此类简单线程,或者在这种情况下这可能有害吗?

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

,线程如何通知我它已完成

2 个答案:

答案 0 :(得分:6)

  

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

可能,是的。这取决于sed -e '/^..........003/{w a.txt' -e 'd}' file >b.txt 退出后代码的作用。您最终可能会尝试访问不再存在的内容。

  

Windows会在我之后简单整理一下吗?

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

  

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

ExitProcess()总是有害的。千万不要用它。

  

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

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

  

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

在你的应用想退出之前。

  

我可以在其OnTerminate事件

中释放一个帖子吗?

没有

  

或者这有点太早了?

那,并且因为在同一个对象触发的事件中释放对象总是不安全的。在事件处理程序退出后,RTL仍然需要访问对象。

话虽如此,由于您没有 clean 方式安全地终止线程,我建议不要在线程仍在运行时退出应用程序。当用户请求退出应用程序时,检查是否有线程正在运行,如果是,则向用户显示忙碌的UI,等待所有线程终止,然后退出应用程序。

例如:

CheckSynchronize()

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;

答案 1 :(得分:3)

  

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

从字面上看,这个问题有点不正确。这是因为在调用ExitProcess之后,默认情况下Delphi应用程序的结束方式,没有线程正在运行。

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


  

Windows会简单地整理一下我的意思吗?在IDE内部,我获得了未释放对象的通知,但在IDE之外它只是出现了   和平。

操作系统将在销毁进程地址空间时回收已分配的内存,当销毁进程句柄表时将关闭所有对象句柄,将使用DLL_PROCESS_DETACH调用所有已加载库的入口点。我无法找到关于此的任何文档,但我也假设将调用待处理的IO请求来取消。

但所有这一切并不意味着没有任何问题。事情可能会变得混乱,例如,涉及进程间通信或同步对象。 ExitProcess ExitProcess详细说明了一个这样的例子:如果一个线程在释放其中一个库试图在分离时获取的锁之前消失,那么就会出现死锁。 Documentation博客文章给出了另一个具体的例子,如果一个线程试图进入另一个已经被终止的线程孤立的关键部分,则操作系统强制终止退出进程。

虽然在退出时释放资源可能是有意义的,特别是如果清理花费了相当多的时间,那么对于非平凡的应用程序来说可能会出错。一个强大的策略是在调用ExitProcess之前清理所有内容。 OTOH如果你发现自己处于已经调用TerminateThread的情况,例如由于终止而进程正在从你的dll中删除,那么几乎唯一安全的做法就是把所有东西都抛在脑后并返回 - 其他所有的dll都可以已被卸载,其他所有线程都已终止。


  

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

建议

FreeOnTerminate仅用于最极端的情况,但因为问题有一个大胆的"这个"应该检查代码真正做的是什么。查看RTL代码,我们可以看到可能发生的最糟糕的情况是打开一个文件句柄,只能读取。这在过程终止时间不是问题,因为句柄很快就会关闭。


  

我通常从OnTerminate()事件中的线程中获取结果,然后让线程FreeOnTerminate。如果我想要自由   他们自己,我什么时候该做?

唯一严格的规则是在完成执行后。选择可能会受到应用程序设计的指导。不同的是,你不能使用Execute并且你会保持对线程的引用以释放它们。在我为回答这个问题而工作的测试用例中,当计时器触发时,完成的工作线程被释放,有点像垃圾收集器。


  

我是否可以在其OnTerminate事件中释放一个线程,或者这有点太早了?

在一个自己的事件处理程序中释放对象会导致在释放的实例内存上运行的风险。 This特别警告组件,但通常这适用于所有类。

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


  

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

TThread.WaitFor可以告知线程已完成其工作,但您可以使用其他方法,例如使用同步对象或排队过程或发布消息等。另外值得注意的是,它还是值得注意的。可以在线程句柄上等待,这是OnClose所做的。


<小时/>

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

终止时间是从调用VCL表单的ExitProcess处理程序开始计算的,并且在RTL调用ExitProcess之前结束时测量。此外,此方法不考虑DirectoryExists需要多长时间,我认为当有悬空线程时会有所不同。但无论如何我都没有尝试过测量它。

工作线程查询不存在的主机上是否存在目录。这是我在等待时间上最多的。每个查询都在新的不存在的主机上,否则ExitProcess会立即返回。

计时器启动并收集工作线程。根据IO查询所花费的时间(大约550ms),计时器间隔会影响任何给定时间的线程总数。我测试了大约10个线程,定时器间隔为250ms。

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


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

  • 接下来,我测试了使用ExitProcess终止线程。这需要140-160毫秒。我相信如果可以考虑时间DirectoryExists,这实际上更接近于之前的测试。但我没有证据。

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

我应该注意GetFileAttributes中的代码有缺陷,至少在XE2中是这样。该函数的第一件事就是调用INVALID_FILE_ATTRIBUTESfunction 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; 返回表示函数失败。这就是RTL处理失败的方式:

GetLastError

此代码假定除非GetLastError返回上述错误代码之一,否则目录存在。这种推理是有缺陷的。实际上,当您取消IO请求时,ERROR_OPERATION_ABORTED会返回DirectoryExists(995),但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. 会返回true,无论目录是否存在。

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

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

我使用的测试代码如下:

{{1}}