Delphi - 线程被用户停止或在一段时间后自行终止

Question

基于 SO 上的几个问题，我已经实现了一个线程，它可以在完成工作之前被用户杀死，或者如果我将它设置为在一段时间后自行终止。

线程实现：

unit Unit2;

interface

uses SyncObjs
     ,classes
     ,System.SysUtils
     ,windows;

type
  TMyThread = class(TThread)
  private
    FTerminateEvent: TEvent;
    FTimerStart: Cardinal;
    FTimerLimit: Cardinal;
    FTimeout: Boolean;
  protected
    procedure Execute; override;
    procedure TerminatedSet; override;
  public
    constructor Create(ACreateSuspended: Boolean; Timeout: Cardinal); overload;
    destructor Destroy; override;
  end;

implementation

constructor TMyThread.Create(ACreateSuspended: Boolean; TimeOut: Cardinal);
begin
  inherited Create(ACreateSuspended);
  FTerminateEvent := TEvent.Create(nil, True, False, '');
  FTimerStart:=GetTickCount;
  FTimerLimit:=Timeout;
  FTimeout:=True;
end;

destructor TMyThread.Destroy;
begin
  OutputDebugString(PChar('destroy '+inttostr(Handle)));
  inherited;
  FTerminateEvent.Free;
end;

procedure TMyThread.TerminatedSet;
begin
  FTerminateEvent.SetEvent;
end;

procedure TMyThread.Execute;
var
  FTimerNow:Cardinal;
begin
  FTimerNow:=GetTickCount;

  while not(Terminated) and ((FTimerNow-FTimerStart)<FTimerLimit) do
  begin
   OutputDebugString(PChar('execute '+inttostr(Handle)));

   FTerminateEvent.WaitFor(100);

   FTimerNow:=GetTickCount;
  end;
  if (FTimerNow-FTimerStart) > FTimerLimit then
   begin
    self.Free;
   end;
end;

end.

以及如何在应用程序的主单元中创建线程

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs
  ,unit2, Vcl.StdCtrls
  ;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
   t1,t2: TMyThread;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
//
  if t1 = nil then
   t1 := TMyThread.Create(false,10000)
  else
 if t2 = nil then
   t2 := TMyThread.Create(False,10000);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//
  if t1 <> nil then
   begin
    t1.Free;
    t1 := nil;
   end
  else
   if t2 <> nil then
    begin
     t2.Free;
     t2 := nil;
    end;
end;

end.

我想要的是一个工作线程，它要么在我杀死它时停止，要么在一段时间后停止。当线程需要自行终止时会出现问题，因为我有内存泄漏并且我的事件没有被释放。

LE：将FreeOnTerminate 设置为True 会导致多次访问冲突。

Answer 1

考虑将TThread.FreeOnTerminate 属性设置为true。这将在执行完成后销毁 Thread 对象。

请记住，线程执行结束后，您将无法访问任何公共属性。这种方法仅在您不需要从线程中读取内容时才有效。

Answer 2

将FreeOnTerminate 设置为true，意味着您应该永远尝试访问TMyThread 的实例。尝试访问实例后，您永远无法预测实例是否有效。

在Execute 方法中调用Self.Free 也是错误的。只需让Execute 方法完成它的工作，剩下的就交给我们了。

让线程在某个时间或某个事件后终止的安全方法是将外部事件处理程序传递给您的线程并将FreeOnTerminate 设置为true。

Answer 3

这里的主要问题是对存储在t1 和t2 中的线程的悬空引用。

因此，您必须注意这些引用。最好的选择是在线程结束时使用TThread.OnTerminate 事件来获取通知。结合TThread.FreeOnTerminate 设置为true 应该可以解决您的问题。

procedure TForm1.Button1Click(Sender: TObject);
begin
//
  if t1 = nil then
  begin
   t1 := TMyThread.Create(false,10000);
   t1.OnTerminate := ThreadTerminate;
   t1.FreeOnTerminate := True;
  end
  else if t2 = nil then
  begin
   t2 := TMyThread.Create(False,10000);
   t2.OnTermiante := ThreadTerminate; 
   t2.FreeOnTerminate := True;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//
  if t1 <> nil then
    t1.Terminate
  else if t2 <> nil then
    t2.Terminate;
end;

procedure TForm1.ThreadTerminate( Sender : TObject );
begin
  if Sender = t1 then
    t1 := nil
  else if Sender = t2 then
    t2 := nil;
end;

更新

您永远不应该使用Self.Free 释放实例本身。这将引导您设计悬空引用。