Problem handling threads within a DLL in Delphi - multithreading

I'm testing out the QuickLogger library from Exilon, which I found to be a pretty versatile logging library, and later on found that it can be accessed through the GetIt Package Manager.
I have been struggling to encapsulate logging abilities for our win32 apps, but only when they are executed on Windows 7 or Windows Server 2008 R2. If I run the code on Windows 10 or Windows Server 2016 or 2019, it works like a charm.
The problem seems to be related to thread handling inside a DLL.
I isolated the problem to the bare minimum code.
The library
library libProject;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
//ShareMem,
System.SysUtils,
System.Classes,
Quick.Logger,
Quick.Logger.Provider.Console;
{$R *.res}
function AddIntegers(const _a, _b: integer): integer; stdcall;
begin
Result := _a + _b;
Logger.Debug('Some debug info');
end;
exports
AddIntegers;
begin
Logger.Providers.Add(GlobalLogConsoleProvider);
with GlobalLogConsoleProvider do
begin
LogLevel := LOG_VERBOSE;
ShowEventColors := True;
Enabled := True;
end;
end.
The test program
program consoleProject;
{$APPTYPE CONSOLE}
{$R *.res}
uses
//ShareMem,
System.SysUtils,
Quick.Logger,
Quick.Logger.Provider.Console;
function AddIntegers(_a, _b: integer): integer; stdcall; external 'libProject.dll';
begin
Logger.Providers.Add(GlobalLogConsoleProvider);
try
WriteLn(AddIntegers(1, 2));
WriteLn('Press Enter');
ReadLn;
except
on E: Exception do
WriteLn(E.ClassName, ': ', E.Message);
end;
end.
Basically, the problem is that the DLL prevents the app from terminating normally because of some unfinished thread execution.

Related

Creating MainForm on a TThread

I have a Delphi 2010 application that exports a DLL and has the library header. It creates its MainForm in a TThread, like so:
var
ActiveThread: TActive;
type
TActive= class(TThread)
protected
procedure Execute; override;
end;
procedure TActive.Execute;
begin
Application.Initialize;
Application.CreateForm(MyForm, form);
Application.Run;
end;
begin
ActiveThread := TActive.Create(true);
ActiveThread.FreeOnTerminate := true;
ActiveThread.Resume;
end.
Whenever I load this DLL through the LoadLibrary function, the application runs fine. (Apparently it uses the thread that I passed to LoadLibrary as the main thread and has no issues)
But if I attempt to export this DLL to an actual EXE, by changing the generated output in Options -> Application. and changing the header from library to program and then build it and execute the output EXE instead of loading the DLL through the windows api, the application hangs when attempting to create the form, specifically at Application.CreateForm(MyForm, form);. If I remove the Application initialization from the thread and place it on the main routine, it runs just fine.
The form I'm trying to render is just an empty form. Any ideas?
When compiling this code as a program, at runtime it will try to terminate itself when end. is reached, before the worker thread even has a chance to run, which could possibly (and likely) happen after the Application object has been destroyed. You would have to wait for the worker thread to finish its work before letting the program exit, eg:
program MyProgram;
uses
Classes, Forms, MyForm;
type
TActive = class(TThread)
protected
procedure Execute; override;
end;
procedure TActive.Execute;
begin
Application.Initialize;
Application.CreateForm(TMyForm, MyForm);
Application.Run;
end;
var
ActiveThread: TActive;
begin
ActiveThread := TActive.Create(False);
ActiveThread.WaitFor;
ActiveThread.Free;
end.
But, there is really no good reason to ever use a worker thread like this, this defeats the whole purpose of using a thread, so you may as well just get rid of it altogether:
program MyProgram;
uses
Forms, MyForm;
begin
Application.Initialize;
Application.CreateForm(TMyForm, MyForm);
Application.Run;
end.
On the other hand, if you are trying to share common code between program and library projects, then you can wrap the Application code inside of a function and let the project decide which thread calls the function, eg:
unit MyApp;
interface
procedure RunMyApp;
implementation
uses
Forms, MyForm;
procedure RunMyApp;
begin
Application.Initialize;
Application.CreateForm(TMyForm, MyForm);
Application.Run;
end;
end.
program MyProgram;
uses
MyApp;
begin
RunMyApp;
end.
library MyLibrary
uses
Classes, MyApp;
type
TActive = class(TThread)
protected
procedure Execute; override;
end;
procedure TActive.Execute;
begin
RunMyApp;
end;
var
ActiveThread: TActive;
begin
ActiveThread := TActive.Create(True);
ActiveThread.FreeOnTerminate := True;
ActiveThread.Resume;
end.

Why do I need Sharemem in my Delphi dll which only exposes a function with WideString parameters?

I have a dll and a test application written in Delphi. The test application uses multiple threads to call the function exported by the dll. The exported function has a trivial thread safe implementation. When running the test application various errors (access violation, invalid pointer operation, stack overflow etc) happens or the application freezes. In some cases the application finishes without errors.
Note that these errors only happen (surface) when using multiple threads. When calling the function from the main thread only then everything works fine.
I have found that adding ShareMem to both the dll and the application stops all these kind of errors. But I don't understand why. To my knowledge ShareMem is only needed when passing long strings between the dll and the application. As far as I know WideString is not a long string.
Also according to this post ShareMem should not be required:
Why can Delphi DLLs use WideString without using ShareMem?
Here is the source of the dll:
library External;
uses
Winapi.Windows;
type
TMyType = class
private
FText: string;
end;
function DoSomething(input: WideString; out output: WideString): Bool; stdcall;
var
x: TObject;
begin
x := TMyType.Create;
try
output := x.ClassName;
finally
x.Free;
end;
Result := True;
end;
exports
DoSomething;
begin
end.
Here is the test application:
program ConsoleTest;
{$APPTYPE CONSOLE}
uses
System.SysUtils,
Winapi.Windows,
OtlParallel;
function DoSomething(input: WideString; out output: WideString): Bool; stdcall; external 'External.dll' name 'DoSomething';
var
sResult: WideString;
begin
try
Parallel.&For(0, 500).Execute(procedure(value: Integer)
var
sResult: WideString;
begin
DoSomething('hhh', sResult);
end);
WriteLn('Done');
ReadLn;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Why ShareMem makes the bugs go away and is there another way to fix these bugs?
I am using Delphi XE2 and OmniThread 3.07.5.
Update
- Same issue when run from a VCL application's button's on click event handler
- If DoSomething uses a critical section inside then runs fine
- If FText field is removed from TMyClass then no errors are reported but the application randomly freezes
For the standard memory manager (FastMM) to support multi threading, you need to set the IsMultiThread flag.
When you use RTL for threading, this flag is automatically set. As revealed in the comments to the question, OTL also use RTL to start its threads. So the memory manager in your executable is aware of threading, but the distinct memory manager in the dll causes errors. When you use "sharemem", there is only one memory manager which is aware of threading because of OTL, so you encounter no errors.
An alternative solution, apart from using a shared memory manager, would be to set the flag also for the memory manager in the dll.

Delphi IDE hangs when I create a thread

I have a problem that Delphi (2010) IDE and the program both hang during debugging when I run a thread.
Both windows do not respond. When I kill the program, IDE works again.
It took time, I had to delete pieces of my program and I found the problem.
It is caused by VirtualStringTree.
So if I put just empty VirtualStringTree (v. 5.5.3) on form, one button to execute TThread with just "Sleep(2000)" in Execute procedure and run such program under debugger, it hangs (usually at first click). When I remove the VST, it works.
I have also noticed that Windows Reporting Service is started but I haven't found anything in the Windows event log.
Does anyone have any idea how this is possible?
Full source here
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
VirtualStringTree1: TVirtualStringTree;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TTestThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TTestThread }
procedure TTestThread.Execute;
begin
FreeOnTerminate:=True;
Sleep(2000);
end;
{ TForm }
procedure TForm1.Button1Click(Sender: TObject);
begin
TTestThread.Create(False);
end;
end.
EDIT:
I have also tried to debug Delphi process. I attached from second to first IDE. When I click the button to start the thread, both IDEs hang. So I have tried with Delphi 7 which I also have installed. That worked. It stays in a loop somewhere in ntdll.NtWaitForMultipleObjects, KERNELBASE.WaitForMultipleObjectsEx, USER32.MsgWaitForMultipleObjects.
I have completely reinstalled Delphi, no change. It may also be related to this line in VirtualStringTree source: "WaitForSingleObject(WorkEvent, INFINITE);". When I remove it, it does not freeze. But I think it is necessary there.
Finally I installed Delphi XE and that works correctly. It is mysterious.
TTestThread is a descendant of TThread in your code but it still needs a variable declaration and a proper constructor call.
var
MyThread: TTestThread;
The proper call to instantiate it would be
MyThread := TTestThread.Create(False);
rather than trying to invoke the constructor as you have in the button click event.
Good luck and have fun.
RP

Linux - XFCE4 - Lazarus system wide hotkey

I have done quite a bit of searching in Google and though I can find the switches to do this for Windows using WM_HOTKEY I cannot find it for Linux.
WM_HOTKEY Hook
uses ...,windows;
var
PrevWndProc: WNDPROC;
const
MY_ID=1;
function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam):LRESULT; stdcall;
begin
if (uMsg=WM_HOTKEY) and (WParam=MY_ID) then
begin
Application.Restore;
end;
result:=CallWindowProc(PrevWndProc,Ahwnd, uMsg, WParam, LParam);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
PrevWndProc:=Windows.WNDPROC(SetWindowLong(Self.Handle,GWL_WNDPROC,PtrInt(#WndCallback)));
RegisterHotKey(Self.Handle,MY_ID,0,vk_F9);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotkey(Self.Handle,MY_ID);
end;
I am looking to place a system wide hotkey hook in XFCE4 and/or XWindows on a linux machine. I know it is possible as many screenshot programs do this all the time no matter what the Window Manager is.
I need for my app to be able to hook a key combo to activate something inside the app but I cannot find anything for this with Lazarus/Pascal on linux anywhere.
Marco knows more about FPC than most (think he wrote it).
In any event you may find the code at the link below helpful and/or other portions of the code base:
http://code.google.com/p/ovoplayer/source/browse/trunk/src/platform/darwin/mmkeys.inc?spec=svn206&r=206

Multithreaded file write via an existing object

Application Description:
I have an application that allows a user to run multiple concurrent queries via threads (up to 100 at once).
I have a class that I use for logging errors. If an error occurs in the application, I create an instance of the class and call a procedure to write the error to a log file.
Question:
I need to make the error logging code thread safe. I've noticed that if a lot of threads are running at the same time and generating the same error (e.g. cannot connect to database), I'm getting i/o error 32 (caused by the application attempting to write to a file that's already open).
As a quick and dirty fix, I've put the code that writes to file in a try... except block inside a repeat loop. If there is an exception (e.g. the file has already been opened by another instance of the class, kicked off by another thread), then it sets a flag to "false". The loop continues to execute until the flag is "true" (i.e. no error writing to file), as follows:
procedure TErrorLogging.logError(error: string);
var
f: textfile;
ok: boolean;
begin
repeat
ok := true;
try
assignfile(f, fLogFilename);
if fileExists(fLogFilename) then append(f) else rewrite(f);
writeln(f, error);
closefile(f);
except
ok := false;
end;
until ok;
end;
I'm aware that the correct way to protect blocks of code is by using Critical Sections, but I'm not sure how I'd implement that, given that there are a number of different threads that use the logging class, and each instance of the thread has its own instance of the logging class that it uses to write to file (so they're not all just synchronizing against the same block of code).
The options, as I can see them:
Use the code as above. Are there any issues with leaving this code as it is? It's a quick and dirty fix, but it works.
Use a global TCriticalSection (how?).
Use a single procedure somewhere that creates an instance of the logging class, which the threads will synchronize against (which defeats the object of having a logging class, I suppose).
Creating instance of a logging class whenever you want to append log entry is wrong as well as opening and closing a log file over and over again. I would personally use one instance of a class which internally uses a string list and whose basic methods are thread safe. Something like this:
type
TErrorLog = class
private
FList: TStringList;
FLock: TRTLCriticalSection;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Add(const ErrorText: string);
procedure SaveToFile(const FileName: string);
end;
implementation
{ TErrorLog }
constructor TErrorLog.Create;
begin
inherited Create;
InitializeCriticalSection(FLock);
FList := TStringList.Create;
end;
destructor TErrorLog.Destroy;
begin
EnterCriticalSection(FLock);
try
FList.Free;
inherited Destroy;
finally
LeaveCriticalSection(FLock);
DeleteCriticalSection(FLock);
end;
end;
procedure TErrorLog.Clear;
begin
EnterCriticalSection(FLock);
try
FList.Clear;
finally
LeaveCriticalSection(FLock);
end;
end;
procedure TErrorLog.Add(const ErrorText: string);
begin
EnterCriticalSection(FLock);
try
FList.Add(ErrorText);
finally
LeaveCriticalSection(FLock);
end;
end;
procedure TErrorLog.SaveToFile(const FileName: string);
begin
EnterCriticalSection(FLock);
try
FList.SaveToFile(FileName);
finally
LeaveCriticalSection(FLock);
end;
end;
Not knowing Delphi, as a general design rule (if possible), I would have your logError function insert into a thread safe Array, ArrayList, Queue object or such that you have available, and then have it write to the file in the background, perhaps every 5-10 seconds or so. This should not only take care of the i/o problem, but should also scale to thousands of writes per second in case you want to log other events for debugging or such.

Resources