finalization section not being run in a dll - delphi

I am trying to create a DLL in Delphi XE2 which will popup a form with a TWebBrowser component in it. When the WebBrowser.Navigate2 method is called the finalization section of the unit (or any unit) is not called when the application ends. If Navigate2 is not called, the finalization section happens just fine.
The dll is being called from C++ (VS 2010 MFC console at the moment) and linked via in import library.
There are other ways of doing this, but I would like to reuse the code we already have written.
Does anyone have any idea what is going on?
Thanks.
Here is a simple recreation of the problem:
library DisplayPatientAlertsIntf;
exports DisplayPatientAlertsA name 'DisplayPatientAlertsA#4';
begin
end.
unit uAlertWindow;
interface
uses
Winapi.ActiveX,
Forms,
SHDocVw,
Graphics, Controls;
function DisplayPatientAlertsA(PatientID : PAnsiChar): Integer; export; stdcall;
implementation
var ts : TStringList;
function DisplayPatientAlertsA(PatientID : PAnsiChar): Integer; export; stdcall;
var Form1 : TForm;
WebBrowser1 : TWebBrowser;
DidCoInit : Boolean;
begin
DidCoInit := Succeeded(CoInitialize(nil));
try
Form1 := TForm.Create(nil);
try
WebBrowser1 := TWebBrowser.Create(nil);
try
WebBrowser1.ParentWindow := Form1.Handle;
WebBrowser1.Align := alClient;
WebBrowser1.Navigate2('file://c:\temp.html');
Form1.ShowModal;
finally
WebBrowser1.Free;
end;
finally
Form1.Free;
end;
finally
if DidCoInit then
CoUninitialize;
end;
Result := 0;
end;
initialization
ts := TStringList.Create;
finalization
ts.Free;
end.
Update 2013.03.19
While solving another problem (dbExpress drivers in a dll), I changed it from a statically linked dll with an import library to a dynamically loaded dll and everything started working.

Do not call CoInitialize() or CoUninitialize() during the DLL's initialization/finalization. That is a very bad place to do that, and besides, it is not the DLL's responsibility to call them anyway. It is the responsibility of the thread that is calling the DLL functions. If you must call them, then at least do so inside of your exported function instead.
As for the exported function itself, use WebBrowser1.Parent instead of WebBrowser1.ParentWindow, use Form1.Free instead of Form1.Release, and get rid of Application.ProcessMessages altogether.
And lastly, do not export the function using a manually decorated name. That is not the DLL's responsibility to do, either. Let the compiler handle the decorating. If there is a naming mismatch when importing the function, that needs to be addressed in the calling app, not the DLL itself.
Your misuse of both COM and the VCL (especially since the problem only occurs once the exported DLL function is called) are likely leading to deadlocks, preventing the DLL from unloading from memory correctly, and thus none of its finalization sections would be called because its DLL entry point is not able to be called. COM is very sensitive when it comes to its initialization/cleanup, so you have to make sure you do it correctly, and in the correct context.
Try this:
library DisplayPatientAlertsIntf;
uses
uAlertWindow;
exports
DisplayPatientAlertsA;
begin
end.
.
unit uAlertWindow;
interface
uses
Winapi.ActiveX,
Forms,
SHDocVw,
Graphics, Controls;
function DisplayPatientAlertsA(PatientID : PAnsiChar): Integer; stdcall;
implementation
function DisplayPatientAlertsA(PatientID : PAnsiChar): Integer; stdcall;
var
Form1 : TForm;
WebBrowser1 : TWebBrowser;
DidCoInit: Boolean;
begin
Result := 0;
try
DidCoInit = Succeeded(CoInitialize(nil));
try
Form1 := TForm.Create(nil);
try
WebBrowser1 := TWebBrowser.Create(Form1);
WebBrowser1.Parent := Form1;
WebBrowser1.Align := alClient;
WebBrowser1.Navigate2('file://c:\temp.html'); //This contains 'ASDF'
Form1.ShowModal;
finally
Form1.Free;
end;
finally
if DidCoInit then
CoUninitialize;
end;
except
Result := -1;
end;
end;
end.

Delphi does not make heavy use of plain DLLs and its support is basic and scarcely documented
While Delphi makes good work for EXE files, intercepting WinMain and bringing its semantics to Turbo Pascal style context, for DLL you have to do it manually.
Start with reading DLL-Main Microsoft documentation and tutorials.
Then you can add into your DLL.dpr something like
begin
DLLProc := #DLLMain;
DLLMain(DLL_PROCESS_ATTACH);
end.
And then in some unit of DLL you can implement it like this:
procedure DLLMain(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
Application.HelpFile := HelpFileName;
dmSelVars := TdmSelVars.Create(nil);
end {= DLL_PROCESS_ATTACH =};
DLL_PROCESS_DETACH:
begin
Application.Handle := 0;
FreeAndNil(dmSelVars);
g_pSvRec := nil;
end {= DLL_PROCESS_DETACH =};
end {= case =};
end {= DLLMain =};
PS. Why using DLL, when you can use Delphi-native (since 1997) BPL instead ?
It solves many problems and it provides much better finalization support:
for manually-loaded packages (via LoadPackage(...) call) finalization called for all units by granted
for manually-loaded packages (via Project Options / Packages / Link with Runtime packages list ) finalization is called for all units, referenced in "uses" sections of your host EXE.
PPS. Starting MSIE for merely displaying one page - doesn't it look overkill ?
Perhaps native HTML support would suffice, even if limited somewhat ? And it is capable of loading page from TStream or from String w/o tinkering with intermediate temporary files. (Well, MSIE is capable as well, though, after some scaffolding).

You might find that an exception is being raised when one of the units is being finalized, preventing other units from being finalized.
I'm not sure about XE2, but older versions of Delphi tended to be very fussy about the ComObj unit being "high up" in the uses/initialization so it would be one of the last to finalize.
The problem was that if ComObj was finalized too soon, it would CoUninitialize too soon - effectively ripping the rug from under other code that still expected COM to be initialized.
If the XE2 version of SHDocVw still uses ComObj in its implementation section, then ComObj will be initialized relatively 'late'. So that could very well be your problem. In which case simply adding it explicitly and high up in your source should do the trick.

Related

Updating Inno Setup progress bar from Dephi DLL

I need your help, please. I'm trying to call function from DLL written in Delphi 10 Seattle from Inno Setup (ANSI). But I do not understand what is the problem. If I make application in Delphi and call this function from DLL, it works perfectly! See code listing:
Delphi DLL:
function Process(Pb: TProgressBar): Integer; stdcall;
var
I: integer;
begin
for I := 0 to 1000 do
begin
Pb.Position := I;
Pb.Update;
Sleep(10);
end;
end;
Exports
Process;
Inno Setup (ANSI):
function Count(Progr: TNewProgressBar): integer; external 'Process#files:CallC.dll stdcall delayload';
procedure NewButton1Click(Sender: TObject);
begin
Count(NewProgressBar1);
end;
After call I get Access Violation. But, comment in dpr file i read, ShareMem write first line, but zero effect.
Show me how to correctly update progress bar in Inno Setup from Delphi DLL, please.
You cannot call object methods this way. You may be lucky to get this working, if you use exactly the same version of Delphi as the one Inno Setup is built with, as your tests with Delphi application shows. But it is still wrong and unreliable, do not do it. As you use a different Delphi version, the layout of the progress bar class in memory is different, hence the "Access violation".
For this particular task, you can easily do with just a handle to the progress bar:
function Process(Handle: THandle): Integer;
var
I: Integer;
begin
SendMessage(Handle, PBM_SETRANGE, 0, 1000 shl 16);
for I := 0 to 1000 do
begin
SendMessage(Handle, PBM_SETPOS, I, 0);
UpdateWindow(Handle);
Sleep(10);
end;
end;
In Inno Setup, call the function like:
function Count(Handle: THandle): integer;
external 'Process#files:CallC.dll stdcall delayload';
procedure NewButton1Click(Sender: TObject);
begin
Count(NewProgressBar1.Handle);
end;
For more advanced tasks, you need to use a callback.
See
Using callback to display filenames from external decompression dll (Inno Setup)
Call C# DLL from Inno Setup with callback

Delphi: Access violation after calling procedure in dll

I have created a procedure in a dll that opens a form and then prints a report.
This procedure works perfectly from an exe.
I have wrapped the unit that contains this procedure and forms in a dll and exported the procedure as follows:
{$R *.res}
Procedure PrintTopSellers; stdcall;
begin
Form1 := TForm1.create(nil);
GetMonth := TGetMonth.create(nil);
Form1.PrintTopSellers;
end;
exports PrintTopSellers;
begin
end.
Now I call this procedure PrintTopSellers from an exe as follows:
procedure TForm1.Button5Click(Sender: TObject);
type
TRead_iButton = function :integer;
var
DLL_Handle: THandle;
Read_iButton: TRead_iButton;
Begin
DLL_Handle := LoadLibrary('c:\Catalog.dll');
if DLL_Handle <> 0 then
begin
#Read_iButton:= GetProcAddress(DLL_Handle, 'PrintTopSellers');
Read_iButton;
end;
application.ProcessMessages;
FreeLibrary(DLL_Handle);
end;
The call to the procedure works perfectly. However, after I close the calling exe, I get an access violation - "Access violation at address 00BAC89C. Read of address 00BAC89C."
Appreciate any assistance. I am using Delphi 7.
Thanks
You are creating Form1, a windowed control, in the DLL. But you never destroy it. Then you unload the DLL which unloads the code that implements the window procedures for all windows created by the DLL. Presumably when the process shuts down, the window procedures are called, but there is no code there anymore.
Fix the problem by destroying all objects that the DLL creates. It looks to me like the best approach is to do that when PrintTopSellers terminates.
Procedure PrintTopSellers; stdcall;
begin
Form1 := TForm1.create(nil);
try
GetMonth := TGetMonth.create(nil);
try
Form1.PrintTopSellers;
finally
GetMonth.Free;
end;
finally
Form1.Free;
end;
end;
In the code that loads the DLL, TRead_iButton is declared incorrectly. It should be
TRead_iButton = procedure; stdcall;
But that doesn't actually explain the problem here since the signature mismatch is benign for a parameterless procedure.
"TRead_iButton = function: integer; register;"
"Procedure PrintTopSellers; stdcall;"
Absolutely different conventions/types, ain't them ?
Make them the same.
And better ditch DLL and use packages (BPL), then compiler would make you safe from such errors
We also don't see the code neither in Form1.PrintTopSellers nor in TGetMonth. The all can leave some dangling pointers in the host exe, that would get accesses after DLL unloaded.
Show exactly chain of function calls leading to AV - it is called stack trace.
Debug info + some excaption interrupt like Jedi CodeLibrary (used by Delphi IDE) madExcept, EurekaLog, synopse log and a lot of other exist.
Display the call stack in a Delphi Win32 application
Does DLL or EXE use Runtime packages ?

DLL registration with regsvr32.exe freezes when unit HtmlHelpViewer is used in Delphi XE or Delphi XE2

DLL registration with regsvr32.exe freezes when unit HtmlHelpViewer is used in DLL sources in Delphi XE or Delphi XE2 Update 3. Just add the unit to interface uses list. The main project (that uses DLL) freezes on exit too.
How to fix the issue?
Thanks for the help!
STEPS TO REPRODUCE THE ISSUE AND ISSUE IN SUGGESTED FIX:
1). Please create the following DLL:
library Test;
uses
ComServ,
HtmlHelpFixer,
HtmlHelpViewer;
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
begin
end.
2). Also create the following BPL linked to this DLL (by -LUTestBpl dcc32 parameter for example):
package TestBpl;
requires
Vcl;
end.
3). Then just execute: regsvr32.exe /s Test.dll. OS Windows 7 32-bit.
Update
According to the latest comments on the QC report submitted by Altaveron, this problem will be resolved in the next Delphi update, update 4. And indeed, Altaveron now confirms that update 4 does resolve the issue.
This is a known problem with the MS HTML help control, hhctrl.ocx. The best description of it that I am aware of is at the HelpWare FAR HTML FAQ. There are many QC reports describing the issue: 48983, 67463, 78998, 89616.
According to the latest QC report, this is fixed in XE2 but you report otherwise and I'd be inclined to believe you. Especially as a comparison of the source for the HtmlHelpViewer unit from XE and XE2 reveals no changes that appear related to this issue.
It's quite hard to work around the issue since the code that needs to be modified is buried deep inside the HtmlHelpViewer unit. I've had to resort to patching the HtmlHelp API call. Like this:
unit HtmlHelpFixer;
interface
implementation
uses
Windows;
function HtmlHelp(hWndCaller: HWND; pszFile: PWideChar; uCommand: UINT; dwData: DWORD): HWND;
begin
if uCommand=HH_CLOSE_ALL then begin
//don't call HtmlHelpW because it can result in a hang due to a bug in hhctrl.ocx
Result := 0;
end else begin
Result := HtmlHelpW(hWndCaller, pszFile, uCommand, dwData);
end;
end;
procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
OldProtect: DWORD;
begin
if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then begin
Move(NewCode, Address^, Size);
FlushInstructionCache(GetCurrentProcess, Address, Size);
VirtualProtect(Address, Size, OldProtect, #OldProtect);
end;
end;
type
PInstruction = ^TInstruction;
TInstruction = packed record
Opcode: Byte;
Offset: Integer;
end;
procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
NewCode: TInstruction;
begin
NewCode.Opcode := $E9;//jump relative
NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
procedure RedirectHtmlHelp;
var
HtmlHelp: function(hWndCaller: HWND; pszFile: PWideChar; uCommand: UINT; dwData: DWORD_PTR): HWND;
begin
HtmlHelp := Windows.HtmlHelp;
RedirectProcedure(#HtmlHelp, #HtmlHelpFixer.HtmlHelp);
end;
initialization
RedirectHtmlHelp;
end.
Include this unit early in your .dpr uses list, before any unit that does anything with HTML help.
The version of the code that I use does a little more and takes steps to ensure that any open help windows are closed when the DLL unloads. This no longer happens because we have stopped sending HH_CLOSE_ALL.
You will want to make sure that any help windows are shut down then keep track of the window handles returned by HtmlHelp calls, which you can now intercept. Then at shutdown send a WM_CLOSE message to those windows which replaces the missing HH_CLOSE_ALL call to HtmlHelp.
However, I believe that the code above should get you over your immediate hurdle with regsvr32 which won't be showing help windows.
Feel free to do some experimentation! At the very least, the code above gives you entry points with which you can modify the behaviour of the HtmlHelpViewer unit.
Embarcadero have fixed this issue on Delphi XE2 Update 4. But now context help doesn't work on IDE while you're using BPL with HtmlHelpViewer unit on uses clause.

Apply Windows Theme to Office Com add-in

For ages, Delphi has supported the Enable runtime themes switch on the Application Settings tab. However, this only works for executables. DLLs are assumed to take over the theming (and other) setings from their parent application.
Unfortunately, Microsoft Office doesn't play nice there. Their 'themed' look is achieved using custom controls, not through Windows' own Common Controls.
In the MSDN article 830033 - How to apply Windows XP themes to Office COM add-ins
Microsoft explains how to apply a manifest to a DLL, making it Isolation Aware such that settings from the parent process are ignored.
Basically, it comes down to two steps:
Include the default manifest resource in your process, using an int-resource id of 2 (as opposed to the 1 you'd normally use).
Compile with the ISOLATION_AWARE_ENABLED define. **Which isn't available in Delphi.**
I think I've got (1) nailed down, although I'm never quite sure whether brcc32 picks up resource IDs as integers or as literal strings. The real problem lies with (2). Supposedly, this define changes several DLL function bindings.
Has anyone solved this problem in Delphi? Should I further investigate this route, should I try and manually creating activation contexts, or are there other elegant solutions to this problem?
I've done this for my COM add-in. I used activation contexts. It's pretty easy for a COM add-in because the surface area of the add-in interface is so small. I could post code but I won't be at a machine with it on until tomorrow. Hope this helps!
UPDATE
As promised, here is the code that I use:
type
(* TActivationContext is a loose wrapper around the Windows Activation Context API and can be used
to ensure that comctl32 v6 and visual styles are available for UI elements created from a DLL .*)
TActivationContext = class
private
FCookie: LongWord;
FSucceeded: Boolean;
public
constructor Create;
destructor Destroy; override;
end;
var
ActCtxHandle: THandle=INVALID_HANDLE_VALUE;
CreateActCtx: function(var pActCtx: TActCtx): THandle; stdcall;
ActivateActCtx: function(hActCtx: THandle; var lpCookie: LongWord): BOOL; stdcall;
DeactivateActCtx: function(dwFlags: DWORD; ulCookie: LongWord): BOOL; stdcall;
ReleaseActCtx: procedure(hActCtx: THandle); stdcall;
constructor TActivationContext.Create;
begin
inherited;
FSucceeded := (ActCtxHandle<>INVALID_HANDLE_VALUE) and ActivateActCtx(ActCtxHandle, FCookie);
end;
destructor TActivationContext.Destroy;
begin
if FSucceeded then begin
DeactivateActCtx(0, FCookie);
end;
inherited;
end;
procedure InitialiseActivationContext;
var
ActCtx: TActCtx;
hKernel32: HMODULE;
begin
if IsLibrary then begin
hKernel32 := GetModuleHandle(kernel32);
CreateActCtx := GetProcAddress(hKernel32, 'CreateActCtxW');
if Assigned(CreateActCtx) then begin
ReleaseActCtx := GetProcAddress(hKernel32, 'ReleaseActCtx');
ActivateActCtx := GetProcAddress(hKernel32, 'ActivateActCtx');
DeactivateActCtx := GetProcAddress(hKernel32, 'DeactivateActCtx');
ZeroMemory(#ActCtx, SizeOf(ActCtx));
ActCtx.cbSize := SizeOf(ActCtx);
ActCtx.dwFlags := ACTCTX_FLAG_RESOURCE_NAME_VALID or ACTCTX_FLAG_HMODULE_VALID;
ActCtx.lpResourceName := MakeIntResource(2);//ID of manifest resource in isolation aware DLL
ActCtx.hModule := HInstance;
ActCtxHandle := CreateActCtx(ActCtx);
end;
end;
end;
procedure FinaliseActivationContext;
begin
if ActCtxHandle<>INVALID_HANDLE_VALUE then begin
ReleaseActCtx(ActCtxHandle);
end;
end;
initialization
InitialiseActivationContext;
finalization
FinaliseActivationContext;
When you want to use this, you simply write code like so:
var
ActivationContext: TActivationContext;
....
ActivationContext := TActivationContext.Create;
try
//GUI code in here will support XP themes
finally
ActivationContext.Free;
end;
You need each entry point that does GUI work to be wrapped in such code.
Note that in my COM add-in DLL I have taken special measures to avoid running code during DLLMain, and so my calls to InitialiseActivationContext and FinaliseActivationContext are not in unit initialization/finalization sections. However, I see no reason why this code would not be safe to place there.

How can a component at designtime determine the project directory

I write a component which should store some information relative to the project directory. Every time a property of my component is changed it should write a file. So how can a component determine the current project directory at design time.
Thanks in advance
EDIT:
I want to generate a delphi source file every time a property of my component is changed, so that I always get the latest version when I compile my code. Think of it as a kind of code generator.
At the moment I set whole path and filename where the source should be stored but I prefer a relative path to the project (or the form/datamodule which contains my component) to make it easier to copy the project on different developer machines.
Thanks for the hints. Open Tools API is the way to go and using the Open Tools API from a component on a form at designtime is possible.
So here is my solution:
I need two units, one for the component and one for registering the component and the code which use the Open Tools API.
Here comes the component unit:
unit TestLabels;
interface
uses
SysUtils, Classes, Windows, Controls, StdCtrls;
type
TTestLabel = class(TLabel)
private
FTestProperty: Boolean;
procedure SetTestProperty(const Value: Boolean);
procedure Changed;
published
property TestProperty: Boolean read FTestProperty write SetTestProperty;
end;
var
OnGetUnitPath: TFunc;
implementation
{ TTestLabel }
procedure TTestLabel.Changed;
begin
if not (csDesigning in ComponentState) then
Exit; // I only need the path at designtime
if csLoading in ComponentState then
Exit; // at this moment you retrieve the unit path which was current before
if not Assigned(OnGetUnitPath) then
Exit;
// only for demonstration
Caption := OnGetUnitPath;
MessageBox(0, PChar(ExtractFilePath(OnGetUnitPath)), 'Path of current unit', 0);
end;
procedure TTestLabel.SetTestProperty(const Value: Boolean);
begin
if FTestProperty Value then
begin
FTestProperty := Value;
Changed;
end;
end;
end.
Here is the unit for registering the component and the call to the Open Tools API:
unit TestLabelsReg;
interface
uses
SysUtils, Classes, Controls, StdCtrls, TestLabels;
procedure register;
implementation
uses
ToolsAPI;
function GetCurrentUnitPath: String;
var
ModuleServices: IOTAModuleServices;
Module: IOTAModule;
SourceEditor: IOTASourceEditor;
idx: integer;
begin
Result := '';
SourceEditor := nil;
if SysUtils.Supports(BorlandIDEServices, IOTAModuleServices,
ModuleServices) then
begin
Module := ModuleServices.CurrentModule;
if System.Assigned(Module) then
begin
idx := Module.GetModuleFileCount - 1;
// Iterate over modules till we find a source editor or list exhausted
while (idx >= 0) and not SysUtils.Supports(Module.GetModuleFileEditor(idx), IOTASourceEditor, SourceEditor) do
System.Dec(idx);
// Success if list wasn't ehausted.
if idx >= 0 then
Result := ExtractFilePath(SourceEditor.FileName);
end;
end;
end;
procedure register;
begin
RegisterComponents('Samples', [TTestLabel]);
TestLabels.OnGetUnitPath := GetCurrentUnitPath;
end;
end.
Starting with delphi 7, the ToolsAPI unit defines a getActiveProject function which returns the IOTAProject interface of the current project.
The fileName property of IOTAProject returns the full path of the main source file of the project (typically the .dpr file).
So, in many cases, it's possible to use a simple instruction such as:
if csDesigning in componentState then
appFolderPath := extractFilePath( getActiveProject.fileName )
else
appFolderPath := extractFilePath( application.exeName );
(and there's no need of using two units as in Heinz's example above)
A component cannot access your source path, because a component is placed in your application and run as a part of your application out of Delphi IDE.
If you want to have access to project path, or automate any process inside IDE; you have to write an IDE expert using OpenTools API, not a component.
I don't think it can. You can determine the directory your EXE is running in easily enough, but your component at design-time is running as a part of the IDE. I doubt there's a way for the component to access project information through the IDE.
see
http://www.gexperts.org/otafaq.html#project
and then
www.href.com/pub/sw/ProjectOptions.html
may be it helps
I had A little bit different objective: how to know where the project exe will be at design time, so that the application at runtime can share some files with the design time functionality.
So, I combined the two best answers and created the following function to be used in applications:
unit MyUtils;
interface
function GetProjectTargetPath: string;
var
_GetProjectTargetPath: TFunc<string>;
...
implementation
function GetProjectTargetPath: string;
begin
Result := '';
if Assigned(_GetProjectTargetPath) then
Result := _GetProjectTargetPath;
if Result <> '' then
Result := IncludeTrailingPathDelimiter(Result);
end;
and then in the component registration unit (which I have separate and linked only to the design time package):
unit MyUtils;
...
implementation
function GetProjectTargetPath: String;
begin
Result := ExtractFilePath( GetActiveProject.ProjectOptions.TargetName );
end;
procedure Register;
begin
...
MyUtils._GetProjectTargetPath := GetProjectTargetPath;
end;
Thus avoiding the actual unit to depend on ToolsAPI.
MyUtils.GetProjectTargetPath returns an empty string at runtime, which corresponds to the application exe-directory in practice.

Resources