Can I raise an exception from within OnTerminate event of a TThread? - delphi

I wrote a TThread descendant class that, if an exception is raised, saves exception's Class and Message in two private fields
private
//...
FExceptionClass: ExceptClass; // --> Class of Exception
FExceptionMessage: String;
//...
I thought I could raise a similar exception in the OnTerminate event, so that the main thread could handle it (here is a simplified version):
procedure TMyThread.Execute;
begin
try
DoSomething;
raise Exception.Create('Thread Exception!!');
except
on E:Exception do
begin
FExceptionClass := ExceptClass(E.ClassType);
FExceptionMessage := E.Message;
end;
end;
end;
procedure TMyThread.DoOnTerminate(Sender: TObject);
begin
if Assigned(FExceptionClass) then
raise FExceptionClass.Create(FExceptionMessage);
end;
I expect that the standard exception handling mechanism occurs (an error dialog box),
but I get mixed results: The dialog appears but is followed by a system error, or
or (more funny) the dialog appears but the function that called the thread goes on as if the exception were never raised.
I guess that the problem is about the call stack.
Is it a bad idea?
Is there another way to decouple thread exceptions from the main thread but reproducing them the standard way?
Thank you

The fundamental issue in this question, to my mind is:
What happens when you raise an exception in a thread's OnTerminate event handler.
A thread's OnTerminate event handler is invoked on the main thread, by a call to Synchronize. Now, your OnTerminate event handler is raising an exception. So we need to work out how that exception propagates.
If you examine the call stack in your OnTerminate event handler you will see that it is called on the main thread from CheckSynchronize. The code that is relevant is this:
try
SyncProc.SyncRec.FMethod; // this ultimately leads to your OnTerminate
except
SyncProc.SyncRec.FSynchronizeException := AcquireExceptionObject;
end;
So, CheckSynchronize catches your exception and stashes it away in FSynchronizeException. Excecution then continues, and FSynchronizeException is later raised. And it turns out, that the stashed away exception is raised in TThread.Synchronize. The last dying act of TThread.Synchronize is:
if Assigned(ASyncRec.FSynchronizeException) then
raise ASyncRec.FSynchronizeException;
What this means is that your attempts to get the exception to be raised in the main thread have been thwarted by the framework which moved it back onto your thread. Now, this is something of a disaster because at the point at which raise ASyncRec.FSynchronizeException is executed, in this scenario, there is no exception handler active. That means that the thread procedure will throw an SEH exception. And that will bring the house down.
So, my conclusion from all this is the following rule:
Never raise an exception in a thread's OnTerminate event handler.
You will have to find a different way to surface this event in your main thread. For example, queueing a message to the main thread, for example by a call to PostMessage.
As an aside, you don't need to implement an exception handler in your Execute method since TThread already does so.
The implementation of TThread wraps the call to Execute in an try/except block. This is in the ThreadProc function in Classes. The pertinent code is:
try
Thread.Execute;
except
Thread.FFatalException := AcquireExceptionObject;
end;
The OnTerminate event handler is called after the exception has been caught and so you could perfectly well elect to re-surface it from there, although not by naively raising it as we discovered above.
Your code would then look like this:
procedure TMyThread.Execute;
begin
raise Exception.Create('Thread Exception!!');
end;
procedure TMyThread.DoOnTerminate(Sender: TObject);
begin
if Assigned(FatalException) and (FatalException is Exception) then
QueueExceptionToMainThread(Exception(FatalException).Message);
end;
And just to be clear, QueueExceptionToMainThread is some functionality that you have to write!

AFAIK the OnTerminate event is called with the main thread (Delphi 7 source code):
procedure TThread.DoTerminate;
begin
if Assigned(FOnTerminate) then Synchronize(CallOnTerminate);
end;
The Synchronize() method is in fact executed in the CheckSynchronize() context, and in Delphi 7, it will re-raise the exception in the remote thread.
Therefore, raising an exception in OnTerminate is unsafe or at least without any usefulness, since at this time TMyThread.Execute is already out of scope.
In short, the exception will never be triggered in your Execute method.
For your case, I suspect you should not raise any exception in OnTerminate, but rather set a global variable (not very beautiful), add an item in a thread-safe global list (better), and/or raise a TEvent or post a GDI message.

A synchonized call of an exception will not prevent the thread from being interrupted.
Anything in function ThreadProc after Thread.DoTerminate; will be omitted.
The code above has two test cases
One with commented / uncommented synchronized exception //**
The second with (un)encapsulated exception in the OnTerminate event, which will lead even to an omitted destruction if used unencapsulated.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TMyThread=Class(TThread)
private
FExceptionClass: ExceptClass;
FExceptionMessage: String;
procedure DoOnTerminate(Sender: TObject);
procedure SynChronizedException;
procedure SynChronizedMessage;
public
procedure Execute;override;
Destructor Destroy;override;
End;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TMyThread.SynChronizedException;
begin
Showmessage('> SynChronizedException');
raise Exception.Create('Called Synchronized');
Showmessage('< SynChronizedException'); // will never be seen
end;
procedure TMyThread.SynChronizedMessage;
begin
Showmessage('After SynChronizedException');
end;
procedure TMyThread.Execute;
begin
try
OnTerminate := DoOnTerminate; // first test
Synchronize(SynChronizedException); //** comment this part for second test
Synchronize(SynChronizedMessage); // will not be seen
raise Exception.Create('Thread Exception!!');
except
on E:Exception do
begin
FExceptionClass := ExceptClass(E.ClassType);
FExceptionMessage := E.Message;
end;
end;
end;
destructor TMyThread.Destroy;
begin
Showmessage('Destroy ' + BoolToStr(Finished)) ;
inherited;
end;
procedure TMyThread.DoOnTerminate(Sender: TObject);
begin
{ with commented part above this will lead to a not called destructor
if Assigned(FExceptionClass) then
raise FExceptionClass.Create(FExceptionMessage);
}
if Assigned(FExceptionClass) then
try // just silent for testing
raise FExceptionClass.Create(FExceptionMessage);
except
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
With TMyThread.Create(false) do FreeOnTerminate := true;
ShowMessage('Hallo');
end;
end.

I don't know why you want to raise the exception in the main thread, but I will assume it is to do minimal exception handling - which I would consider to be something like displaying the ClassName and Message of the Exception object in a nice way on the UI. If this is all you want to do then how about if you catch the exception in your thread, then save the Exception.ClassName and Exception.Message strings to private variables on the main thread. I know it's not the most advanced method, but I've done this and I know it works. Once the thread terminates because of the exception you can display those 2 strings on the UI. All you need now is a mechanism for notifying the main thread that the worker thread has terminated. I've achieved this in the past using Messages but I can't remember the specifics.
Rather than try to solve "How do I solve problem A by doing B?" you could reframe your situation as "How do I solve problem A whichever way possible?".
Just a suggestion. Hope it helps your situation.

Related

How to catch unhandled exception that are raised in background thread?

I have for habit to execute anonymous thread like :
TThread.CreateAnonymousThread(
procedure
begin
.....
end).start;
But the problem is that if some unhandled exception will raise during the execution, then i will be not warned about it! For the main thread we have Application.OnException. Do we have something similar for background thread ?
TThread has a public FatalException property:
If the Execute method raises an exception that is not caught and handled within that method, the thread terminates and sets FatalException to the exception object for that exception. Applications can check FatalException from an OnTerminate event handler to determine whether the thread terminated due to an exception.
For example:
procedure TMyForm.DoSomething;
begin
...
thread := TThread.CreateAnonymousThread(...);
thread.OnTerminate := ThreadTerminated;
thread.Start;
...
end;
procedure TMyForm.ThreadTerminated(Sender: TObject);
begin
if TThread(Sender).FatalException <> nil then
begin
...
end;
end;
N̶o̶,̶ ̶t̶h̶e̶r̶e̶ ̶i̶s̶ ̶n̶o̶t̶h̶i̶n̶g̶ ̶s̶i̶m̶i̶l̶a̶r̶ ̶f̶o̶r̶ ̶a̶ ̶b̶a̶c̶k̶g̶r̶o̶u̶n̶d̶ ̶t̶h̶r̶e̶a̶d̶.̶ (Thanks, Remy!)
The best solution is to always be absolutely certain to never let an exception escape from a thread. Ideally, your thread procedures should look something like this :
TThread.CreateAnonymousThread(
procedure
begin
try
{ your code}
except
{on E : Exception do}
{... handle it!}
end;
end).start;
Ok, finally I got the best answer :
Assign the global ExceptionAcquired procedure to our own implementation (it is nil by default). This procedure gets called for unhandled exceptions that happen in other threads than the main thread.
ExceptionAcquired := MyGlobalExceptionAcquiredHandler;
The answer of J... and Remy Lebeau are good with what delphi offer, but i need a little more and I finally decide to modify a little the unit System.Classes
var
ApplicationHandleThreadException: procedure (Sender: TObject; E: Exception) of object = nil;
function ThreadProc(const Thread: TThread): Integer;
...
try
Thread.Execute;
except
Thread.FFatalException := AcquireExceptionObject;
if assigned(ApplicationHandleThreadException) and
assigned(Thread.FFatalException) and
(Thread.FFatalException is Exception) and
(not (Thread.FFatalException is EAbort)) then
ApplicationHandleThreadException(Thread, Exception(Thread.FFatalException));
end;
in this way you just need to assign ApplicationHandleThreadException to handle unhandled exception raise in any TThread. You don't need to be worry about the multi thread because global var like ExceptAddr are declared as threadvar so everything work fine, even to retrieve the stack trace !
https://quality.embarcadero.com/browse/RSP-21269

Delphi TThread handle error

I am reading "Delphi High performance" and there is something that I am missing. Given this code as test:
type TTest = class(TThread)
private
amemo: TMemo;
public
constructor Create(ss: boolean; memo: TMemo);
protected
procedure Execute; override;
end;
constructor TTest.Create(ss: boolean; memo: TMemo);
begin
inherited Create(ss);
FreeOnTerminate := true;
amemo := memo;
end;
procedure TTest.Execute;
var i: uint32;
begin
inherited;
i := 0;
while not Terminated do
begin
Inc(i);
Synchronize(procedure
begin amemo.Lines.Add(i.ToString) end);
Sleep(1000);
end;
end;
Very simply, this thread prints some numbers in a memo. I start the thread suspended and so I have to call this piece of code:
procedure TForm1.Button1Click(Sender: TObject);
begin
thread := TTest.Create(true, Memo1);
thread.Start;
end;
I have always stopped the thread calling thread.Terminate; but reading the book I see that Primoz stops a thread like this:
procedure TForm1.Button2Click(Sender: TObject);
begin
thread.Terminate;
thread.WaitFor; //he adds this method call
//FreeAndNil(thread)
//there is the above line as well in the code copied from the book but I have removed it since I have set FreeOnTerminate := true (so I dont have to worry about freeing the obj).
end;
At this point, if I run the code using only Terminate I have no problems. If I run the code with Terminate + WaitFor I get this error:
I have read more coding in delphi too and I see that Nick Hodges just makes a call to Terminate;. Is calling Terminate; enough to safey stop a thread? Note that I've set FreeOnTerminate := true so I don't care about the death of the object. Terminated should stop the execution (what is inside execute) and so it should be like this:
Call Terminated
Execute stops
Thread stops execution
Thread is now free (FreeOnTerminate := true)
Please tell me what I'm missing.
Note.
In the book the thread doesn't have FreeOnTerminate := true. So the thread needs to be freed manually; I guess that this is the reason why he calls
thread.Terminate;
thread.WaitFor;
FreeAndNil(thread)
I agree on Terminate (stop the thread= and FreeAndNil (free the object manually) but the WaitFor?
Please tell me what I'm missing.
The documentation for FreeOnTerminate explicitly says that you cannot use the Thread in any way after Terminate.
That includes your WaitFor call, which would work on a possibly already free'd object. This use-after-free can trigger the error above, among other even more "interesting" behaviours.

Who is responsible for error checking and handling?

Who is responsible for error checking and handling?
I don't have any of the expensive component libraries such as DevExpress or TMS Components etc so I cannot look at source to get an idea of how most components manage error handling.
Specifically what I am wanting to know is should there be a limit to how many errors and warnings component developers should try to capture? Is there a balance between having meaningful error checking and just making it too easy for developers using your component?
Here is an example using a few scenarios:
Note these are directly from the components source (made up for example purposes)
procedure TMyComponent.AddFromFile(FileName: string);
begin
FBitmap.LoadFromFile(FileName);
end;
or
procedure TMyComponent.AddFromFile(FileName: string);
begin
if FileExists(FileName) then
begin
FBitmap.LoadFromFile(FileName);
end
else
raise Exception.Create(FileName + ' does not exist.');
end;
And these last two are using an instance of the component at runtime:
procedure TForm1.FormCreate(Sender: TObject);
begin
MyComponent1.AddFromFile('D:\Test.bmp');
end;
or
procedure TForm1.FormCreate(Sender: TObject);
begin
if FileExists('D:\Test.bmp') then
begin
MyComponent1.AddFromFile('D:\Test.bmp');
end
else
raise Exception.Create('D:\Test.bmp does not exist.');
end;
I guess it comes down to who should error check and handle what? Is the component developer responsible for handling these types of checking or the user of the component?
As I am writing this I believe both component developer and user should handle such checking but I am unsure, so I am looking for what the general consensus amongst developers is.
Thanks.
To answer your specific queestion:
Specifically what I am wanting to know is should there be a limit to how many errors and warnings component developers should try to capture? Is there a balance between having meaningful error checking and just making it too easy for developers using your component?
The general rule about exception handling is that you should only catch exceptions you know how to handle, and let others propagate to higher code that may know how to handle it. If an exception is raised inside of your component, the component needs to decide whether to:
handle that particular exception internally and gracefully move on to other things without notifying the caller at all.
re-throw the exception (maybe with tweaks made to it), or re-throw a whole new exception, to allow the caller to identify and handle that specific failure, if desired.
ignore the exception (don't catch it at all) and just let it propagate as-is.
If an API used by your component returns an error code instead of raising an exception, the component needs to decide how to handle that as well. Whether to ignore the error and move on, or raise an exception to make it more apparent.
In your particular example, I prefer the following approach:
type
EMyComponentAddError = class(Exception)
private
FFileName: String;
begin
constructor CreateWithFileName(const AFileName: string);
property FileName: string read FFileName;
end;
constructor EMyComponentAddError.CreateWithFileName(const AFileName: string);
begin
inherited CreateFmt('Unable to add file: %s', [AFileName]);
FFileName := AFileName;
end;
procedure TMyComponent.AddFromFile(FileName: string);
begin
try
FBitmap.LoadFromFile(FileName);
except
Exception.RaiseOuterException(EMyComponentAddError.CreateWithFileName(FileName));
end;
end;
This allows your component to recognize that an error occurred, act on it as needed, and still report component-specific information to the caller without losing the original error that caused the actual failure. If the caller is interested in the details, it can catch the exception, look at its InnerException property, access custom properties if present, etc.
For example:
procedure TForm1.FormCreate(Sender: TObject);
begin
MyComponent1.AddFromFile('D:\Test.bmp');
end;
Let's assume MyComponent1.AddFromFile('D:\Test.bmp'); fails. The default exception handler will catch it and display a popup message that says:
Unable to add file: D:\Test.bmp
Useful, but little details, as it could have failed for any number of reasons. Maybe the file could not be opened, but why? Non-existant vs no permission? Maybe the file was opened but corrupted? Maybe memory could not be allocated? And so on.
The caller could catch it and display more useful info, if so desired (it is not required - the component provides the info, the caller decides whether to use it or not):
procedure TForm1.FormCreate(Sender: TObject);
begin
try
MyComponent1.AddFromFile('D:\Test.bmp');
except
on E: EMyComponentAddError do
begin
ShowMessage('There was a problem adding a file:'+sLineBreak+E.FileName+sLineBreak+sLineBreak+E.InnerException.Message);
Sysutils.Abort;
end;
end;
end;
Or:
procedure TForm1.FormCreate(Sender: TObject);
begin
try
MyComponent1.AddFromFile('D:\Test.bmp');
except
on E: EMyComponentAddError do
begin
raise Exception.CreateFmt('There was a problem adding a file:'#10'%s'#10#10'%s', [E.FileName, E.InnerException.Message]);
end;
end;
end;
Either of which would display:
There was a problem adding a file:
D:\Test.bmp
The file was not found
As David said we only need this
procedure TMyComponent.AddFromFile(FileName: string);
begin
FBitmap.LoadFromFile(FileName);
end;
This will check that
there is an existing file
in this file is a valid bitmap
Now it depends on the application, how important is this for the application. If this TForm1 is the Application.MainForm, every exception you did not catch inside the creation process will terminate the application. This is sometimes a valid behavior.
Very important, the application cannot run without
procedure TForm1.Form1Create(Sender:TObject);
begin
MyComponent.AddFromFile( 'D:\Test.bmp' );
end;
or wrap the exception for a user-friendly message
procedure TForm1.Form1Create(Sender:TObject);
begin
try
MyComponent.AddFromFile( 'D:\Test.bmp' );
except
on E: Exception do
raise Exception.Create( 'Sorry, I cannot run, because of: ' + E.Message );
end;
end;
Very important, but we have a fallback to handle this, maybe
procedure TForm1.Form1Create(Sender:TObject);
var
LBitmapFiles : TStringList;
LBitmapIdx : Integer;
LBitmapLoaded : Boolean;
LErrorStore : TStringList;
begin
LBitmapFiles := nil;
LErrorStore := nil;
try
LBitmapFiles := TStringList.Create;
LErrorStore := TStringList.Create;
LBitmapFiles.Add( 'D:\Test.bmp' );
LBitmapFiles.Add( 'D:\Fallback.bmp' );
LBitmapLoaded := False;
while not LBitmapLoaded and ( LBitmapIdx < LBitmapFiles.Count ) do
try
MyComponent.AddFromFile( LBitmapFiles[LBitmapIdx] );
LBitmapLoaded := True;
except
on E: Exception do
begin
LErrorStore.Add( LBitmapFiles[LBitmapIdx] + ': ' + E.Message );
Inc( LBitmapIdx );
end;
end;
if not LBitmapLoaded then
raise Exception.Create( 'Sorry, I cannot run, because of: ' + LErrorStore.Text );
finally
LErrorStore.Free;
LBitmapFiles.Free;
end;
end;
There are other fallbacks possible and this also depends on the application (f.i. set a dummy bitmap to the component) to get the application to work properly.
Not important, if we have no image ... we have no image, who cares
procedure TForm1.Form1Create(Sender:TObject);
const
CBitmapFile = 'D:\Test.bmp';
begin
// check, if there is a file
if FileExists( CBitmapFile ) then
try
MyComponent.AddFromFile( CBitmapFile );
except
on E: Exception do
begin
// Maybe log the exception
SomeLogger.Log( E );
// Maybe set some extra parameters for the application to know, this has failed
RunningWithoutBitmap();
end;
end
else
// Maybe set some extra parameters for the application to know, this has failed
RunningWithoutBitmap();
end;
Component
procedure TMyComponent.AddFromFile(FileName: string);
begin
FBitmap.LoadFromFile(FileName);
end;
This is all you need. If the bitmap object cannot load the file, for whatever reason, it will raise an exception. Let that exception propagate to the consumer of the code.
There's really no point trying to test whether or not the file exists. What if the file exists and it is not a bitmap file? What if the file exists, is a bitmap file, but the disk has a duff sector and the file read fails? If you attempt to check for all error conditions, you will just be repeating the checks that the LoadFromFile method already does.
Some error conditions cannot possibly be checked from the outside. An error that only becomes apparent part way through reading the file cannot reasonably be checked from the outside.
One very common consequence of over-zealous, duplicate error checking is that you end up with code that produces errors in scenarios where there should be none. If you get your error checking wrong you could end up reporting an error that would not have occurred had you let the underlying code run.
Consumer
procedure TForm1.FormCreate(Sender: TObject);
begin
MyComponent1.AddFromFile('D:\Test.bmp');
end;
At this point the decision is more difficult. I would typically expect the following question to be the driver of the decision:
Is it an expected, and reasonable event, for the file not to be present?
If the answer to that question is yes, then you should consider handling the exception in the FormCreate method. Again, testing FileExists() catches just one failure mode, albeit a common one. Perhaps you should use a try/except block to catch the error.
If the answer to the question is no, let the error propagate.
That said, you should also consider whether or not you want an exception to be thrown from your form's OnCreate event handler. That may be perfectly reasonable, but it is certainly conceivable that you will not wish to do this.

Application.OnException fails to handle all the exception - Delphi

I'm using Delphi 7 and in an attempt to handle all the possible exceptions being thrown during the run of the program. I used Application.OnException := HandlerProcedure; to handle exceptions but when exception occurs, HandlerProcedure never gets called. In order to assure if it really works, I raised exception after I assigned Application.OnException as below:
Application.OnException := HandlerProcedure;
raise Exception.Create('Exception');
and defined HandlerProcedure as:
procedure TFormMain.HandlerProcedure(Sender: TObject; E: Exception);
begin
ShowMessage('Exception.');
Exit;
end;
But HandlerProcedure never gets called. How can I make it handle all the exceptions?
If you want to intercept ALL exceptions, you need to implement a RTLUnwindProc low-level procedure.
This is a bit low-level (e.g. it needs asm skills), so you should better rely on existing code. See this stack overflow question. I even put some reference code (including low-level asm, working with Delphi 7 and later under Win32) in my own answer.
Something is wrong in your code. The example from Embarcadero's website is working perfect.
{
In addition to displaying the exception message, which
happens by default, the following code shuts down the
application when an exception is not caught and handled.
AppException should be declared a method of TForm1.
}
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnException := AppException;
end;
procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
Application.ShowException(E);
Application.Terminate;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
raise EPasswordInvalid.Create('Incorrect password entered');
end;
Also good practices on handling errors on Delphi are described here.
In order to further investigate the problem you have, you should take a look at this https://stackoverflow.com/questions/1259563/good-os-delphi-exception-handling-libraries
If you are using a third party exception handler such as madExcept, Application.OnException no longer fires. You must instead code TMadExceptionHandler.OnException event or directly call RegisterExceptionHandler.

Delphi threads deadlock

I am having a problem sometimes with a deadlock when destroying some threads. I've tried to debug the problem but the deadlock never seems to exist when debugging in the IDE, perhaps because of the low speed of the events in the IDE.
The problem:
The main thread creates several threads when the application starts. The threads are always alive and synchronizing with the main thread. No problems at all. The threads are destroyed when the application ends (mainform.onclose) like this:
thread1.terminate;
thread1.waitfor;
thread1.free;
and so on.
But sometimes one of the threads (which logs some string to a memo, using synchronize) will lock the whole application when closing. I suspect that the thread is synchronizing when I call waitform and the harmaggeddon happens, but that's is just a guess because the deadlock never happens when debugging (or I've never been able to reproduce it anyway). Any advice?
Logging messages is just one of those areas where Synchronize() doesn't make any sense at all. You should instead create a log target object, which has a string list, protected by a critical section, and add your log messages to it. Have the main VCL thread remove the log messages from that list, and show them in the log window. This has several advantages:
You don't need to call Synchronize(), which is just a bad idea. Nice side effect is that your kind of shutdown problems disappear.
Worker threads can continue with their work without blocking on the main thread event handling, or on other threads trying to log a message.
Performance increases, as multiple messages can be added to the log window in one go. If you use BeginUpdate() and EndUpdate() this will speed things up.
There are no disadvantages that I can see - the order of log messages is preserved as well.
Edit:
I will add some more information and a bit of code to play with, in order to illustrate that there are much better ways to do what you need to do.
Calling Synchronize() from a different thread than the main application thread in a VCL program will cause the calling thread to block, the passed code to be executed in the context of the VCL thread, and then the calling thread will be unblocked and continue to run. That may have been a good idea in the times of single processor machines, on which only one thread can run at a time anyway, but with multiple processors or cores it's a giant waste and should be avoided at all costs. If you have 8 worker threads on an 8 core machine, having them call Synchronize() will probably limit the throughput to a fraction of what's possible.
Actually, calling Synchronize() was never a good idea, as it can lead to deadlocks. One more convincing reason to not use it, ever.
Using PostMessage() to send the log messages will take care of the deadlock issue, but it has its own problems:
Each log string will cause a message to be posted and processed, causing much overhead. There is no way to handle several log messages in one go.
Windows messages can only carry machine-word sized data in parameters. Sending strings is therefore impossible. Sending strings after a typecast to PChar is unsafe, as the string may have been freed by the time the message is processed. Allocating memory in the worker thread and freeing that memory in the VCL thread after the message has been processed is a way out. A way that adds even more overhead.
The message queues in Windows have a finite size. Posting too many messages can lead to the queue to become full and messages being dropped. That's not a good thing, and together with the previous point it leads to memory leaks.
All messages in the queue will be processed before any timer or paint messages will be generated. A steady stream of many posted messages can therefore cause the program to become unresponsive.
A data structure that collects log messages could look like this:
type
TLogTarget = class(TObject)
private
fCritSect: TCriticalSection;
fMsgs: TStrings;
public
constructor Create;
destructor Destroy; override;
procedure GetLoggedMsgs(AMsgs: TStrings);
procedure LogMessage(const AMsg: string);
end;
constructor TLogTarget.Create;
begin
inherited;
fCritSect := TCriticalSection.Create;
fMsgs := TStringList.Create;
end;
destructor TLogTarget.Destroy;
begin
fMsgs.Free;
fCritSect.Free;
inherited;
end;
procedure TLogTarget.GetLoggedMsgs(AMsgs: TStrings);
begin
if AMsgs <> nil then begin
fCritSect.Enter;
try
AMsgs.Assign(fMsgs);
fMsgs.Clear;
finally
fCritSect.Leave;
end;
end;
end;
procedure TLogTarget.LogMessage(const AMsg: string);
begin
fCritSect.Enter;
try
fMsgs.Add(AMsg);
finally
fCritSect.Leave;
end;
end;
Many threads can call LogMessage() concurrently, entering the critical section will serialize access to the list, and after adding their message the threads can continue with their work.
That leaves the question how the VCL thread knows when to call GetLoggedMsgs() to remove the messages from the object and add them to the window. A poor man's version would be to have a timer and poll. A better way would be to call PostMessage() when a log message is added:
procedure TLogTarget.LogMessage(const AMsg: string);
begin
fCritSect.Enter;
try
fMsgs.Add(AMsg);
PostMessage(fNotificationHandle, WM_USER, 0, 0);
finally
fCritSect.Leave;
end;
end;
This still has the problem with too many posted messages. A message needs only be posted when the previous one has been processed:
procedure TLogTarget.LogMessage(const AMsg: string);
begin
fCritSect.Enter;
try
fMsgs.Add(AMsg);
if InterlockedExchange(fMessagePosted, 1) = 0 then
PostMessage(fNotificationHandle, WM_USER, 0, 0);
finally
fCritSect.Leave;
end;
end;
That still can be improved, though. Using a timer solves the problem of the posted messages filling up the queue. The following is a small class that implements this:
type
TMainThreadNotification = class(TObject)
private
fNotificationMsg: Cardinal;
fNotificationRequest: integer;
fNotificationWnd: HWND;
fOnNotify: TNotifyEvent;
procedure DoNotify;
procedure NotificationWndMethod(var AMsg: TMessage);
public
constructor Create;
destructor Destroy; override;
procedure RequestNotification;
public
property OnNotify: TNotifyEvent read fOnNotify write fOnNotify;
end;
constructor TMainThreadNotification.Create;
begin
inherited Create;
fNotificationMsg := RegisterWindowMessage('thrd_notification_msg');
fNotificationRequest := -1;
fNotificationWnd := AllocateHWnd(NotificationWndMethod);
end;
destructor TMainThreadNotification.Destroy;
begin
if IsWindow(fNotificationWnd) then
DeallocateHWnd(fNotificationWnd);
inherited Destroy;
end;
procedure TMainThreadNotification.DoNotify;
begin
if Assigned(fOnNotify) then
fOnNotify(Self);
end;
procedure TMainThreadNotification.NotificationWndMethod(var AMsg: TMessage);
begin
if AMsg.Msg = fNotificationMsg then begin
SetTimer(fNotificationWnd, 42, 10, nil);
// set to 0, so no new message will be posted
InterlockedExchange(fNotificationRequest, 0);
DoNotify;
AMsg.Result := 1;
end else if AMsg.Msg = WM_TIMER then begin
if InterlockedExchange(fNotificationRequest, 0) = 0 then begin
// set to -1, so new message can be posted
InterlockedExchange(fNotificationRequest, -1);
// and kill timer
KillTimer(fNotificationWnd, 42);
end else begin
// new notifications have been requested - keep timer enabled
DoNotify;
end;
AMsg.Result := 1;
end else begin
with AMsg do
Result := DefWindowProc(fNotificationWnd, Msg, WParam, LParam);
end;
end;
procedure TMainThreadNotification.RequestNotification;
begin
if IsWindow(fNotificationWnd) then begin
if InterlockedIncrement(fNotificationRequest) = 0 then
PostMessage(fNotificationWnd, fNotificationMsg, 0, 0);
end;
end;
An instance of the class can be added to TLogTarget, to call a notification event in the main thread, but at most a few dozen times per second.
Consider replacing Synchronize with a call to PostMessage and handle this message in the form to add a log message to the memo. Something along the lines of: (take it as pseudo-code)
WM_LOG = WM_USER + 1;
...
MyForm = class (TForm)
procedure LogHandler (var Msg : Tmessage); message WM_LOG;
end;
...
PostMessage (Application.MainForm.Handle, WM_LOG, 0, PChar (LogStr));
That avoids all the deadlock problems of two threads waiting for each other.
EDIT (Thanks to Serg for the hint): Note that passing the string in the described way is not safe since the string may be destroyed before the VCL thread uses it. As I mentioned - this was only intended to be pseudocode.
Add mutex object to main thread. Get mutex when try close form. In other thread check mutex before synchronizing in processing sequence.
It's simple:
TMyThread = class(TThread)
protected
FIsIdle: boolean;
procedure Execute; override;
procedure MyMethod;
public
property IsIdle : boolean read FIsIdle write FIsIdle; //you should use critical section to read/write it
end;
procedure TMyThread.Execute;
begin
try
while not Terminated do
begin
Synchronize(MyMethod);
Sleep(100);
end;
finally
IsIdle := true;
end;
end;
//thread destroy;
lMyThread.Terminate;
while not lMyThread.IsIdle do
begin
CheckSynchronize;
Sleep(50);
end;
Delphi's TThread object (and inheriting classes) already calls WaitFor when destroying, but it depends on whether you created the thread with CreateSuspended or not. If you are using CreateSuspended=true to perform extra initialization before calling the first Resume, you should consider creating your own constructor (calling inherited Create(false);) that performs the extra initialization.

Resources