Create package project:
MyLib.dpk
package MyLib; {$R *.res} {$ALIGN 8} {$ASSERTIONS ON} {$BOOLEVAL OFF} {$DEBUGINFO ON} {$EXTENDEDSYNTAX ON} {$IMPORTEDDATA ON} {$IOCHECKS ON} {$LOCALSYMBOLS ON} {$LONGSTRINGS ON} {$OPENSTRINGS ON} {$OPTIMIZATION ON} {$OVERFLOWCHECKS OFF} {$RANGECHECKS OFF} {$REFERENCEINFO ON} {$SAFEDIVIDE OFF} {$STACKFRAMES OFF} {$TYPEDADDRESS OFF} {$VARSTRINGCHECKS ON} {$WRITEABLECONST OFF} {$MINENUMSIZE 1} {$IMAGEBASE $400000} {$IMPLICITBUILD OFF} requires rtl, vcl, xmlrtl; contains MyUtils in 'MyUtils.pas'; end.
Create routines and classes in unit file, and call RegisterClass()
and UnRegisterClass()
in its initialization
and finalization
sections respectively: MyUtils.pas
unit MyUtils; interface uses SysUtils, Classes, Dialogs; const Left = 0; Right = 1; //------------------------------------------------------------------------------ // Class definitions //------------------------------------------------------------------------------ var TMyUtils = class(TComponent) private FAppHandle: integer; LastGreeting: Widestring; public function TestUnit(AppHandle: integer): Boolean; stdcall; procedure MyHelloWorld(InitialGreeting: Widestring=''); stdcall; procedure MySecondHello(greeting: Widestring); stdcall; end; //------------------------------------------------------------------------------ // Class and Function Implementations //------------------------------------------------------------------------------ implementation //------------------------------------------------------------------------------ {* // @section TestUnit Procedure: TestUnit // @brief Unit test routine, for easy testing of different function in library. // @param[in] AppHandle: integer; Application Handle, in case we need to use it. // @retval Boolean // @remarks Rev.History: // - smayr 19-Sep-2006, Routine creation. } //------------------------------------------------------------------------------ function TMyUtils.TestUnit(AppHandle: integer): Boolean; stdcall; begin //------------------------------- // perform unit testing //------------------------------- MyHelloWorld('Hello World'); MySecondHello('Greetings from Planet Earth'); DisplayLastGreeting(); //------------------------------- // Unit Test Results //------------------------------- result := True; // Unit Test Passed end; //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ procedure TMyUtils.MyHelloWorld(InitialGreeting: Widestring=''); stdcall; begin LastGreeting := InitialGreeting; ShowMessage(InitialGreeting); end; //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ procedure TMyUtils.MySecondHello(Greeting: Widestring); stdcall; begin LastGreeting := InitialGreeting; ShowMessage(Greeting); end; //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ procedure TMyUtils.DisplayLastGreeting(); stdcall; begin ShowMessage(LastGreeting); end; initialization RegisterClass(TMyUtils); finalization UnRegisterClass(TMyUtils); end.
Create an application, and:
uses
list for the unit requiring the package. For example, the main form (frmMain) would look like this: main.pas
unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, MyLib; type TfrmMain = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject) ; private { Private declarations } public { Public declarations } end; var frmMain: TfrmMain; implementation {$R *.dfm} //----------------------------------------------------------- // other function implementations //----------------------------------------------------------- procedure TForm1.Button1Click(Sender: TObject) ; var sample: TMyUtils; begin sample := TMyUtils.Create(); sample.TestUnit(); sample.Free(); end; end.
Create an application, and
For example, the abstract class definition would look like this: MyUtilsAbs.pas
unit MyUtilsAbs; interface uses Classes; type //------------------------------------------------------- // abstract class definition for TMyUtils class //------------------------------------------------------- TMyUtilsAbs = class(TComponent) public function TestUnit(AppHandle: integer): Boolean; virtual; abstract; procedure MyHelloWorld(InitialGreeting: Widestring=''); virtual; abstract; procedure MySecondHello(greeting: Widestring); virtual; abstract; end; implementation end.
the main form (frmMain) would look like this: main.pas
unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, ActnList, Grids, ValEdit, ActnMan, ActnColorMaps, Buttons, MyUtilsAbs {abstract class definition}; type TMyUtilsClass = class of TMyUtilsAbs; // used in dynamic loading of package TfrmMain = class(TForm) procedure actTestUnitExecute(Sender: TObject); // test routine . . . code removed . . . private { Private declarations } FMyUtil: TMyUtils; // instance of main object loaded from package HInst: HModule; // instance of dynamically loaded package PkgLoaded: boolean=False; // flag to know if package was loaded correctly function LoadUserPackage(PkgName: string): Boolean; // routine to dynamically load package procedure UnloadUserPackage(); // routine to unload package and dispose of memory public { Public declarations } end; var frmMain: TfrmMain; implementation //---------------------------------------------------------------------------- // function to load the specified package (BPL) //---------------------------------------------------------------------------- function TfrmMain.LoadUserPackage(PkgName: string): boolean; var PkgLoaded: boolean; Cls: TMyUtilsClass; begin if PkgLoaded then begin result := True; // loaded Exit; end; // initialize flags ObjLoaded := False; // load library HInst := LoadPackage(PkgName); if HInst > 0 then begin try PkgLoaded := True; // Load class and create an instance for later access to the new object. // This class must have been exported in the unit's initialization section // using RegisterClass(). try Cls := TMyUtilsClass(FindClass('TMyUtils')); // you can also use GetClass() here except Cls := nil; end; if Assigned(Cls) then begin try FMyUtil := cls.Create(Application); if Assigned(FMyUtil) then begin ObjLoaded := True; end; except on E:Exception do begin ObjLoaded := False; ShowMessage('LoadUserPackage(): '+ E.ClassName + ' = '+ E.Message); end; end; end; // clean up workspace finally if ObjLoaded then begin result := True; // we loaded the package end else begin UnloadPackage(HInst); // unload package PkgLoaded := False; ShowMessage('A function/procedure in ' + PkgName + ' package was not loaded.'); result := False; end; end; end else begin PkgLoaded := False; ShowMessage('Package '+ PkgName + ' not found'); result := False; end; end; //---------------------------------------------------------------------------- // Routine to unload the library at will or when destroying the form or application: //---------------------------------------------------------------------------- procedure TfrmMain.UnloadUserPackage(); var i: Integer; M: TMemoryBasicInformation; begin // Make sure there aren't any instances of any // of the classes from Module instantiated, if // so then free them. (This assumes that the // classes are owned by the application) for i := Application.ComponentCount - 1 downto 0 do begin VirtualQuery(GetClass(Application.Components[i].ClassName), M, SizeOf(M)); if (HInst= 0) or (HMODULE(M.AllocationBase) = HInst) then begin Application.Components[i].Free; end; end; if HInst > 0 then begin UnRegisterModuleClasses(HInst); UnloadPackage(HInst); // unload BPL end; PkgLoaded := False; end; //---------------------------------------------------------------------------- // OnDestroy event for the main form, making sure the library resources are freed. //---------------------------------------------------------------------------- procedure TfrmMain.FormDestroy(Sender: TObject); begin UnloadUserPackage(); end; //---------------------------------------------------------------------------- // Load a package (BPL) and execute a function //---------------------------------------------------------------------------- procedure TfrmMain.actTestUnitExecute(Sender: TObject); begin if LoadUserPackage('MyLib.bpl') then begin if FMyUtil.TestUnit() then begin MessageDlg('Test Unit was performed successfully!', mtInformation, [mbOK], 0); end else begin MessageDlg('Test Unit failed to run correctly', mtError, [mbOK], 0); end; end; end;
Create an interface (New > Unit) IntfMyUtils.pas
unit IntfMyUtils; interface type IMyUtil = interface ['{5DE083EF-9B9A-41C2-9413-9644F9A88CA6}'] // generated with < ctrl > < shift > < G > function BPLVersion(): WideString; // user defined function end; implementation end.
Modify the class to inherit from the interface MyUtils.pas
unit MyUtils; interface uses ..., IntfMyUtils; type //---------------------------------------------------------------------------- // type TMyUtils //---------------------------------------------------------------------------- TMyUtils = class(TMyUtils, IMyUtils) public function BPLVersion(): WideString; // user defined function ... end; ... //------------------------------------------------------------------------------ // Function Implementations //------------------------------------------------------------------------------ implementation function TMyUtils.BPLVersion(): widestring; begin result := '0.25 dev'; // BPL version number end; //------------------------------------------------------------------------------ // initialization //------------------------------------------------------------------------------ initialization // need to register classes so they are available at run-time RegisterClasses([TMyUtils]); //------------------------------------------------------------------------------ // finalization //------------------------------------------------------------------------------ finalization // reclaim memory of run-time classes UnRegisterClasses([TMyUtils]); end.
In the main application, load the package dynamically: main.pas
unit main.pas; ... // global variables var HandlePkg: HModule; ... implementation function TfrmMain.LoadUserPackage(PkgName: string): boolean; var ProcLoaded: boolean; myutil: IMyUtils; begin if PkgLoaded then begin result := True; // loaded Exit; end; // try to load the package HandlePkg := LoadPackage(PkgName); if HandlePkg > 0 then begin try PkgLoaded := True; // load an instance using Interfaces with TPersistentClass(FindClass('TMyUtils')).Create do begin try if GetInterface(IMyUtils, myutil) then begin ShowMessage('BPL = ' + myutil.BPLVersion()); // call methods and do some work end; finally // ensure reference count is set to 0 myutil := nil; Free; end; end; finally if ProcLoaded then begin result := True; // we loaded the BPL end else begin UnloadPackage(HandlePkg); // unload BPL PkgLoaded := False; ShowMessage('A function/procedure in ' + PkgName + ' library failed to load.'); result := False; end; end; end else begin PkgLoaded := False; ShowMessage(PkgName + ' library not found'); result := False; end; end;
In a package, to create an object when the package is loaded, perform the following:
initialization MyObj := TMyObj.Create; MyObj.Name := 'MyObj'; finalization MyObj.Free;
To reference that object already created from outside the package, the package will have to export a function for that. For example, in MainApplication load the package :
H := LoadPackage('MyPackage.bpl'); // load package obj := GetObjectRef(H, 'MyObj'); // exists something like this ?
In the package:
package MyLib; ... exports GetObjectRef; begin end.