Hello all,
(warning, this will be lengthy)
This is a continuation of a previous thread ("App as a DLL, inside the form
of another app"), in that I've gotten the basics together, but some problems
are cropping up.
I'm showing an app as a DLL inside another app. The dll app has to be fully
functional, but must be placed inside the main form of the calling app (so
as to look like an extension of the calling app). The DLL app must naturally
be called dynamically, since if it is not present, the panel for it has to
be hidden. After some good advice, I placed a lot of stuff and tested the
dll app by calling it from a toy calling application, ie one that just had a
form and a panel on it, and showed the dll app on the panel. Everything ran
ok. So I tried to call the dll app from my "real" app, using the same setup
as on the "toy" calling app. My real app is of course a big and heavy one,
with lots of 3rd party components and other bells and whistles. It calls the
dll app ok, but for some reason, after about a minute or two, there is an
access violation message "Application 'RealApp.exe' has caused too many
consecutive errors: access violation on reading address 0xff6404dc". After
this, RealApp has to be shut down and restarted.
Here's an outline of my setup and what I've discovered so far. First, the
setup:
1) The DLL contains an "export" unit, to allow its functions to be exported:
*******************************
unit ExportDll;
interface
...
type
TDllAppInfo = record
OldApp : TApplication;
OldProc : Pointer;
end;
function CreateDLLFormInCtl(App : TApplication; Ctl: TWinControl): HWnd;
stdcall;
procedure DLLEntryPoint(dwReason: DWORD); stdcall;
implementation
var
TheDLLMainForm : TDLLMainForm //the main form of the DLL
TheHWnd : HWnd;
DllApp : TDllAppInfo;
function CreateDLLFormInCtl(App : TApplication; Ctl: TWinControl): HWnd;
stdcall;
var
Frm: TDLLMainForm;
begin
result := 0;
Application := App;
if Ctl <> nil then
begin
Frm := TDLLMainForm.CreateParented(Ctl.Handle);
Frm.Show;
Frm.BorderStyle := bsNone;
Frm.WindowState := wsMaximized;
Frm.Align := alClient;
TheDLLMainForm := Frm;
TheHWnd := Frm.ParentWindow;
Result := TheHWnd;
end;
end;
procedure DLLEntryPoint(dwReason: DWORD); stdcall;
begin
case dwReason of //(?1) my test stopping point
DLL_PROCESS_ATTACH:
begin
// nothing actually done here
end;
DLL_PROCESS_DETACH:
begin
if TheDLLMainForm <> nil then
begin
TheDLLMainForm.free; //NOT "release", as that causes errors!
TheDLLMainForm := nil;
end;
DLLProc := DLLApp.OldProc;
Application := DLLApp.OldApp;
end;
end;
end;
exports
CreateDLLFormInCtl,
DLLEntryPoint;
begin
DllApp.OldProc := @DLLProc;
DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH); //(?2) the error I get is the same
whether I call this line or not
end.
********************************
2) The calling app contains an "import" unit, to import the DLL app's
functions:
********************************
unit ImportDll;
interface
...
type
TCreateDLLFormInCtl = function (App : TApplication; Ctl: TWinControl):
HWnd; stdcall;
TDLLEntryPoint = procedure (dwReason: DWORD); stdcall;
function LoadDLLApp: Boolean;
procedure UnloadDLLApp;
var
MyCreate : TCreateDLLFormInCtl;
MyDLLEntryPoint : TDLLEntryPoint;
implementation
var
hWDLL: THandle = 0;
const
WR_Dll_Name = 'WR_Dll.dll';
function LoadDLLApp: Boolean;
begin
if (hWDLL = 0) then
begin
hWDLL := LoadLibrary('DLLApp.dll');
if (hWDLL <> 0) then
begin
@MyCreate := GetProcAddress(hWDLL, 'CreateDLLFormInCtl');
@MyDLLEntryPoint := GetProcAddress(hWDLL, 'DLLEntryPoint');
end;
end;
Result := (hWDLL <> 0);
end;
procedure DechargerDLLWR;
begin
if (hWDLL > 0) then FreeLibrary(hWDLL);
end;
end.
********************************
3) The calling app's main form (TForm1 here) behaves as follows:
********************************
interface
uses ...WR_ImportDll,...
type
TForm1 = class(TForm)
Panel: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
public
hwr: HWnd;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadDLLApp;
hwr := CreateDLLFormInCtl(Application,Panel);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnloadDLLApp;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := True;
DLLEntryPoint(DLL_PROCESS_DETACH);
end;
***************************
Now here's what I've found so far.
I'm debugging the DLL by specifying the calling app for it in the settings
(first ToyApp.exe, then RealApp.exe). I placed a "stopping point" (F5) at
the line shown above (?1), then checked the value of "dwreason" every time
it stopped there.
The first call was of course found to be DLL_PROCESS_ATTACH (?2). So far so
good. The calling application then shows itself, with the DLLapp neatly
inside it. On closing the calling app, the call is DLL_PROCESS_DETACH, which
is also logical. Both ToyApp.exe and RealApp.exe call these calls just fine.
!!!!BUT!!!!!
When I start up RealApp.exe, then about a minute and a half after starting
(ie after it has already done the DLL_PROCESS_ATTACH call), it suddenly
calls DLLEntryPoint with the value 87576816 (for which there is no value in
the "case"). And immediately after, the access violation error occurs. Again
and again. I have no choice but to shut down RealApp.exe. I don't have to do
anything for this error to occur; it even happens if I just start up
RealApp.exe and leave it be for a minute and a half. Also, DLLApp is
entirely independent of its calling parent: it does not access the parent ap
plication at any time, other than being created in the parent control.
What am I doing wrong? (more info: RealApp does include components such as
Orpheus and DevExpress, and also uses Lead dll's). Is there an extra call
corresponding to this value (87576816) which I should process in the "case"
inside DLLEntryPoint? (I've googled on DLLProc, but nobody seems to have had
this problem).
If someone can understand this problem and help me, I'd be MOST GRATEFUL.
Thanks in advance for your attention if you've read so far :)
Z
