I want to send a Post to a server that is slow. The server won't answer for 20 minutes (or more) and the whole application freezes.
I would like to unfreeze the GUI and at the same time, while waiting for the Post response to process the data from previous Post commands.
Here is how I send the Post command:
{ POST }
procedure TJob.SendToServer;
begin
...
lHTTP := TIdHTTP.Create(NIL);
TRY
TRY
Server.Rspns:= lHTTP.Post(ApiServer, MegaSeqFileName); { This won't freeze the GUI anymore because now TJob.SendToServer function is called in a TPostThread thread }
EXCEPT
on E: Exception DO { Catch Internet connection problems }
begin
Application.ProcessMessages;
Status:= jsNotSubmited;
ParentTask.Log.AddError(E.Message);
EXIT;
end;
END;
FINALLY
FreeAndNil(lHTTP);
END;
This is the Thread code:
TYPE
TPostThread= class(TThread)
public
Job: TJob;
procedure Execute; override;
procedure Done;
end;
procedure TPostThread.Done;
begin
Job.ThreadDone:= TRUE;
end;
procedure TPostThread.Execute;
begin
Job.SendToServer; { Send job and collect results }
Synchronize(Done);
end;
and this is how I start the thread
Job.ThreadDone:= FALSE;
Thread:= TPostThread.Create(TRUE);
Thread.Job:= Job;
Thread.FreeOnTerminate:= FALSE;
Thread.Start; {This calls: Job.SendToServer }
REPEAT
DelayEx(2000);
if Aborted then
begin
MesajInfo('Task aborted.');
Thread.Terminate;
FreeAndNil(Thread); <----freezes here!
EXIT(FALSE);
end;
//todo: run other tasks here (more exactly get results from previous Posts and send them to a different web server)
UNTIL Job.ThreadDone;
FreeAndNil(Thread);
The problem is that when I set Aborted = True, the thread won't exit. It freezes on FreeAndNil(Thread)... which is natural, because I don't check the Terminated in Thread.Execute.
I have this temporary solution, without threads, based on an idea from #RemyLebeau:
procedure TJob.OnHTTPProgress(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
if UserAborted=true then TIdHTTP(ASender).Disconnect;
Application.ProcessMessages;
end;
I know THIS IS NOT the good answer, only a dirty hack (this is why I will never mark this answer as accepted), but it made my program work, and I badly need to make it work in the next 1-2 weeks. It allows me to do both things: stop the program (during upload) and prevent the GUI from freezing.
I can return later to fix this nastyty.
Related
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.
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.
to write information on the processing state to the GUI inside a tcpserver.onexecute(..) function , i used the following command sequence
ExecuteDUMMYCommand(Global_Send_Record);
BitMap_PaintImageProcess;
TThread.Synchronize(nil, BitMap_PaintImageProcess);
The code is working well on some machines, but on a few it fails. The code execution stops atTThread.Synchronize command. I guess on these machines the function call is trapped inside a deadlock
Any chance to figure out the real problem behind ?
The procedure BitMap_PaintImageProcess , here I create a Bitmap and do a lot of painting stuff , but is seems that this code is never executed ?
I try to explain the very long code and reduce to the main points , the critical thread issues are hidden in processing the bitmap inside my Bitmapprocessingclass.
This class is accessed inside the GUIProcessing procedures of my ServerMainForm which also has the INDY TCP Server component.
{--------------- CLASS DEFINITION -----------------------------}
TBitMapProcessingClass = class()
FBitmap : TBitmap;
FList : TListOfSomething;
procedure ProcessTheBitmap(....);
......
(many many functions);
procedure Init;
procedure Free;
Procedure Create;
end;
TMainform = class(TForm)
MyServer : TIdTCPServer;
aBitMaoProcessingClass : TBitMaoProcessingClass;
procedure BitMap_PaintImageProcess;
procedure BitMap_ListProcess;
.....
end;
{------------------------- Implemantation ------------------------------}
procedure TMainform.IndyTCPServer.Onexecute()
begin
.......
ExecuteDUMMYCommand(Global_Send_Record);
BitMap_PaintImageProcess;
TThread.Synchronize(nil, BitMap_PaintImageProcess);
.......
end;
procedure TMainform.BitMap_PaintImageProcess;
begin
DoSomeServerVCLStuff(....);
aBitMapProcessingClass.ProcessTheBitmap;
DoSomeServerVCLStuff(....);
end;
Having no idea what BitMap_PaintImageProcess() does in fact, I have a few suppositions:
In the TThread.Synchronize call you try to read some data from the socket/idContext, but the data is not yet available. This will block the main thread until the data becomes available. But Indy's thread that is responsible for reading from the underlying socket buffer is currently blocked by your TThread.Synchronize call in the OnExecute event i.e. deadlock occurs;
In the TThread.Synchronize call you use Application.ProcessMessages (a common mistake);
In the OnExecute event you enter a critical section. Then during the TThread.Synchronize call you try to enter the same critical section again;
You modify the GUI in the onExecute event. Because onExecute is not thread safe, accessing VCL/FM from Indy's thread could lead to unpredictable results, including random deadlocks (hard to find).
I would suggest to use MadExcept / Eurekalog. They both have options to check if the main thread is "frozen". When that happens (during the deadlock) they will show you the current call stack. Having the call stack you can figure out which function is causing the deadlock.
Regarding the posted code:
procedure TMainform.IndyTCPServer.Onexecute()
begin
.......
ExecuteDUMMYCommand(Global_Send_Record);
BitMap_PaintImageProcess; //-> You do VCL stuff in the context of Indy's thread!
TThread.Synchronize(nil, BitMap_PaintImageProcess);
end;
In the BitMap_PaintImageProcess() you call DoSomeServerVCLStuff(....). Do not forget that OnExecute is fired from Indy's thread for the current context. I.e. you modify VCL from another thread (other from the Main Thread) which is not thread safe.
On your comment:
...but here my complex TBitmap processing Class must be alive the whole
time my Server is active...
If you have only one (global) instance for image processing, then what will happen if another client connects, while you are still processing the old connection (think Parallel :) )? Your image processing class should be instantiated separately for each new connection/context. For GUI updating you can use TIdNotify descendant.
A possible solution:
type
{ tIdNotify Stuff }
TVclProc= procedure(imgClass: tMyImageProcessingClass) of object;
tIdNotifyDescendant = (tIdNotify)
protected
fImgClass: tMyImageProcessingClass;
fProc: TVclProc;
procedure DoNotify; override;
public
class procedure updateVcl(imgClass: tMyImageProcessingClass; vclProc: TVclProc);
end;
procedure tIdNotifyDescendant.DoNotify;
begin
inherited DoNotify;
FProc(fImgClass);
end;
class procedure tIdNotifyDescendant.updateVcl(imgClass: tMyImageProcessingClass; vclProc: TVclProc);
begin
with Create do
begin
fImgClass := imgClass;
fProc := vclProc;
Notify;
end;
end;
{ Indy stuff & other logic }
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
// Create your instance when the client connects
AContext.Data := tMyImageProcessingClass.Create;
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
// Do cleanup
if assinged(AContext.Data) then
(AContext.Data as tMyImageProcessingClass).Free // Casting just for clarity
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
imgProcClass: tMyImageProcessingClass;
begin
imgProcClass := acontext.Data as tMyImageProcessingClass;
// Do image processing
// Notify GUI for the progress:
tIdNotifyDescendant.updateVcl(AContext.data as tMyImageProcessingClass);
end;
Tip: If you do JPEG processing and you use Draw() method have in mind this: TJPEGImage.Draw() is not thread safe
I added a few more details on my BitmapProcessingclass and the idea of a thread safe extension of the existing class...
I need the existing class u nchanged in others apps ... I need a extension inside my app with the indy server.
ONly one client my connect to one server, or he has to query the state of the server
type TBmpNotify = class(TIdNotify)
protected
FBMP: MyImageProcessingClass;
procedure DoNotify; override;
public
constructor Create(aBMP: MyImageProcessingClass);
function SetImageView(LL, UR: TPoint): Boolean;
procedure PaintBitMap;
function InitBitMap(x, y: Integer;
PixelFormat: TPixelFormat = pf24bit): Boolean;
destructor free;
end;
implementation
{ TBmpNotify }
constructor TBmpNotify.Create(aBMP: MyImageProcessingClass);
begin
// indise this class I also create
// class.TBitmap
// class.TList
// much more stuff ....
FBmp := MyImageProcessingClass.Create;
end;
procedure TBmpNotify.DoNotify;
begin
inherited;
end;
destructor TBmpNotify.free;
begin
FBmp.Free;
inherited;
end;
function TBmpNotify.InitBitMap(x, y: Integer;
PixelFormat: TPixelFormat): Boolean;
begin
// Write values to the List
// also modify TBitmap
// execution time of this function ~ 5 min
FBmp.InitBitMap(x,y,PixelFormat)
end;
procedure TBmpNotify.PaintBitMap;
begin
// much TBitmap, bitmap.canvas .... is used
// execution time of this function ~ 1 min
FBmp.PaintBitMap;
end;
function TBmpNotify.SetImageView(LL, UR: TPoint): Boolean;
begin
// this function takes about 1 min
FBmp.SetImageView(LL, UR);
end;
end.
I've built a few services in Delphi 7 and did not have this problem. Now that I started a new service app in XE2, it won't stop properly. I don't know if it's something I'm doing wrong or if it might be a bug in the XE2 services.
The execute procedure looks like this:
procedure TMySvc.ServiceExecute(Sender: TService);
begin
try
CoInitialize(nil);
Startup;
try
while not Terminated do begin
DoSomething; //Problem persists even when nothing's here
end;
finally
Cleanup;
CoUninitialize;
end;
except
on e: exception do begin
PostLog('EXCEPTION in Execute: '+e.Message);
end;
end;
end;
I never have an exception, as you can see I log any exception. PostLog saves to an INI file, which works fine. Now I do use ADO components, so I use CoInitialize() and CoUninitialize. It does connect to the DB and do its job properly. The problem only happens when I stop this service. Windows gives me the following message:
Then the service continues. I have to stop it a second time. The second time it does stop, but with the following message:
The log file indicates that the service did successfully free (OnDestroy event was logged) but it never successfully stopped (OnStop was never logged).
In my above code, I have two procedures Startup and Cleanup. These simply create/destroy and initialize/uninitialize my necessary things...
procedure TMySvc.Startup;
begin
FUpdateThread:= TMyUpdateThread.Create;
FUpdateThread.OnLog:= LogUpdate;
FUpdateThread.Resume;
end;
procedure TMySvc.Cleanup;
begin
FUpdateThread.Terminate;
end;
As you can see, I have a secondary thread running. This service actually has numerous threads running like this, and the main service thread is only logging the events from each thread. Each thread has different responsibilities. The threads are reporting properly, and they are also being terminated properly.
What could be causing this stop failure? If my posted code doesn't expose anything, then I can post more code later - just have to 'convert' it because of internal naming, etc.
EDIT
I just started NEW service project in Delphi XE2, and have the same issue. This is all my code below:
unit JDSvc;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, JDSvcMgr;
type
TJDService = class(TService)
procedure ServiceExecute(Sender: TService);
private
FAfterInstall: TServiceEvent;
public
function GetServiceController: TServiceController; override;
end;
var
JDService: TJDService;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
JDService.Controller(CtrlCode);
end;
function TJDService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TJDService.ServiceExecute(Sender: TService);
begin
while not Terminated do begin
end;
end;
end.
look at the source code for the Execute method:
procedure TServiceThread.Execute;
var
msg: TMsg;
Started: Boolean;
begin
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE); { Create message queue }
try
// Allow initialization of the Application object after
// StartServiceCtrlDispatcher to prevent conflicts under
// Windows 2003 Server when registering a class object with OLE.
if Application.DelayInitialize then
Application.Initialize;
FService.Status := csStartPending;
Started := True;
if Assigned(FService.OnStart) then FService.OnStart(FService, Started);
if not Started then Exit;
try
FService.Status := csRunning;
if Assigned(FService.OnExecute) then
FService.OnExecute(FService)
else
ProcessRequests(True);
ProcessRequests(False);
except
on E: Exception do
FService.LogMessage(Format(SServiceFailed,[SExecute, E.Message]));
end;
except
on E: Exception do
FService.LogMessage(Format(SServiceFailed,[SStart, E.Message]));
end;
end;
as you can see if you don't assign a OnExecute method, Delphi will process SCM requests (Service Start, Stop, ...) until the service is stopped.
When you make an loop in the Service.Execute you must to process SCM requests yourself by calling ProcessRequests(False). A good habit is not to use Service.execute and start your workerthread in the Service.OnStart event and terminating/freeing it in the Service.OnStop event.
As told in the comments, another problem lies in the FUpdateThread.Terminate part.
David Heffernan was spot on with the Free/WaitFor comment.
Make sure you end your thread in correct fashion using synchronisation objects.
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.