I have a small Windows software created with Delphi 7 where a thread periodically do some action, like save information in a SQLite database. It works just fine, but the same thread never execute when Windows is about to shutdown/reboot/logoff. Here is a simple example:
type
TSaveText = class(TThread)
private
FText: string;
protected
procedure Execute; override;
end;
...
private
procedure WMQueryEndSession(var AMsg: TMessage); message WM_QUERYENDSESSION;
procedure SaveText(const AText: string);
...
procedure AddToLog(const Str: string);
var
Pth: string;
Txt: TextFile;
begin
Pth := ExtractFilePath(ParamStr(0)) + 'log.txt';
try
AssignFile(Txt, Pth);
if not FileExists(Pth) then
ReWrite(Txt);
Append(Txt);
WriteLn(Txt, Trim(Str));
finally
CloseFile(Txt);
end;
end;
procedure TfrmMain.SaveText(const AText: String);
begin
with TSaveText.Create(True) do
begin
FText := AText;
FreeOnTerminate := True;
Priority := tpNormal;
Resume;
end;
end;
procedure TSaveText.Execute;
begin
inherited;
AddToLog(FText);
end;
procedure TfrmMain.WMQueryEndSession(var AMsg: TMessage);
begin
inherited;
SaveText('Windows is about to shutdown/reboot/logoff!');
AMsg.Result := 1;
end;
In this example, the text 'Windows is about to shutdown/reboot/logoff!' is never saved in the log file. But if I remove the action from the thread, it works:
procedure TfrmMain.WMQueryEndSession(var AMsg: TMessage);
begin
inherited;
AddToLog('Windows is about to shutdown/reboot/logoff!');
AMsg.Result := 1;
end;
I'd like to know if there is a way to force thread to execute in this scenario, when Windows is about to shutdown/reboot/logoff.
Thanks!
Related
I need to do a label to blink 5 times using a thread.
When I click on the button, I need the label blinks 5 times.
Now, I have a problem.
when I close the form I have a Memory Leak on Thread.
What am I doing wrong here?
type
TForm1= class(TForm)
...
labelNewMsg:Tlabel;
private
MEvent: TEvent;
procedure Torm1.FormCreate(Sender: TObject);
begin
MEvent := TEvent.Create(nil, False, False, '');
waitNewMessage();
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
MEvent.Free;
end;
procedure TForm1.ButtonDoSetEventClick(Sender: TObject);
begin
Mevent.SetEvent;
end;
procedure TForm1.waitNewMessage;
var
Status:TWaitResult;
begin
TThread.CreateAnonymousThread(
procedure
var IntCnt: Integer;
begin
while not TThread.CurrentThread.CheckTerminated and (not application.terminated) do begin
Sleep(100);
Status:=MEvent.WaitFor(INFINITE);
if Status=wrSignaled then begin
for IntCnt:=1 to 5 do begin
Sleep(1000);
TThread.Synchronize(nil,procedure begin
labelNewMsg.Visible:=not labelNewMsg.Visible;
end);
end;
IntCnt:=0;
MEvent.ResetEvent;
end;
end;
end
).Start;
end;
Hi, I created a second option, but I have the same problem:
procedure TFrm_PrincipalDemo.waitNewMessage;
var
Status:TWaitResult;
begin
TThread.CreateAnonymousThread(
procedure
var IntCnt: Integer;
begin
while MEvent.WaitFor(INFINITE) in [wrSignaled] do begin
if TThread.CurrentThread.CheckTerminated then exit;
MEvent.ResetEvent;
Sleep(100);
for IntCnt:=1 to 5 do begin
Sleep(1000);
TThread.Synchronize(nil,procedure begin
labelNewMsg.Visible:=not labelNewMsg.Visible;
end);
end;
if TThread.CurrentThread.CheckTerminated then exit;
end;
end
).Start;
end;
You are not signaling the thread to terminate itself before your Form is closed. For instance, if the thread is blocked waiting for MEvent, you need to signal MEvent so the thread can wake up and check for termination.
The Application.Terminated property is not set to True until the main message loop has processed a WM_QUIT message from PostQuitMessage(), which Application.Terminate() calls. The program's Application.MainForm calls Application.Terminate() when the Form is closed (not destroyed, that comes later).
If you keep a reference to the TThread object that you create, you can then call the TThread.Terminate() method directly, which sets the thread's Terminated property to True (otherwise, there is no point in calling TThread.CheckTerminated() inside of the thread at all), eg:
type
TForm1 = class(TForm)
...
labelNewMsg: TLabel;
ButtonDoSetEvent: TButton;
...
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure ButtonDoSetEventClick(Sender: TObject);
...
private
MEvent: TEvent;
Thread: TThread;
procedure waitNewMessage;
procedure ThreadTerminated(Sender: TObject);
...
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MEvent := TEvent.Create(nil, False, False, '');
waitNewMessage();
end;
procedure TForm1.FormClose(Sender: TObject; Action: TCloseAction);
begin
if Thread <> nil then
begin
Thread.Terminate;
MEvent.SetEvent;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Thread <> nil then
Thread.OnTerminate := nil;
MEvent.Free;
end;
procedure TForm1.ButtonDoSetEventClick(Sender: TObject);
begin
MEvent.SetEvent;
end;
procedure TForm1.waitNewMessage;
begin
Thread := TThread.CreateAnonymousThread(
procedure
var
IntCnt: Integer;
Status: TWaitResult;
begin
while not TThread.CheckTerminated do begin
Sleep(100);
Status := MEvent.WaitFor(INFINITE);
if (Status = wrSignaled) and (not TThread.CheckTerminated) then begin
for IntCnt := 1 to 5 do begin
Sleep(1000);
TThread.Synchronize(nil,
procedure
begin
labelNewMsg.Visible := not labelNewMsg.Visible;
end
);
end;
end;
end;
end
);
Thread.OnTerminate := ThreadTerminated;
Thread.Start;
end;
procedure TForm1.ThreadTerminated(Sender: TObject);
begin
Thread := nil;
end;
But really, why are you even using a thread at all? Nothing your thread does actually needs to be in a thread in the first place. A simple timer would suffice instead, and it would be safer for the UI, and easier to stop during program shutdown.
type
TForm1 = class(TForm)
...
labelNewMsg: TLabel;
ButtonDoSetEvent: TButton;
NewMsgTimer: TTimer;
...
procedure ButtonDoSetEventClick(Sender: TObject);
procedure NewMsgTimerTimer(Sender: TObject);
...
end;
procedure TForm1.ButtonDoSetEventClick(Sender: TObject);
begin
NewMsgTimer.Tag := 0;
NewMsgTimer.Enabled := True;
end;
procedure TForm1.NewMsgTimerTimer(Sender: TObject);
begin
NewMsgTimer.Tag := NewMsgTimer.Tag + 1;
labelNewMsg.Visible := not labelNewMsg.Visible;
if NewMsgTimer.Tag = 5 then
NewMsgTimer.Enabled := False;
end;
Is it possible to restart TEvent.WaitFor without exiting it? I need to start waiting again when _interval was changed by setter. For example, when one hour was set and I would like to change interval to 15 seconds, changes will come into effect when one hour is elapsed.
_terminatingEvent: TEvent;
procedure TTimerThread.Execute();
begin
inherited;
while not Terminated do begin
try
_terminatingEvent.WaitFor(_interval);
if Assigned(_onTimer) and _enabled then _onTimer(Self);
except
on ex: Exception do _logError(ex);
end;
end;
end;
procedure TTimerThread.TerminatedSet();
begin
_terminatingEvent.SetEvent();
end;
procedure TTimerThread._setInterval(const Value: Integer);
begin
_interval := Value;
//Restart WaitFor here
end;
Currently I "solved" the issue in a following way:
procedure TTimerThread.Execute();
begin
inherited;
while not Terminated do begin
try
if _terminatingEvent.WaitFor(_interval) = wrTimeout then
if Assigned(_onTimer) and _enabled then _onTimer(Self);
except
on ex: Exception do _logError(ex);
end;
end;
end;
procedure TTimerThread.TerminatedSet();
begin
_terminatingEvent.SetEvent();
end;
procedure TTimerThread._setInterval(const Value: Integer);
begin
_interval := Value;
_terminatingEvent.ResetEvent();
end;
It seems that when I use SetEvent instead of ResetEvent, the "set" state is saved permanently and CPU usage jumps to 100%.
You can use two TEvent objects, one for the timer and one for the setter, eg:
type
TTimerThread = class(TThread)
private
_terminatingEvent: TEvent;
_updatedEvent: TEvent;
...
protected
procedure Execute; override;
procedure TerminatedSet; override;
public
constructor Create(ASuspended: Boolean); reintroduce;
destructor Destroy; override;
end;
constructor TTimerThread.Create(ASuspended: Boolean);
begin
inherited Create(ASuspended);
_terminatingEvent := TEvent.Create(nil, True, False, '');
_updatedEvent := TEvent.Create(nil, False, False, '');
end;
destructor TTimerThread.Destroy;
begin
_terminatingEvent.Free;
_updatedEvent.Free;
inherited;
end;
procedure TTimerThread.Execute;
var
Arr: THandleObjectArray;
SignaledObj: THandleObject;
begin
SetLength(Arr, 2);
Arr[0] := _terminatingEvent;
Arr[1] := _updatedEvent;
while not Terminated do
begin
try
case THandleObject.WaitForMultiple(Arr, _interval, False, SignaledObj) of
wrSignaled: begin
if (SignaledObj is TEvent) then (SignaledObj as TEvent).ResetEvent();
end;
wrTimeOut: begin
if Assigned(_onTimer) and _enabled then
_onTimer(Self);
end;
wrError: begin
RaiseLastOSError;
end;
end;
except
on ex: Exception do
_logError(ex);
end;
end;
end;
procedure TTimerThread.TerminatedSet;
begin
inherited;
_terminatingEvent.SetEvent;
end;
procedure TTimerThread._setInterval(const Value: Integer);
begin
if _interval <> Value then
begin
_interval := Value;
_updatedEvent.SetEvent;
end;
end;
Finally I used a combination of SetEvent and ResetEvent. If somebody has a better answer, I will accept it.
procedure TTimerThread.Execute();
begin
inherited;
while not Terminated do begin
try
case _terminatingEvent.WaitFor(_interval) of
wrTimeout: if Assigned(_onTimer) and _enabled then _onTimer(Self);
wrSignaled: _terminatingEvent.ResetEvent();
end;
except
on ex: Exception do _logError(ex);
end;
end;
end;
procedure TTimerThread.TerminatedSet();
begin
_terminatingEvent.SetEvent();
end;
procedure TTimerThread._setInterval(const Value: Integer);
begin
_interval := Value;
_terminatingEvent.SetEvent();
end;
procedure TTimerThread._setEnabled(const Value: Boolean);
begin
if _enabled = Value then Exit();
_enabled := Value;
if _enabled and Suspended then Suspended := False;
_terminatingEvent.SetEvent();
end;
I've coding a multithread application that send and receive TCP packages. I'm with the problem that when I call twice event confirmBoxRecognized(peerIP: string) of the code bellow. I'm getting the following exception:
Cannot call Start on a running or suspended thread
If I check in the thread object I've that terminated == true and suspended == false. Why am I coding wrong?
Following the code:
TThreadReadTCP = class(TThread)
private
context: TfrmBoxTest;
looping: Boolean;
procedure readTCP;
protected
procedure DoTerminate; override;
procedure Execute; override;
public
peerIP: String;
responseObject: TProtocolObject;
constructor Create(CreateSuspended: Boolean; ctx: TFrmBoxTest); overload;
end;
{ TThreadReadTCP }
constructor TThreadReadTCP.Create(CreateSuspended: Boolean; ctx: TFrmBoxTest);
begin
inherited Create(CreateSuspended);
Self.context := ctx;
FreeOnTerminate := True;
end;
procedure TThreadReadTCP.DoTerminate;
begin
looping := false;
inherited DoTerminate();
end;
procedure TThreadReadTCP.Execute;
begin
inherited;
looping := true;
readTCP;
end;
procedure TThreadReadTCP.readTCP;
var
buffer: TBytes;
begin
while looping do
begin
if context.tcpClientBox.Connected then
begin
try
buffer := TEncoding.ASCII.GetBytes(context.tcpClientBox.Socket.ReadLn());
//do something else
except on E:Exception do
ShowMessage('Error receiving TCP buffer with message: ' + e.Message);
end;
end;
end;
end;
procedure TfrmBoxTest.confirmBoxRecognized(peerIP: string);
begin
if (connectBoxTCP(peerIP)) then
begin
if Assigned(threadReadTCP) then
begin
threadReadTCP.Terminate();
threadReadTCP.Start(); // I get the exception here when I run this code twice...
end;
showBoxRecognized();
end;
sendBoxRecognized();
end;
Are there running thread status can I get? Or anyone can explain how can I improve this code to solve this problem?
Thanks a lot!
You get the exception because you can only call Start() on a TThread object one time. Once the thread has been started, you cannot restart it. Once it has been signaled to terminate, all you can do is wait for it to finish terminating, and then destroy the object.
If you want another thread to start running, you have to create a new TThread object, eg:
type
TThreadReadTCP = class(TThread)
private
context: TfrmBoxTest;
protected
procedure Execute; override;
procedure TerminatedSet; override;
public
peerIP: String;
responseObject: TProtocolObject;
constructor Create(ctx: TFrmBoxTest); reintroduce;
end;
constructor TThreadReadTCP.Create(ctx: TFrmBoxTest);
begin
inherited Create(False);
Self.context := ctx;
// NEVER use FreeOnTerminate=True with a thread object that you keep a reference to!
// FreeOnTerminate := True;
end;
procedure TThreadReadTCP.Execute;
var
buffer: TBytes;
begin
while not Terminated do
begin
try
buffer := TEncoding.ASCII.GetBytes(context.tcpClientBox.Socket.ReadLn());
// do something else
except
on E: Exception do
begin
// do something
raise;
end;
end;
end;
end;
procedure TThreadReadTCP.TerminatedSet;
begin
try
context.tcpClientBox.Disconnect(False);
except
end;
end;
...
procedure TfrmBoxTest.confirmBoxRecognized(peerIP: string);
begin
if Assigned(threadReadTCP) then
begin
threadReadTCP.Terminate();
threadReadTCP.WaitFor();
FreeAndNil(threadReadTCP);
end;
if connectBoxTCP(peerIP) then
begin
threadReadTCP := TThreadReadTCP.Create(Self);
showBoxRecognized();
end;
sendBoxRecognized();
end;
I'm trying to put an indy TIdHttp in a thread,
I have tried this :
type
TSendThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
public
http : TIdHTTP;
URL : String;
Method : String;
property ReturnValue;
end;
procedure TSendThread.Execute;
begin
form1.Memo1.lines.Add(http.Get(URL));
ReturnValue := 1;
end;
And in the main :
procedure TForm1.Button1Click(Sender: TObject);
var t : TSendThread;
begin
t := TSendThread.Create(true);
t.URL := 'http://www.url.com/';
t.http := http;
t.Start;
showmessage(IntToStr(t.ReturnValue));
end;
My problem here is that the next instruction gets executed(showmessage) without waiting the thread to be done, i tried to use the "WaitFor" but it freezes the application.
Is there any other workaround?
Thank you.
Use the TThread.OnTerminate event to know when the thread has finished:
type
TSendThread = class(TThread)
private
http : TIdHTTP;
Line: string;
procedure AddLine;
protected
procedure Execute; override;
public
constructor Create; reintroduce;
destructor Destroy; override;
URL : String;
Method : String;
property ReturnValue;
end;
constructor TSendThread.Create;
begin
inherited Create(True);
FreeOnTerminate := True;
http := TIdHTTP.Create;
end;
destructor TSendThread.Destroy;
begin
http.Free;
inherited;
end;
procedure TSendThread.Execute;
begin
Line := http.Get(URL);
Synchronize(AddLine);
ReturnValue := 1;
end;
procedure TSendThread.AddLine;
begin
Form1.Memo1.Lines.Add(Line);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
t : TSendThread;
begin
t := TSendThread.Create;
t.URL := 'http://www.url.com/';
t.OnTerminate := ThreadTerminated;
t.Start;
end;
procedure TForm1.ThreadTerminated(Sender: TObject);
begin
ShowMessage(IntToStr(TSendThread(Sender).ReturnValue));
end;
If you want to use a loop to wait for the thread to finish, without blocking the UI, then you can do it like this:
constructor TSendThread.Create;
begin
inherited Create(True);
//FreeOnTerminate := True; // <-- remove this
http := TIdHTTP.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
t : TSendThread;
h : THandle;
begin
t := TSendThread.Create;
try
t.URL := 'http://www.url.com/';
t.Start;
h := t.Handle;
repeat
case MsgWaitForMultipleObjects(1, h, 0, INFINITE, QS_ALLINPUT) of
WAIT_OBJECT_0: Break;
WAIT_OBJECT_0+1: Application.ProcessMessages;
WAIT_FAILED: RaiseLastOSError;
else
Break;
end;
until False;
ShowMessage(IntToStr(t.ReturnValue));
finally
t.Free;
end;
end;
Download the source code with compiled executable (221 KB (226,925 bytes)): http://www.eyeclaxton.com/download/delphi/skeleton.zip
Why doesn't the Destroy destructor get called if I close the application (click the X button) before the thread has terminated? FastMM4 reports a memory leak with FPauseEvent event.
How should i destroy thread? If someone closes the application before the thread finishes.
unit SkeletonThread;
interface
uses
Windows, Classes, SysUtils, SyncObjs;
type
TOnInitialize = procedure(Sender: TObject; const AMaxValue: Integer) of object;
TOnBegin = procedure(Sender: TObject) of object;
TOnProgress = procedure(Sender: TObject; const APosition: Integer) of object;
TOnPause = procedure(Sender: TObject; const APaused: Boolean) of object;
TOnFinish = procedure(Sender: TObject) of object;
TOnFinalize = procedure(Sender: TObject) of object;
TMasterThread = class(TThread)
private
{ Private declarations }
FPaused: Boolean;
FPosition: Integer;
FMaxValue: Integer;
FOnBegin: TOnBegin;
FOnProgress: TOnProgress;
FOnFinish: TOnFinish;
FOnInitialize: TOnInitialize;
FOnFinalize: TOnFinalize;
FPauseEvent: TEvent;
FOnPause: TOnPause;
procedure BeginEvent();
procedure ProgressEvent();
procedure FinishEvent();
procedure InitializeEvent();
procedure FinalizeEvent();
procedure PauseEvent();
procedure CheckForPause();
protected
{ Protected declarations }
procedure DoInitializeEvent(const AMaxValue: Integer); virtual;
procedure DoBeginEvent(); virtual;
procedure DoProgress(const APosition: Integer); virtual;
procedure DoPauseEvent(const APaused: Boolean); virtual;
procedure DoFinishEvent(); virtual;
procedure DoFinalizeEvent(); virtual;
public
{ Public declarations }
constructor Create(const CreateSuspended: Boolean; const theValue: Integer);
destructor Destroy(); override;
procedure Pause();
procedure Unpause();
published
{ Published declarations }
property IsPaused: Boolean read FPaused write FPaused default False;
property OnInitialize: TOnInitialize read FOnInitialize write FOnInitialize default nil;
property OnBegin: TOnBegin read FOnBegin write FOnBegin default nil;
property OnProgress: TOnProgress read FOnProgress write FOnProgress default nil;
property OnPause: TOnPause read FOnPause write FOnPause default nil;
property OnFinish: TOnFinish read FOnFinish write FOnFinish default nil;
property OnFinalize: TOnFinalize read FOnFinalize write FOnFinalize default nil;
end;
TSkeletonThread = class(TMasterThread)
private
{ Private declarations }
procedure DoExecute(const theValue: Integer);
protected
{ Protected declarations }
procedure Execute(); override;
public
{ Public declarations }
published
{ Published declarations }
end;
implementation
{ TMasterThread }
constructor TMasterThread.Create(const CreateSuspended: Boolean; const theValue: Integer);
begin
inherited Create(CreateSuspended);
Self.FreeOnTerminate := True;
Self.FPosition := 0;
Self.FMaxValue := theValue;
Self.FPaused := False;
Self.FPauseEvent := TEvent.Create(nil, True, True, '');
end;
destructor TMasterThread.Destroy();
begin
FreeAndNil(FPauseEvent);
if (Pointer(FPauseEvent) <> nil) then Pointer(FPauseEvent) := nil;
inherited Destroy();
end;
procedure TMasterThread.DoBeginEvent();
begin
if Assigned(Self.FOnBegin) then Self.FOnBegin(Self);
end;
procedure TMasterThread.BeginEvent();
begin
Self.DoBeginEvent();
end;
procedure TMasterThread.DoProgress(const APosition: Integer);
begin
if Assigned(Self.FOnProgress) then Self.FOnProgress(Self, APosition);
end;
procedure TMasterThread.ProgressEvent();
begin
Self.DoProgress(Self.FPosition);
end;
procedure TMasterThread.DoFinishEvent();
begin
if Assigned(Self.FOnFinish) then Self.FOnFinish(Self);
end;
procedure TMasterThread.FinishEvent();
begin
Self.DoFinishEvent();
end;
procedure TMasterThread.DoInitializeEvent(const AMaxValue: Integer);
begin
if Assigned(Self.FOnInitialize) then Self.FOnInitialize(Self, AMaxValue);
end;
procedure TMasterThread.InitializeEvent();
begin
Self.DoInitializeEvent(Self.FMaxValue);
end;
procedure TMasterThread.DoFinalizeEvent();
begin
if Assigned(Self.FOnFinalize) then Self.FOnFinalize(Self);
end;
procedure TMasterThread.FinalizeEvent;
begin
Self.DoFinalizeEvent();
end;
procedure TMasterThread.DoPauseEvent(const APaused: Boolean);
begin
if Assigned(Self.FOnPause) then Self.FOnPause(Self, APaused);
end;
procedure TMasterThread.PauseEvent();
begin
Self.DoPauseEvent(Self.FPaused);
end;
procedure TMasterThread.Pause();
begin
Self.FPauseEvent.ResetEvent();
Self.FPaused := True;
Self.Synchronize(Self.PauseEvent);
end;
procedure TMasterThread.Unpause();
begin
Self.FPaused := False;
Self.Synchronize(Self.PauseEvent);
Self.FPauseEvent.SetEvent();
end;
procedure TMasterThread.CheckForPause();
begin
if (not (Self.Terminated)) then Windows.Sleep(1);
Self.FPauseEvent.WaitFor(INFINITE);
end;
{ TSkeletonThread }
procedure TSkeletonThread.DoExecute(const theValue: Integer);
var
X: Integer;
begin
Self.Synchronize(InitializeEvent);
try
Self.Synchronize(BeginEvent);
try
for X := 0 to (theValue - 1) do
begin
Self.CheckForPause();
if (not Self.FPaused) and (not Self.Terminated) then
begin
Self.FPosition := Self.FPosition + 1;
Self.Synchronize(ProgressEvent);
end
else begin
Break;
end;
end;
for X := Self.FPosition downto 1 do
begin
Self.CheckForPause();
if (not Self.FPaused) and (not Self.Terminated) then
begin
Self.FPosition := X;
Self.Synchronize(ProgressEvent);
end
else begin
Break;
end;
end;
finally
Self.Synchronize(FinishEvent);
end;
finally
Self.Synchronize(FinalizeEvent);
end;
end;
procedure TSkeletonThread.Execute();
begin
Self.DoExecute(Self.FMaxValue);
end;
end.
You have to terminate the thread yourself (tell it to stop). One way is to use the Terminate procedure of the thread, but you have to check for this in the thread Execute method. Something like this:
procedure Execute;
begin
inherited;
while not Terminated do
begin
// do your job
end;
end;
procedure TForm1.StopThread;
begin
MyThread.Terminate;
// wait and block until the scheduling thread is finished
AResult := WaitForSingleObject(MyThread.Handle, cShutdownTimeout);
// check if we timed out
if AResult = WAIT_TIMEOUT then
TerminateThread(MyThread.Handle, 0);
end;
Or you can use signalization build into windows so you do not have to loop.
procedure Execute;
begin
inherited;
while not Terminated do
begin
WaitStatus := WaitForSingleObject(FTermEvent, Max(0, SleepInterval));
// check what was the cause for signalization
if WaitStatus <> WAIT_TIMEOUT then
Terminate;
end;
end;
procedure TForm1.StopThread;
begin
// Terminate the thread
SetEvent(FTermEvent);
// close the handle
CloseHandle(FTermEvent);
// wait and block until the scheduling thread is finished
AResult := WaitForSingleObject(MyThread.Handle, cShutdownTimeout);
// check if we timed out
if AResult = WAIT_TIMEOUT then
TerminateThread(MyThread.Handle, 0);
end;
Signalization can be very neat way of signaling for termination because you can use WaitForMultipleObjects and release the wait in different conditions. I used WaitForSingleObject to not complicate things to much.
Also be sure to set "FreeOnTerminate := True" in thread constructor. Oh and the hard termination at the end is optional of course. It can be dangerous. You know best yourself if you will use it or not. You can also wait for a longer period or infinite if you are sure the thread will stop eventually.