9

If I create a (suspended) thread from the main thread as such:

  with TMyThread.Create(True) do
  begin
    OnTerminate := ThreadTerminated;
    FreeOnTerminate := False;
    Start;
  end;

How do I go about freeing that instance once it's completed? (ie the Execute procedure has finished executing - assume I've captured exceptions).

This Proper way of destroying a tthread object link shows a way (via the PostMessage procedure) which works fine and makes sense. However, what if I create the thread and I don't have a handle to a form or something where I can invoke the PostMessage procedure. eg I create the thread within a class descended directly from TObject?

TMyClass = class
public
  procedure DoSomething;
end;

TMyClass.DoSomething;
begin
      with TMyThread.Create(True) do
      begin
        OnTerminate := ThreadTerminated;
        FreeOnTerminate := False;
        Start;
      end;  
end;

So, I guess, how do I free a thread without access to a form handle?

Thanks

Community
  • 1
  • 1
Jason
  • 2,572
  • 3
  • 34
  • 41
  • 3
    Why are you creating the thread but not remembering the TThread instance? – David Heffernan Nov 24 '11 at 07:16
  • I guess in the example above there was no need. I don't see it necessary to create a variable/property if I never refer to it again. It could be argued perhaps then that I could use FreeOnTerminate := True but even if I did keep a reference to it, where would I free it? – Jason Nov 24 '11 at 08:02
  • 3
    What happens if the process terminates before the thread? Or if a DLL unloads before the thread completes? In my view it is folly to start threads and without being able to tidy them all up at module unload time. – David Heffernan Nov 24 '11 at 08:25
  • That could not help. The problem with setting a thread running and losing any reference to it is that bad things will happen if the owning module terminates while the thread is running. You need to be able to reliably and gracefully terminate all your threads before the owning module unloads. – David Heffernan Nov 24 '11 at 21:50
  • you are right, of course. but for the purposes of the exercise, i was more interested in determining when the thread will be freed. Initially I looked at freeing the object in the OnTerminate event (which contains the thread object) but that isn't the best place for it (in XE2 it deadlocks). Hence my question. – Jason Nov 24 '11 at 21:58
  • You would free it when it was done doing whatever it does. – David Heffernan Nov 24 '11 at 22:01
  • 1
    In fact I've just searched for and found a FreeOnTerminate in my own code which I have removed. Thanks for prompting me to do this! – David Heffernan Nov 24 '11 at 22:23

1 Answers1

7

Obviously, somewhere there has to be a reference to the instantiated thread. But I can relate to your wish: you want a always-done-never-care solution.

I suggest you manage the thread's existence by a separate ThreadController class:

unit Unit2;

interface

uses
  Classes, SysUtils, Forms, Windows, Messages;

type
  TMyThreadProgressEvent = procedure(Value: Integer;
    Proceed: Boolean) of object;

procedure RunMyThread(StartValue: Integer; OnProgress: TMyThreadProgressEvent);

implementation

type
  TMyThread = class(TThread)
  private
    FException: Exception;
    FOnProgress: TMyThreadProgressEvent;
    FProceed: Boolean;
    FValue: Integer;
    procedure DoProgress;
    procedure HandleException;
    procedure ShowException;
  protected
    procedure Execute; override;
  end;

  TMyThreadController = class(TObject)
  private
    FThreads: TList;
    procedure StartThread(StartValue: Integer;
      OnProgress: TMyThreadProgressEvent);
    procedure ThreadTerminate(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
  end;

var
  FMyThreadController: TMyThreadController;

function MyThreadController: TMyThreadController;
begin
  if not Assigned(FMyThreadController) then
    FMyThreadController := TMyThreadController.Create;
  Result := FMyThreadController
end;

procedure RunMyThread(StartValue: Integer; OnProgress: TMyThreadProgressEvent);
begin
  MyThreadController.StartThread(StartValue, OnProgress);
end;

{ TMyThreadController }

constructor TMyThreadController.Create;
begin
  inherited;
  FThreads := TList.Create;
end;

destructor TMyThreadController.Destroy;
var
  Thread: TThread;
begin
  while FThreads.Count > 0 do
  begin
    Thread := FThreads[0]; //Save reference because Terminate indirectly
                           //extracts the list entry in OnTerminate!
    Thread.Terminate; //Indirectly decreases FThreads.Count
    Thread.Free;
  end;
  FThreads.Free;
  inherited Destroy;
end;

procedure TMyThreadController.StartThread(StartValue: Integer;
  OnProgress: TMyThreadProgressEvent);
var
  Thread: TMyThread;
begin
  Thread := TMyThread.Create(True);
  FThreads.Add(Thread); //Add to list before a call to Resume because once
                        //resumed, the thread might be gone already!
  Thread.FValue := StartValue;
  Thread.FOnProgress := OnProgress;
  Thread.OnTerminate := ThreadTerminate;
  Thread.Resume;
end;

procedure TMyThreadController.ThreadTerminate(Sender: TObject);
begin
  FThreads.Extract(Sender);
end;

{ TMyThread }

procedure TMyThread.DoProgress;
begin
  if (not Application.Terminated) and Assigned(FOnProgress) then
    FOnProgress(FValue, FProceed);
end;

procedure TMyThread.Execute;
begin
  try
    FProceed := True;
    while (not Terminated) and (not Application.Terminated) and FProceed and
      (FValue < 20) do
    begin
      Synchronize(DoProgress);
      if not FProceed then
        Break;
      Inc(FValue);
      Sleep(2000);
    end;
    //In case of normal execution ending, the thread may free itself. Otherwise,
    //the thread controller object frees the thread.
    if not Terminated then
      FreeOnTerminate := True;
  except
    HandleException;
  end;
end;

procedure TMyThread.HandleException;
begin
  FException := Exception(ExceptObject);
  try
    if not (FException is EAbort) then
      Synchronize(ShowException);
  finally
    FException := nil;
  end;
end;

procedure TMyThread.ShowException;
begin
  if GetCapture <> 0 then
    SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  if (FException is Exception) and (not Application.Terminated) then
    Application.ShowException(FException)
  else
    SysUtils.ShowException(FException, nil);
end;

initialization

finalization
  FreeAndNil(FMyThreadController);

end.

To run this sample thread which counts from 5 to 19 in 2 second intervals and provides feedback and an opportunity to a premature termination, call from the main thread:

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure MyThreadProgress(Value: Integer; Proceed: Boolean);
  end;

...

procedure TForm1.Button1Click(Sender: TObject);
begin
  RunMyThread(5, MyThreadProgress);
end;

procedure TForm1.MyThreadProgress(Value: Integer; Proceed: Boolean);
begin
  Caption := IntToStr(Value);
end;

This thread automatically kills itself on either thread's or application's termination.

Maybe this unit is a little overkill for your situation because it is capable of handling multiple threads (of the same type), but I think it answers your question. Adjust to your liking.

Partial origin of this answer: NLDelphi.com.

NGLN
  • 43,011
  • 8
  • 105
  • 200
  • This is effectively how I i'll go about it. Although I'm not sure setting FreeOnTerminate to True at the end of the Execute procedure is best practise? I don't know. I've seen conflicting reports about that on the internets. Thanks – Jason Nov 24 '11 at 22:01
  • It should not be a problem according to the RTL code. There is however a problem with `FreeOnTerminate = True` when destroying the thread prematurely, see [FreeOnTerminate not possible in combination with Free?](http://www.nldelphi.com/forum/showthread.php?t=24450) – NGLN Nov 25 '11 at 05:26
  • ... which [this question](http://stackoverflow.com/questions/9029730) deals with. – NGLN Oct 05 '12 at 06:39