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

Question

Based on several questions here on SO, I've implemented a thread which can be killed by user before finishing it's job, or if I'm setting it to self-terminate after a period of time.

Thread implementation:

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.

and how the threads are created in the main unit of the app

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.

What I want is a worker thread that stops either when I'm killing it, either after a period of time. Problem appears when the thread needs to self-terminate, because there I get memory leaks and my event does not get freed.

LE: setting up the FreeOnTerminate to True results in multiple access violations.

Answer 1

The main problem here are the dangling references to your threads stored in t1 and t2.

So you must take care of this references. The best option is to use the TThread.OnTerminate event to get informed whenever a thread has come to an end. Combined with TThread.FreeOnTerminate set to true should solve your problems.

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;

UPDATE

You should never free the instance itself with Self.Free. This will lead you to dangling references by design.