Unit ufrmmain;
Interface
Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, stdctrls;
Type
Tfrmmain = Class (tform)
Btn1: tbutton;
Btn2: tbutton;
Btn3: tbutton;
Procedure btn1click (Sender: tobject );
Procedure btn2click (Sender: tobject );
Procedure btn3click (Sender: tobject );
Private
Function createformbyclassname (const classname: string): tcustomform;
Function createdatamodulebyclassname (const classname: string): tdatamodule;
Procedure unloadaddinpackage (moduleinstance: hmodule );
Public
{Public declarations}
End;
VaR
Frmmain: tfrmmain;
Implementation
VaR
Moduleinstance1: hmodule;
{$ R *. DFM}
//---------------------------------------------------------------
// Dynamically load the package
//---------------------------------------------------------------
Procedure tfrmmain. btn1click (Sender: tobject );
Begin
Moduleinstance1: = loadpackage ('package1. BPL ');
End;
//---------------------------------------------------------------
// Bring the form1 in the package out
//---------------------------------------------------------------
Procedure tfrmmain. btn2click (Sender: tobject );
VaR
FRM: tcustomform;
Begin
FRM: = createformbyclassname ('tform1 ');
Try
FRM. showmodal;
Finally
FRM. release;
End;
End;
//---------------------------------------------------------------
// Release the package
//---------------------------------------------------------------
Procedure tfrmmain. btn3click (Sender: tobject );
Begin
Unloadaddinpackage (moduleinstance1 );
End;
//---------------------------------------------------------------
// Customize the function-createformbyclassname () to create a form
//---------------------------------------------------------------
Function tfrmmain. createformbyclassname (const classname: string): tcustomform;
VaR
Aclass: tpersistentclass;
Begin
Aclass: = getclass (classname );
If Aclass = nil then exit;
Result: = tcomponentclass (Aclass). Create (Application) as tcustomform;
// Or result: = tcustomform (tcomponentclass (Aclass). Create (Application ));
End;
//---------------------------------------------------------------
// Customize the function-createdatamodulebyclassname () to create a data module
//---------------------------------------------------------------
Function tfrmmain. createdatamodulebyclassname (const classname: string): tdatamodule;
VaR
Aclass: tpersistentclass;
Begin
Result: = nil;
Aclass: = getclass (classname );
If Aclass = nil then exit;
Result: = tcomponentclass (Aclass). Create (Application) as tdatamodule;
End;
//---------------------------------------------------------------
// Customize the function-unloadaddinpackage () to release the package
//---------------------------------------------------------------
Procedure tfrmmain. unloadaddinpackage (moduleinstance: hmodule );
VaR
I: integer;
M: tmemorybasicinformation;
Begin
For I: = application. componentcount-1 downto 0 do
Begin
Virtualquery (getclass (application. components [I]. classname), M, sizeof (m ));
If (moduleinstance = 0) or (hmodule (M. allocationbase) = moduleinstance) then
Application. components [I]. Free;
End;
// The following two functions should be called as long as one of them is called.
Unregistermoduleclasses (moduleinstance); // directly cancel the package
Unloadpackage (moduleinstance); // indirectly logs out and calls finalization in the package.
End;
End.