When you create a TThread descendant using the tool palette in your BDS, you can provide a name for the thread. Here's the auto-generated code. You just call the SetName() function in the Execute method and the thread calling this method is given a name in a kind of weird way...
{$IFDEF MSWINDOWS}
type
TThreadNameInfo = record
FType: LongWord; // must be 0x1000
FName: PChar; // pointer to name (in user address space)
FThreadID: LongWord; // thread ID (-1 indicates caller thread)
FFlags: LongWord; // reserved for future use, must be zero
end;
{$ENDIF}
{ TTestThread }
procedure TTestThread.SetName;
{$IFDEF MSWINDOWS}
var
ThreadNameInfo: TThreadNameInfo;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
ThreadNameInfo.FType := $1000;
ThreadNameInfo.FName := 'ThreadName';
ThreadNameInfo.FThreadID := $FFFFFFFF;
ThreadNameInfo.FFlags := 0;
try
RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), #ThreadNameInfo );
except
end;
{$ENDIF}
end;
I find it really useful during debugging for you can see not only TIDs, but also thread names assigned that way. You know which thread is which thanks to that.
Please tell me, however, if the name assigned can be accessed in any way. Can it be read based on a thread's handle? Or can it be read even from 'outside' the process by another process? You know, there are applications which list your processes and the threads working in them. Will this name be accessible to apps like that?
Thanks!
Actually, thread names are just used for debugging purposes and nothing else, really. In your code, you could just identify threads by using the ThreadID. And if you want to keep a name with those thread ID's, keep a separate (dictionary) list which maps each thread ID to whatever name you like.
The hack that you see does a nasty trick. The exception that is raised is captured by the debugger, which just handles it as a special exception and will just continue execution. The exception flag just tells the system to continue after the exception is raised, since the code will handle it. The empty except-clause is handling the exception within your code. It's just a dirty trick to communicate with the debugger, which will zee the exception and remember the name you've just passed to it...
It's entirely a debugging feature. In fact, the thread object doesn't even keep track of its own name. It sends it directly to the debugger, but doesn't store a copy of the name for itself. It's not accessible from within your own program or from anywhere else, except the debugger.
Related
I have a Delphi 10 project using the latest version of EurekaLog. I'm currently using EurekaLog to help me debug problems in my production clients.
I noticed that EurekaLog wasn't registering errors that happened within threads. After I started reading up on it, I found that I need to change from TThread to TThreadEx, and add the following code at the start of my Execute overriden method.
SetEurekaLogStateInThread(ThreadID, true);
Despite this, when an error happens, it does not generate an event in the EL file.
If I add ExceptionManager.StandardEurekaError('TThrdSincArquivos.Execute => ' + ex.Message); on the try..except, it does log. But the stack trace is displayed as if the error occurred on the line where I call StandardEurekaLog(), not on the line where the error actually occurred. This defeats the purpose of the whole thing.
Another problem is that it displays a dialog box, which I don't want, since the error occurred inside a background thread. I just want it logged. I should get a dialog only with errors on the main thread.
How can I achieve theses results within the thread?
Actually log the error with the correct stack.
When on the main thread, display the dialog, but within a thread, just log with no dialog.
EDIT
Below is my EurekaLog Muti-threading configuration
Here is my thread declaration:
unit ThrdSincArquivos;
interface
uses
System.Classes, System.SysUtils, System.Generics.Collections, REST.Client, REST.Types,
System.JSON, Data.DB, Datasnap.DBClient, FireDAC.Comp.Client, FireDAC.Stan.Param, System.SyncObjs, EBase, EExceptionManager, EClasses;
type
TThrdSincArquivos = class(TThreadEx)
private
My thread's Create
constructor TThrdSincArquivos.Create(pPrimeiraExec: boolean; tipoSincParam: TTipoSinc);
begin
inherited Create(true);
NameThreadForDebugging('TThrdSincArquivos');
primeiraExec := pPrimeiraExec;
tipoSinc := tipoSincParam;
executadoThreadSinc := false;
FreeOnTerminate := true
end;
The start of my Execute
procedure TThrdSincArquivos.Execute;
var
contador: Integer;
begin
inherited;
try
and the end of the Execute
except
on ex: Exception do
begin
oLog.GravarLog(ex, 'TThrdSincArquivos.Execute => FIM');
end;
end;
end;
It refuses to log any exception to the Elf file. I tried to add a raise after my own log routine, but it still didn't help. It should log, but it isn't, unless I explicitly call the StandardEurekaError, but I get the stack wrong, and I get the dialog.
When you are using TThread class - it saves thread exception to .FatalException property, which you are supposed to handle in some way. Either from thread event, or from other (caller) thread. EurekaLog does not break this behaviour. E.g. your previosly written code will not change its behaviour when you enable EurekaLog. That way your properly written code would work correctly both with and without EurekaLog.
How your code is currently handling thread exceptions? Are you doing something like ShowMessage or custom logging? This obviosly would not work with EurekaLog, it does not know that you are processing exceptions with ShowMessage or your own custom logging code. You probably want something like Application.ShowException or re-raise in caller thread.
If you can not use default RTL/VCL processing (which is hooked by EurekaLog) for some reason - then you need to tell EurekaLog that you want to handle this particular exception. For example, from docs: you can use (for example) HandleException(E); from EBase unit:
Thread.WaitFor;
if Assigned(Thread.FatalException) then
begin
// Your old code is here
// Do your own thing: show message, log, etc.
// Tell EurekaLog to do its thing:
HandleException(Thread.FatalException);
end;
You would probably want to set exception filter or use events to disable dialogs for thread exceptions, because presumably you have already processed exception yourself (e.g. already showed message).
There is A LOT more ways to handle exception in threads, and EurekaLog's docs illustrate each thread case (like BeginThread, TThread, thread pools, etc.) with several possible options. It is just not reasonable to pack all this information into a single answer.
If, for some reason, you do not have code that processes .FatalException property of TThread - then you can use TThreadEx class and its .AutoHandleException property to handle exceptions automatically when thread exits, as described here:
type
TMyThread = class(TThreadEx)
protected
procedure Execute; override;
end;
procedure TMyThread.Execute;
begin
// ... your code ...
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Thread: TMyThread;
begin
Thread := TMyThread.Create(True, 'My thread');
Thread.AutoHandleException := True; // <- added
Thread.FreeOnTerminate := True;
Thread.Start;
Thread := nil; // never access thread var with FreeOnTerminate after Start
end;
However, be aware that you code will not work properly (e.g. will ignore exceptions) if you decide to disable EurekaLog in the future. Because if you remove EurekaLog from your project - then your project will have no code to handle thread exceptions!
P.S.
I need to change from TThread to TThreadEx, and add the following
code at the start of my Execute overriden method.
SetEurekaLogStateInThread(ThreadID, true);
That is slightly incorrect: you can do either one or another, but not both. And there are other ways to tell EurekaLog that it should hook exceptions in this thread.
Basically, exception life has two stages: raise and handle. EurekaLog hooks both stages when they are implemented in default RTL/VCL code. You need to explicitly indicate which threads you want to hook, because you probably want to ignore system / 3rd party threads, which you have no control over. And it so happens that default processing for TThread does not exist in RTL/VCL. That is why there is nothing to hook.
I have some inherited code for opening IE and I have some troubles, here is what I have:
IEUnit.pas (no form) has routines for LoadIE and OpenIE
OpenIE is called from separate thread and it looks like this
procedure OpenIE(URL: OleVariant; FieldValues: string = '');
var ie : IWebBrowser2; // <-- This should become "global" variable for the IEUnit
begin
ie := CreateOleObject('InternetExplorer.Application') as IWebBrowser2;
ie.Navigate2(URL, Flags, TargetFrameName, PostData, Headers);
ShowWindow(ie.HWND, SW_SHOWMAXIMIZED);
ie.Visible := true;
...
end;
I would like to have "global" ie variable in the unit and to write LoadIE routine like this :
LoadIE should be called from FormCreate (main thread)
It should just create "global" ie object
ie := CreateOleObject('InternetExplorer.Application') as IWebBrowser2;
so the OpenIE function doesn't need to create it, just to use it (purpose is to speed things up)
So problem is how to access same OLE object from 2 different threads, one creates the object, the other one uses it.
When I write code that doesn't take care of threads I get an error
exception class EOleSysError with message 'The application called an interface that was marshalled for a different thread'
How should I do it, to take care of threads (I'm not experienced with threads, some reading and video links are welcome).
Thanks in advance
MTA model COM servers can only be used from within their associated apartment. Here's the explanation of the error with the following advice:
The correct way of transferring an interface pointer (either a direct
pointer or a proxy pointer) from one apartment to another is via COM's
marshaling mechanism. The source apartment can call
CoMarshalInterThreadInterfaceInStream() to marshal the interface
pointer to a shared (global) stream. The destination apartment can
unmarshal this interface pointer by calling
CoGetInterfaceAndReleaseStream().
As you know, because it was the subject of your previous question, you need all calls to the COM object to be made from the same thread. The obvious choice is the main GUI thread. So, create the IWebBrowser2 in your main form's OnCreate event handler. And then use TThread.Synchronize or TThread.Queue whenever you need to show the browser. The code that you pass to Synchronize or Queue will be executed on the main GUI thread.
Assuming you are using a modern version of Delphi with support for anonymous methods you'd write it like this:
procedure TMyThread.ShowBrowser(const URL: string);
var
Proc: TThreadProcedure;
begin
Proc := procedure
begin
MainForm.Browser.Navigate2(URL, ...);
ShowWindow(MainForm.Browser.HWND, SW_SHOWMAXIMIZED);
MainForm.Browser.Visible := true;
end;
Queue(Proc);
end;
Non-free-threaded COM objects can only be used by/on/in the same thread as the one it's created for/on/in/with. In your case, to speed things up, I would use a plain global treadvar value of type IWebBrowser2, or a property in your class overriding TThread.
use CriticalSection to wrap all calls to the OleObject. also use Synchronize to call from the "other" thread to the main UI thread (this is why you get the exception).
What I basically want is to start AsyncCall and proceed with my code loading. I have Interface section that consumes lots of time (600+ms) and I want to load this code in independent thread.
I've tried to use AsyncCall to make something like this:
procedure Load;
begin
...
end;
initialization
AsyncCall(#Load, []); // or LocalAsyncCall(#Load)
However, this Load procedure actually starts in Main thread and not in the new created thread. How can I force the Load procedure to be loaded in any thread other than MainThread?
I can create TThread and Execute this but I want to force AsyncCall or LocalAsyncCall or anything from AsyncCall library to make to work.
Thanks for your help.
Have you tried something like this?:
procedure Load;
begin
if GetCurrentThreadId <> MainThreadID then
Beep;
end;
var a: IAsyncCall;
initialization
a := AsyncCall(#Load, []);
a.ForceDifferentThread;
ForceDifferentThread() tells AsyncCalls that the assigned function must
not be executed in the current thread.
The problem is that your code is not retaining the IAsyncCall interface that is returned by the AsyncCall function.
AsyncCall(#Load, []);
//AsyncCall returns an IAsyncCall interface,
//but this code does not take a reference to it
Because of this, the interface that is returned has its reference count decremented to zero as soon as the initialization section completes. This therefore frees the object that implements the interface which does this:
destructor TAsyncCall.Destroy;
begin
if FCall <> nil then
begin
try
--> FCall.Sync; // throw raised exceptions here
finally
FCall.Free;
end;
end;
inherited Destroy;
end;
The key line is the call to Sync which forces the asynchronous call to be executed to completion. All this happens in the main thread which explains the behaviour that you report.
The solution is that you simply need to keep the IAsyncCall interface alive by storing it in a variable.
var
a: IAsyncCall;
initialization
a := AsyncCall(#Load, []);
In the real code you need to ensure that Load had completed before running any code that is reliant on Load. When your program reached a point where it required Load to have been called it has to call Sync on the IAsyncCall interface.
So you might write it something like this.
unit MyUnit;
interface
procedure EnsureLoaded;
implementation
uses
AsyncCalls;
....
procedure Load;
begin
....
end;
var
LoadAsyncCall: IAsyncCall;
procedure EnsureLoaded;
begin
LoadAsyncCall := nil;//this will effect a call to Sync
end;
initialization
LoadAsyncCall := AsyncCall(#Load, []);
end.
The call EnsureLoaded from other units that required Load to have run. Or, alternatively, call EnsureLoaded from any methods exported by MyUnit that depended on Load having run. The latter option has much better encapsulation.
i use this code in a thread (through Indy Onexecute event) . is there any problem ?
function TFrmMain.ShellExecute_AndWait(FileName, Params: string): bool;
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
exInfo.lpVerb := 'open';
exInfo.lpParameters := PChar(Params);
lpFile := PChar(FileName);
nShow := SW_NORMAL;
end;
if ShellExecuteEx(#exInfo) then
Ph := exInfo.hProcess
else
begin
Result := true;
exit;
end;
while WaitForSingleObject(exInfo.hProcess, 50) <> WAIT_OBJECT_0 do
begin
end;
CloseHandle(Ph);
Result := true;
end;
MSDN has this advice:
Because ShellExecuteEx can delegate execution to Shell extensions (data sources, context menu handlers, verb implementations) that are activated using Component Object Model (COM), COM should be initialized before ShellExecuteEx is called. Some Shell extensions require the COM single-threaded apartment (STA) type. In that case, COM should be initialized as shown here:
CoInitializeEx(NULL, COINIT_APARTMENTTHREADED | COINIT_DISABLE_OLE1DDE)
There are instances where ShellExecuteEx does not use one of these types of Shell extension and those instances would not require COM to be initialized at all. Nonetheless, it is good practice to always initalize COM before using this function.
(In Delphi, you'd of course replace the first parameter with nil and use or for the bitwise operation.)
Raymond Chen recently wrote about the consequences of getting this wrong. The specific example was that the function might fail with the Error_Access_Denied error code.
That's the only potential multithreading issue I see in your code. Below are further things that occurred to me when I read your code, although they have nothing to do with multithreading (and not even much to do with Indy).
You have a peculiar way of waiting for the program to stop running. You repeatedly wait for 50 milliseconds at a time, but if the process isn't finished yet, you do nothing but wait again. Describe your intention more accurately by specifying Infinite for the timeout.
The function always returns True. If there's no useful return value, then you should just make it a procedure so there's no return value at all. Don't confuse the caller with useless information. If you're going to keep it as a function, then use the Delphi native type Boolean instead of the Windows compatibility type Bool for the return type.
I'm a little wary about the idea of a server executing user-interactive programs upon receipt of network messages.
Notice when MSDN says you might not get a process handle. There are cases when ShellExecuteEx can service your request without creating a new process, so you'll have nothing to wait on.
The user might end up using the program awhile, and your server will be stuck waiting all that time. I wonder whether it really needs to wait at all. Is the client going to be waiting for a response from the server, too?
I have just written my own logging framework (very lightweight, no need for a big logging framework). It consists of an interface ILogger and a number of classes implementing that interface. The one I have a question about is TGUILogger which takes a TStrings as the logging target and synchronizes the logging with the main thread so that the Items member of a listbox can be used as the target.
type
ILogger = Interface (IInterface)
procedure Log (const LogString : String; LogLevel : TLogLevel);
procedure SetLoggingLevel (LogLevel : TLogLevel);
end;
type
TGUILogger = class (TInterfacedObject, ILogger)
public
constructor Create (Target : TStrings);
procedure Log (const LogString : String; LogLevel : TLogLevel);
procedure SetLoggingLevel (LogLevel : TLogLevel);
private
procedure PerformLogging;
end;
procedure TGUILogger.Log (const LogString : String; LogLevel : TLogLevel);
begin
TMonitor.Enter (Self);
try
FLogString := GetDateTimeString + ' ' + LogString;
TThread.Synchronize (TThread.CurrentThread, PerformLogging);
finally
TMonitor.Exit (Self);
end;
end;
procedure TGUILogger.PerformLogging;
begin
FTarget.Add (FLogString);
end;
The logging works, but the application does not close properly. It seems to hang in the Classes unit. The stack trace:
System.Halt0, System.FinalizeUnits, Classes.Finalization, Classes.FreeExternalThreads,
System.TObject.Free, Classes.TThread.Destroy, Classes.TThread.RemoveQueuedEvents
What am I doing wrong here?
EDIT: I just found the following hint in the Delphi help for TThread.StaticSynchronize
Warning: Do not call StaticSynchronize from within the main thread. This can cause
an infinite loop.
This could be exactly my problem since some logging request come from the main thread. How can I solve this?
If you compare the CurrentThreadID with MainThreadID then you can choose to synchronize or not.
Personally, I chose to have the GUI ask the log system for the latest info, rather than have threads pause. Otherwise your logging interferes with the fast operation of the thread which defeats the purpose of having it.
If you don't find any simpler way, you could try doing this:
At program initialization, (from the main thread,) have your logging subsystem call the Windows API function GetCurrentThreadID and store the result in a variable. (EDIT: the MainThreadID variable in the System unit, gets initialized this way automatically for you at startup. Thanks, mghie.) When a logging request comes in after that, call GetCurrentThreadID again, and only synchronize if it's coming from a different thread.
There are other tricks that don't involve the Windows API, but they end up being more complicated, especially if you have a bunch of different custom TThread descendants. The basic principle is the same, though: Verify whether or not you're in the main thread before you decide whether or not to call StaticSynchronize.