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

Delphi - thread stopped by user or self-terminate after a period of time

基于这里关于 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 会导致多次访问冲突。

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

请记住,线程执行结束后您将无法访问任何 public 属性。这种方法只有在你不需要从线程终止后读取内容时才有效。

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

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

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

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

因此您必须处理好这些参考资料。最好的选择是使用 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 释放实例本身。这将导致您设计成悬挂引用。