Since my iOS app terminates (if running in debugger, the app simply freezes without any errors) after some minutes of intensive use, I started looking into possible reasons why the app would simply suddenly close down. (But always first do so after some time.)
I create lots of shortlived threads that are set to terminate when done. (I use FreeOnTerminate := True in constructor.) However, in Delphi IDE | Thread status the threads seem to live on after execute has run.
So in debug window, I have e.g. 100 threads with State=none and Status=unknown. Am I correct in assuming that means the threads are not completely freed/gone?
For reference, demo code:
constructor TMyOnlineThread.Create(...) ;
begin
inherited Create(False);
//--
//...
//--
FreeOnTerminate := True;
end;
destructor TMyOnlineThread.Destroy;
begin
//...
inherited;
end;
procedure TMyOnlineThread.Execute;
begin
//--
// Single task. No while loop or anything like that.
//--
if (...) then
begin
if Assigned(FOnDone) then
Synchronize(MyCallBack)
;
end
;
end;
procedure someothercode;
begin
TMyOnlineThread.Create(...);
end;
Related
I encounter an awkward problem. In my app I often do
TThread.createAnonymousThread(
procedure
....
end).start
The problem I have is that when I close the main form of my app, then sometime some of those AnonymousThread are still alive after the Tform.destroy finished . Is their a way in my Tform.destroy to wait that all those AnonymousThread (created a little everywhere in the whole app) are successfully terminated before to continue ?
I found this way to list all running thread (from How can I get a list with all the threads created by my application) :
program ListthreadsofProcess;
{$APPTYPE CONSOLE}
uses
PsAPI,
TlHelp32,
Windows,
SysUtils;
function GetTthreadsList(PID:Cardinal): Boolean;
var
SnapProcHandle: THandle;
NextProc : Boolean;
TThreadEntry : TThreadEntry32;
begin
SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); //Takes a snapshot of the all threads
Result := (SnapProcHandle <> INVALID_HANDLE_VALUE);
if Result then
try
TThreadEntry.dwSize := SizeOf(TThreadEntry);
NextProc := Thread32First(SnapProcHandle, TThreadEntry);//get the first Thread
while NextProc do
begin
if TThreadEntry.th32OwnerProcessID = PID then //Check the owner Pid against the PID requested
begin
Writeln('Thread ID '+inttohex(TThreadEntry.th32ThreadID,8));
Writeln('base priority '+inttostr(TThreadEntry.tpBasePri));
Writeln('');
end;
NextProc := Thread32Next(SnapProcHandle, TThreadEntry);//get the Next Thread
end;
finally
CloseHandle(SnapProcHandle);//Close the Handle
end;
end;
begin
{ TODO -oUser -cConsole Main : Insert code here }
GettthreadsList(GetCurrentProcessId); //get the PID of the current application
//GettthreadsList(5928);
Readln;
end.
but it's look like that in this list their is some threads that are not really made by my code and that those threads never close. For example for a blank project this is the list of threads :
Core problem you are facing does not come from the anonymous threads as such, but from self-destroying anonymous threads - the ones that have FreeOnTerminate set.
In order to wait on a thread, you need to have reference to a thread or its handle (Windows platform). Because you are dealing with self-destroying threads, taking reference to a thread is not an option, because as soon as you start the thread you are no longer allowed to touch that reference.
Delphi RTL does not perform any cleanup for the self destroying anonymous threads during application shutdown, so those threads will be just killed by the OS after your application main form is destroyed, hence your problem.
One of the solutions that will allow you to wait for anonymous threads, that does not require any complicated housekeeping and maintaining any kind of lists, and that also requires minimal changes to the code that can be done with simple find and replace, is using TCountdownEvent to count threads.
This requires replacing TThread.CreateAnonymousThread with constructing custom thread class TAnoThread.Create (you can add static factory method if you like, instead of directly calling constructor) that will have same behavior as anonymous thread, except its instances will be counted and you will be able to wait on all such threads to finish running.
type
TAnoThread = class(TThread)
protected
class var
fCountdown: TCountdownEvent;
class constructor ClassCreate;
class destructor ClassDestroy;
public
class procedure Shutdown; static;
class function WaitForAll(Timeout: Cardinal = INFINITE): TWaitResult; static;
protected
fProc: TProc;
procedure Execute; override;
public
constructor Create(const aProc: TProc);
end;
class constructor TAnoThread.ClassCreate;
begin
fCountdown := TCountdownEvent.Create(1);
end;
class destructor TAnoThread.ClassDestroy;
begin
fCountdown.Free;
end;
class procedure TAnoThread.Shutdown;
begin
fCountdown.Signal;
end;
class function TAnoThread.WaitForAll(Timeout: Cardinal): TWaitResult;
begin
Result := fCountdown.WaitFor(Timeout);
end;
constructor TAnoThread.Create(const aProc: TProc);
begin
inherited Create(True);
fProc := aProc;
FreeOnTerminate := True;
end;
procedure TAnoThread.Execute;
begin
if fCountdown.TryAddCount then
try
fProc;
finally
fCountdown.Signal;
end;
end;
And then you can add following code in your form destructor or any other appropriate place and wait for all anonymous threads to finish running.
destructor TForm1.Destroy;
begin
TAnoThread.Shutdown;
while TAnoThread.WaitForAll(100) <> wrSignaled do
CheckSynchronize;
inherited;
end;
Principle is following: countdown event is created with value 1, and when that value reaches 0, event will be signaled. To initiate shutdown, you call Shutdown method which will decrease initial count. You cannot call this method more than once because it would mess up the count.
When anonymous thread Execute method starts, it will first attempt to increase the count. If it cannot do that, it means countdown event is already signaled and thread will just terminate without calling its anonymous method, otherwise anonymous method will run and after it finishes count will be decreased.
If anonymous threads use TThread.Synchronize calls, you cannot just call WaitForAll because calling it from the main thread will deadlock. In order to prevent deadlock while you are waiting for the threads to finish, you need to call CheckSynchronize to process pending synchronization requests.
This solution counts all threads of the TAnoThread class regardless of whether they are self-destroying or not. This can be easily changed to count only those that have FreeOnTerminate set.
Also, when you call Shutdown, and you still have some running threads, new threads will still be able to start at that point because countdown even is not signaled. If you want to prevent new threads from that point on, you will need to add a Boolean flag that will indicate you have initiated shutdown process.
Reading all threads from the process and then trying to figure out which ones to wait for sounds like the path to a lot of pain.
If you really don't want to store the references of the anonymous threads (which then by the way should not be FreeOnTerminate as that would cause dangling references if the thread ends before you wait for it) then build a wrapper around TThread.CreateAnonymousThread or TTask.Run which does the storage internally and encapsulates the WaitFor. You could even be fancy and add an additional group key so you can create and wait for different set of threads/tasks instead of all.
Push in a thread-safe list the TThread references returned by CreateAnonymousThread, make sure to keep it in sync when a thread terminates and implement your own WaitForAll.
Or, consider to use TTask class for a simple parallel threads management. It have already implemented WaitForAll method.
Sample code took from Delphi help:
procedure TForm1.MyButtonClick(Sender: TObject);
var
tasks: array of ITask;
value: Integer;
begin
Setlength (tasks ,2);
value := 0;
tasks[0] := TTask.Create (procedure ()
begin
sleep(3000);
TInterlocked.Add (value, 3000);
end);
tasks[0].Start;
tasks[1] := TTask.Create (procedure ()
begin
sleep (5000);
TInterlocked.Add (value, 5000);
end);
tasks[1].Start;
TTask.WaitForAll(tasks);
ShowMessage ('All done: ' + value.ToString);
end;
Why the use of a progress bar to show the progress of an iteration considerably increases the execution time of the process in question?
Considering the following example:
procedure FileToStringList(FileName: String);
var
fileSource: TStringList;
I: Integer;
begin
fileSource:= TStringList.Create;
try
fileSource.LoadFromFile(FileName);
for I := 0 to fileSource.Count - 1 do
begin
//Code....
end;
finally
fileSource.Free;
end;
end;
If you add the update of a progress bar:
procedure FileToStringList(FileName: String);
var
fileSource: TStringList;
I: Integer;
begin
fileSource:= TStringList.Create;
try
fileSource.LoadFromFile(FileName);
ProgressBar.Properties.Max:= fileSource.Count;
for I := 0 to fileSource.Count - 1 do
begin
Application.ProcessMessages;
ProgressBar.Position:= I;
end;
finally
fileSource.Free;
end;
end;
The time required for the iteration process to be performed is multiplied enormously.
Performing a reading test of a file of 200,000 lines, without the update of the progress bar, the time of the iteration is approximately 8 seconds but, if the update of the progress bar is activated to show the progress of the iteration, this process takes several minutes.
A test with a file of 2,700 lines, the normal time is 2-4 seconds but with the use of a progress bar, the execution time is more than 1 minute.
Can someone indicate if the use of the Application ProcessMessages is incorrect?. The result does not change if the routine is in a unit or on the same form like the progress bar.
Okay I can see the comments but, can someone indicate with an example or link which should be the correct way to update the progress bar in these conditions?
You're not really "just adding a progress bar". Your use of Application.ProcessMessages; messages means that you're also pumping all manner of additional messages doing other work. So now your "busy/main work" is competing for CPU time on the same thread (and CPU) as all the other messages going through your application. We're certainly in no position to comment on what other messages might be flowing though your application.
Busy work should not be done in the main thread. And it's generally fairly easy to wrap a method into a thread provided it isn't already too tightly coupled to your GUI.
No doubt you've been told all this in comments already.
First take note of a few important rules:
don't interact with your GUI from your child threads (Synchronise or Queue calls to code that updates GUI);
avoid sharing data1 between threads (including main thread);
if you must share data ensure your threads co-ordinate1 their access to avoid race conditions (too big a topic to go into detail).
Then the following is the minimum needed:
Define your thread.
Implement your main processing in the Execute() method.
Create and start your thread.
Since you want to update a progress bar, and remembering "Rules to note": make sure you Queue those updates.
But there are a number of more advanced considerations you can apply to improving your thread. (Those will be left to you for further research.)
You would also be well advised to also take advice Ive and others have already given and reduce the number of times you update your progress. Excessive updates just wastes time; especially with cross-thread operations (see last section).
How do you interrupt your thread if your user wants to cancel the job or close the app?
How do you manage the possibility of your user starting too many jobs?
How do you deal with errors in your threads?
How do you want to manage what happens when your thread terminates.
The following sample code is a trimmed down version of what you need in 1-4. You can fill in the trivial bits I left out.
1)
type
TFileProcessor = class(TThread)
public
constructor Create(const AFileName: string);
procedure Execute; override;
end;
2 & 4)
Note that you could pass the progress bar instance in your constructor and update it from your thread. But even though it's a little more work, it's much cleaner to define a callback event on your thread, and allow your GUI to handle the event in order to choose exactly what it wishes to do.
procedure TFileProcessor.Execute;
var
fileSource: TStringList;
I: Integer;
begin
fileSource:= TStringList.Create;
try
fileSource.LoadFromFile(FileName);
{ GUI interaction must be queued.
ProgressBar.Properties.Max:= fileSource.Count;}
FPosition := 0;
FCount := fileSource.Count;
Queue(DoUpdateProgress);
for I := 0 to fileSource.Count - 1 do
begin
{ Obviously this must go!
Application.ProcessMessages;}
{ Again GUI interaction must be Queued
ProgressBar.Position:= I;}
FPosition := I;
Queue(DoUpdateProgress); {TIP: Reduce your progress updates for
more performance improvement; updating
on every single line is overkill.}
end;
finally
fileSource.Free;
end;
end;
procedure TFileProcessor.DoUpdateProgress();
begin
if Assigned(FOnUpdateProgress) then
FOnUpdateProgress(FPosition, FCount);
end;
3)
procedure TForm1.Button1Click(...);
var
LThread: TFileProcessor;
begin
LThread := TFileProcessor.Create(FFileName);
LThread.OnUpdateProgress := HandleUpdateProgress;
LThread.FreeOnTerminate := True;
LThread.Start;
end;
4)
As mentioned earlier it's cleaner if your form controls what GUI controls it wants to update and how in response to progress updates. E.g. You could update a label at the same same time if desired without any change to the thread and job code.
procedure TForm1.HandleUpdateProgress(APosition, ACount: Integer);
begin
ProgressBar.Position := APosition;
ProgressBar.Properties.Max := ACount;
Label1.Caption := Format('Line %d of %d', [APosition, ACount]);
end;
1 I'd like to emphasise the point that you should avoid sharing data with multi-threaded code. Cross-thread operations are much more expensive than same-thread operations. (This includes notifications to the main thread.)
For example, on my system, the thread code above has the following overheads.
200,000 Queued events to the main thread has an overhead of almost 1 second.
Depending on what you do inside HandleUpdateProgress you might find it takes some time processing all the queued messages for a while after your file has actually finished processing. (On my system updating a standard label and progress bar, this takes 5 seconds.)
If your application only transforms the input file, then there is no need for a special thread and you can use following code.
In the case that an application allows the user to perform another operations while processing the file, then a background thread should be used.
procedure FileToStringList(FileName: String);
var
fileSource: TStringList;
I,J: Integer;
begin
fileSource:= TStringList.Create;
try
fileSource.LoadFromFile(FileName);
ProgressBar.Properties.Max:= fileSource.Count;
J:=10;//TODO make it better
for I := 0 to fileSource.Count - 1 do
begin
if (I mod J = 0) then
begin
Application.ProcessMessages;
ProgressBar.Position:= I;
end;
end;
ProgressBar.Position:= fileSource.Count;
finally
fileSource.Free;
end;
end;
Or you can call your processMessages on time:
procedure FileToStringList(FileName: String);
var
fileSource: TStringList;
I,J: Integer;
lastCheck: TDateTime;
begin
fileSource:= TStringList.Create;
try
fileSource.LoadFromFile(FileName);
ProgressBar.Properties.Max:= fileSource.Count;
J:=1000;//refresh in ms
lastCheck:=now;
for I := 0 to fileSource.Count - 1 do
begin
if (lastCheck+j)<now then
begin
lastCheck:=now;
Application.ProcessMessages;
ProgressBar.Position:= I;
end;
end;
ProgressBar.Position:= fileSource.Count;
finally
fileSource.Free;
end;
end;
I have a TADOConnection inside a thread. In the event that it fails to connect to the database (timeout), when closing the app, the thread is held up and it takes time until the attempt is finished before my app is able to close. I don't want to reduce the connection timeout of the connection, this isn't the issue. Is there any way I can forcefully abort the attempt to connect?
The TADOConnection connects at the beginning of the thread execution and automatically reconnects repeatedly until success. Then, upon closing the app, if the database is failing to connect, the thread hangs until the connection attempt is finished (timed out).
EDIT
This is a sample of how the thread works:
procedure TMyThread.Init;
begin
CoInitialize(nil);
FDB:= TADOConnection.Create(nil);
FDB.LoginPrompt:= False;
FDB.ConnectionTimeout:= 5;
FDB.ConnectOptions:= coAsyncConnect;
end;
procedure TMyThread.Uninit;
begin
if FDB.Connected then
FDB.Connected:= False;
FDB.Free;
CoUninitialize;
end;
function TMyThread.Reconnect: Boolean;
begin
Result:= False;
if FDB.Connected then
FDB.Connected:= False;
FDB.ConnectionString:= FConnectionString;
try
FDB.Connected:= True; //How to abort?
Result:= True;
except
on e: exception do begin
//MessageDlg(e.Message, mtError, [mbOK], 0);
FDB.Connected:= False;
Result:= False;
end;
end;
end;
procedure TMyThread.Process;
begin
if Reconnect then begin //Once connected, keep alive in loop
while FActive do begin
if Terminated then Break;
if not Connected then Break;
//Do Some Database Work
end;
end else begin
//Log connection failure
end;
end;
procedure TMyThread.Execute;
begin
while not Terminated do begin
if FActive then begin
Init; //CoInitialize, create DB, etc.
try
while (FActive) and (not Terminated) do begin
try
Process; //Actual processing procedure
except
on e: exception do begin
//Record error to log
end;
end;
end;
finally
Uninit; //CoUninitialize, destroy DB, etc.
end;
end;
end;
end;
(Tried to include just relevant things to the question)
First thing that comes to mind is to reduce connection's timeout. Why do you not want that? And why do you want to establish a connection when closing the application? Especially when you prefer to abort it when it takes more time than expected, why connect at all? Sounds like we could know more background info.
In the special case that you really need it on the condition that it connects quickly, ánd when this issue only applies to application's destruction, then I suggest not to wait for the thread to finish. Just do not free it, terminate the application, and let Windows kill the process including all its threads.
In the case that the connection does succeed, then this approach could backfire, so signal your main thread when the thread dóes connect, and postpone its termination by yet waiting for the thread. You may need another timeout for that again.
Edit:
I suppose the OnWillConnect event will occur every time the attempt to connect is made. Try returning EventStatus := esCancel within its handler.
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.
i'm writing a delphi app that communicates with excel. one thing i noticed is that if i call the Save method on the Excel workbook object, it can appear to hang because excel has a dialog box open for the user. i'm using the late binding.
i'd like for my app to be able to notice when Save takes several seconds and then take some kind of action like show a dialog box telling this is what's happening.
i figured this'd be fairly easy. all i'd need to do is create a thread that calls Save and have that thread call Excel's Save routine. if it takes too long, i can take some action.
procedure TOfficeConnect.Save;
var
Thread:TOfficeHangThread;
begin
// spin off as thread so we can control timeout
Thread:=TOfficeSaveThread.Create(m_vExcelWorkbook);
if WaitForSingleObject(Thread.Handle, 5 {s} * 1000 {ms/s})=WAIT_TIMEOUT then
begin
Thread.FreeOnTerminate:=true;
raise Exception.Create(_('The Office spreadsheet program seems to be busy.'));
end;
Thread.Free;
end;
TOfficeSaveThread = class(TThread)
private
{ Private declarations }
m_vExcelWorkbook:variant;
protected
procedure Execute; override;
procedure DoSave;
public
constructor Create(vExcelWorkbook:variant);
end;
{ TOfficeSaveThread }
constructor TOfficeSaveThread.Create(vExcelWorkbook:variant);
begin
inherited Create(true);
m_vExcelWorkbook:=vExcelWorkbook;
Resume;
end;
procedure TOfficeSaveThread.Execute;
begin
m_vExcelWorkbook.Save;
end;
i understand this problem happens because the OLE object was created from another thread (absolutely).
how can i get around this problem? most likely i'll need to "re-marshall" for this call somehow...
any ideas?
The real problem here is that Office applications aren't intended for multithreaded use. Because there can be any number of client applications issuing commands through COM, those commands are serialized to calls and processed one by one. But sometimes Office is in a state where it doesn't accept new calls (for example when it is displaying a modal dialog) and your call gets rejected (giving you the "Call was rejected by callee"-error). See also the answer of Geoff Darst in this thread.
What you need to do is implement a IMessageFilter and take care of your calls being rejected. I did it like this:
function TIMessageFilterImpl.HandleInComingCall(dwCallType: Integer;
htaskCaller: HTASK; dwTickCount: Integer;
lpInterfaceInfo: PInterfaceInfo): Integer;
begin
Result := SERVERCALL_ISHANDLED;
end;
function TIMessageFilterImpl.MessagePending(htaskCallee: HTASK;
dwTickCount, dwPendingType: Integer): Integer;
begin
Result := PENDINGMSG_WAITDEFPROCESS;
end;
function ShouldCancel(aTask: HTASK; aWaitTime: Integer): Boolean;
var
lBusy: tagOLEUIBUSYA;
begin
FillChar(lBusy, SizeOf(tagOLEUIBUSYA), 0);
lBusy.cbStruct := SizeOf(tagOLEUIBUSYA);
lBusy.hWndOwner := Application.Handle;
if aWaitTime < 20000 then //enable cancel button after 20 seconds
lBusy.dwFlags := BZ_NOTRESPONDINGDIALOG;
lBusy.task := aTask;
Result := OleUIBusy(lBusy) = OLEUI_CANCEL;
end;
function TIMessageFilterImpl.RetryRejectedCall(htaskCallee: HTASK;
dwTickCount, dwRejectType: Integer): Integer;
begin
if dwRejectType = SERVERCALL_RETRYLATER then
begin
if dwTickCount > 10000 then //show Busy dialog after 10 seconds
begin
if ShouldCancel(htaskCallee, dwTickCount) then
Result := -1
else
Result := 100;
end
else
Result := 100; //value between 0 and 99 means 'try again immediatly', value >= 100 means wait this amount of milliseconds before trying again
end
else
begin
Result := -1; //cancel
end;
end;
The messagefilter has to be registered on the same thread as the one issuing the COM calls. My messagefilter implementation will wait 10 seconds before displaying the standard OLEUiBusy dialog. This dialog gives you the option to retry the rejected call (in your case Save) or switch to the blocking application (Excel displaying the modal dialog).
After 20 seconds of blocking, the cancel button will be enabled. Clicking the cancel button will cause your Save call to fail.
So forget messing around with threads and implement the messagefilter, which is the way
to deal with these issues.
Edit:
The above fixes "Call was rejected by callee" errors, but you have a Save that hangs. I suspect that Save brings up a popup that needs your attention (Does your workbook has a filename already?). If it is a popup that is in the way, try the following (not in a separate thread!):
{ Turn off Messageboxes etc. }
m_vExcelWorkbook.Application.DisplayAlerts := False;
try
{ Saves the workbook as a xls file with the name 'c:\test.xls' }
m_vExcelWorkbook.SaveAs('c:\test.xls', xlWorkbookNormal);
finally
{ Turn on Messageboxes again }
m_vExcelWorkbook.Application.DisplayAlerts := True;
end;
Also try to debug with Application.Visible := True; If there are any popups, there is a change you will see them and take actions to prevent them in the future.
Rather than accessing the COM object from two threads, just show the message dialog in the secondary thread. The VCL isn't thread-safe, but Windows is.
type
TOfficeHungThread = class(TThread)
private
FTerminateEvent: TEvent;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure Terminate; override;
end;
...
constructor TOfficeHungThread.Create;
begin
inherited Create(True);
FTerminateEvent := TSimpleEvent.Create;
Resume;
end;
destructor TOfficeHungThread.Destroy;
begin
FTerminateEvent.Free;
inherited;
end;
procedure TOfficeHungThread.Execute;
begin
if FTerminateEvent.WaitFor(5000) = wrTimeout then
MessageBox(Application.MainForm.Handle, 'The Office spreadsheet program seems to be busy.', nil, MB_OK);
end;
procedure TOfficeHungThread.Terminate;
begin
FTerminateEvent.SetEvent;
end;
...
procedure TMainForm.Save;
var
Thread: TOfficeHungThread;
begin
Thread := TOfficeHungThread.Create;
try
m_vExcelWorkbook.Save;
Thread.Terminate;
Thread.WaitFor;
finally
Thread.Free;
end;
end;
Try calling CoInitializeEx with COINIT_MULTITHREADED since MSDN states:
Multi-threading (also called free-threading) allows calls to methods of objects created by this thread to be run on any thread.
'Marshalling' an interface from one thread to another can be done by using CoMarshalInterThreadInterfaceInStream to put the interface into a stream, move the stream to the other thread and then use CoGetInterfaceAndReleaseStream to get the interface back from the stream. see here for an example in Delphi.
Lars' answer is along the right lines I think. An alternative to his suggestion is to use the GIT (Global Interface Table), which can be used as a cross-thread repository for interfaces.
See this SO thread here for code for interacting with the GIT, where I posted a Delphi unit that provides simple access to the GIT.
It should simply be a question of registering your Excel interface into the GIT from your main thread, and then getting a separate reference to the interface from within your TOfficeHangThread thread using the GetInterfaceFromGlobal method.