Delphi's package is the core technology of Delphi IDE. There is no package of Delphi visual programming without packages. The package can also be used in the project we have developed, and the benefit is that you can share the project size, reduce the project size, and simply upgrade and patches the project by replacing the package. But we have to load the package, you must know the classes already existing in the package. About how to dynamically load packages, I don't want to discuss this issue. But Delphi's IDE is very special, it does not need to know what kind of your package is enabled in advance, create a formation. But Borland does not have a format of the BPL file. Can we implement the IDE function?
First we know. A component package wants to be able to use it in the IDE to register, which is to create a process, for example:
PROCEDURE register;
Begin
RegisterComponents (pages in IDE, [Component Class]);
END;
Call this process is registered when the IDE is loaded.
Second, we have known the BORLAND and know that BPL is just a special format DLL file. So since the IDE can call the registration process, the registration process must have the export type (exports). So, we can find ways to understand. Write a package file. Contains TEST, and TestBTN two units. The two units have a registration process, and then compile into a BPL file. Ok, we can use the Exescope tool to figure out the mystery.
We can see a function @ Test @ Register $ qrv. Almost certainly certain that this function is the registration function exported in the Test unit in the Test unit, and that @ TestBTN @ register $ qrv must be a registration function of this unit. You can make an experiment to prove our ideas, add ShowMessage in the register function of the Test unit ('Hello, you call the registration function');
Then call the function @ Test @register $ qrv in our package. Write a project to see if you can call the Register process in the Test unit.
VAR
H: integer;
Regproc: procedure ();
Begin
H: = 0;
H: = loading ('TestPackage.bpl');
Try
IF H <> 0 THEN
Begin
RegProc: = getProcaddress (h, '@ Test @ register $ qrv'); / / Load the function in the package
IF assigned (regproc) THEN
Begin
RegProc (); // Call function
END;
END;
Finally
IF H <> 0 THEN
Begin
UnloadPackage (h);
H: = 0;
END;
END;
END;
The result of the call is called to the register process of the Terst cell in the package. But what are you registered? The registration component is to use the RegisterComponents function. It is open to the source code of the VCL system, and we look at how registercomponents is implemented.
We can see in the Classes unit:
Procedure RegisterComponents (Const Page: String;
Const ComponentClasses: array of tcomponentclass;
Begin
IF assigned (registercomponentsproc) THEN
RegisterComponentsProc (Page, ComponentClasses)
Else
Raise ecomponenterror.createres (@sregisterrror);
Painted is a function pointer, Delphi's IDE is to do specific work in the function referred to in this pointer. We can also use it to achieve our registration.
Procedure MyRegcomponentsProc (const page: string;
Const ComponentClasses: array of tcomponentclass;
VAR
I: integer;
IDEINFO: PIDEINFO;
Begin
For i: = 0 to high (componentclasses) do
Begin
RegisterClass (ComponentClasses [i]);
END;
END;
Then a statement registercomponentsproc: = @MyregComponentsproc; it seems to solve the problem.
Slow! RegisterComponentsProc is in the Classes unit. However, the Classes unit in the BPL is in the package Vcl.bpl in another runtime. The REGISTERCOMPONENTSPROC's pointer for our project is compiled in our project, and space is different. So our project must compile the talented to the running package Vcl.bpl. But in this way, we can only load the BPL files compiled with the same version of the compiler as the compiler we have, that is, Delphi6 can only load the BPL file compiled by Delphi6 or BCB6 to be pushed.
But there is still a problem that has not been solved, how is it knowing that the units in a package? It can be obtained by getPackageInfo process.
I have already packaged the process of the load package to a class. The code for the entire program is as follows:
{********************************************************** *********************}
{}
{Dynamic Loading Package Class}
{}
{WR960204 (Wang Rui) 2003-2-20}
{}
{********************************************************** *********************}
Unit UNITPACKAGEINFO;
Interface
Uses
Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, stdctrls;
Type
Pideinfo = ^ TIDEINFO;
TIDEINFO = Record
ICLASS: TComponentClass;
iPage: String;
END;
Type
TPackage = Class (TOBJECT)
Private
FPACKHANDLE: THANDLE;
FPackageFileName: String;
FPAGEINFOS: TLIST;
FContainSUnit: Tstrings; // Unit FrequiresPackage: Tstrings; // Need to
FDCPBPINAME: TSTRINGS; //
Procedure ClearPageInfo;
Procedure loadpackage;
Function GetIdeInfo (INDEX: Integer): TideInfo;
Function GetIdeInfocount: Integer;
public
Constructor Create (const filename: string); overload;
Constructor Create (Const PackageHandle: Thandle); OVERLOAD;
DESTRUCTOR DESTROY; OVERRIDE;
Function regclassinpackage: boolean;
Property IDEINFO [INDEX: Integer]: TideInfo Read GetIdeInfo;
Property IDEINFOCOUNT: INTEGER READ GetIdeInfocount;
Property ContainSUnit: Tstrings Read fcontains;
Property Requirespackage: Tstrings ReadFrequirespage
Property DCPBPINAME: TSTRINGS Read FDCPBPINAME
END;
IMPLEMENTATION
VAR
CurrentPackage: tpackage;
Procedure RegcomponentsProc (const page: string;
Const ComponentClasses: array of tcomponentclass;
VAR
I: integer;
IDEINFO: PIDEINFO;
Begin
For i: = 0 to high (componentclasses) do
Begin
RegisterClass (ComponentClasses [i]);
NEW (IDEINFO);
Ideinfo.ipage: = Page;
IDEINFO.ICLASS: = ComponentClasses [i];
CurrentPackage.fpageInfos.Add (Ideinfo);
END;
END;
Procedure Everyunit (const name: string; nametype: tnametype; flaggs: byte; param:
Pointer;
Begin
Case NameType of
NtcontainsUnit:
CurrentPackage.FContainSUnit.Add (Name);
NTDCPBPINAME:
CurrentPackage.fdcpbpiname.add (name);
NTREQUIRESPACKAGE:
CurrentPackage.FrequiresPackage.Add (Name);
END;
END;
{Tpackage}
Constructor tpackage.create (const filename: string);
Begin
FPackageFileName: = filename;
Loadpackage;
END;
Procedure tpackage.clearpageinfo;
VAR
I: integer;
IDEINFO: PIDEINFO;
Begin
For i: = fpageinfos.count-1 Downto 0 DO
BeginideIndfo: = fpageinfos [i];
Dispose (IDEINFO);
FPAGEINFOS.DELETE (i);
END;
FPAGEINFOS.CLEAR;
END;
Constructor tpackage.create (const packagehandle: thandle);
Begin
FPackageFileName: = getModulenAme (packagehandle);
Loadpackage;
END;
Destructor tpackage.destroy;
VAR
I: integer;
Begin
FContainSUnit.free;
FREQUIRESPACKAGE.FREE;
FDCPBPINAME.FREE;
IF FPACKHANDE <> 0 THEN
Begin
UnregisterModuleClasses (FPACKHANDLE);
ClearPageInfo;
FPAGEINFOS.FREE;
UnloadPackage (FPACKHANDLE);
FPACKHANDLE: = 0;
END;
Inherited destroy;
END;
Function tpage.getideInfocount: integer;
Begin
Result: = fpageinfos.count;
END;
Function TPackage.GetideInfo (INDEX: Integer): TideInfo;
Begin
IF (INDEX IN [0 .. (FPAGEINFOS.COUNT - 1)]).
Begin
Result: = TIDEINFO (FPAGEINFOS [INDEX] ^);
END;
END;
Procedure tpackage.load;
VAR
Flags: integer;
I: integer;
Unitname: string;
Begin
FPAGEINFOS: = TLIST.CREATE;
Fcontainsunit: = TSTRINGLIST.CREATE;
Frequirespackage: = TSTRINGLIST.CREATE
FDCPBPINAME: = TSTRINGLIST.CREATE;
FPACKHANDLE: = SYSUTILS.LOADPACKAGE (FPACKAGEFILENAME);
CurrentPackage: = Self;
GetPackageInfo (FPACKHANDLE, @FPACKHANDLE, FLAGS, EVERYUNIT);
END;
Function TPackage.regClassInpackage: boolean;
// This function can only be used when the project file needs VCL, RTL two package files can be used
// Because we need to point the global function pointer Classes.registerComponentsProc to us
// Function (This function is ready for IDE, IDE will set a function for it and our program also imitate the IDE to set a function).
/ / If it is not a packet with VCL and RTL, then we set it only the function pointer of our Classes unit.
// is not a global in which package is included.
//
//, interesting is if our project does not have a package, then we can basically use it at the same time to see the recent version.
The // Borland compiler does not produce an exception, but the control cannot be registered.
VAR
I: integer;
Oldproc: Pointer; RegProc: procedure ();
RegProcname, UnitName: String;
Begin
Oldproc: @ Classes.RegisterComponentsProc;
Classes.registercomponentsproc: = @RegcomponentsProc;
FPAGEINFOS.CLEAR;
Try
Try
For i: = 0 to fcontainsunit.count - 1 do
Begin
Regproc: = nil;
UnitName: = fcontainsunit [i];
RegProcname: =
'@' Upcase (UnitName [1])
LowerCase (Copy (UnitName, 2, Length))
'@Regs $ qqrv';
// Rear This string @ register $ qrv is Borland's dead, Delphi5, 6, 7, BCB5, 6 is like this.
// Delphi3 is Name
'.Register @ 51f89ff7'. And Delphi4 has no, no trials
Regproc: = getProcAddress (FPackHandle,
Pchar (regprocname);
IF assigned (regproc) THEN
Begin
CurrentPackage: = Self;
Regproc;
END;
END;
Except
UnregisterModuleClasses (FPACKHANDLE);
ClearPageInfo;
RESULT: = TRUE;
EXIT;
END;
Finally
Classes.registercomponentsproc: = OldProc;
END;
END;
End.
Call as follows
{********************************************************** *********************}
{}
{Program main form unit}
{}
{WR960204 (Wang Rui) 2003-2-20}
{}
{********************************************************** *********************}
Unit unit1;
Interface
Uses
UnitPackageInfo,
Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Stdctrls, ExtCtrls;
Type
TFORM1 = Class (TFORM)
Groupbox1: TgroupBox; Panel1: TPANEL
Listbox1: tlistbox;
Button1: tbutton;
Button2: tbutton;
OpenDialog1: TopEndialog;
Memo1: TMEMO;
Procedure Button1Click (Sender: TOBJECT);
Procedure formclose (Sender: Tobject; VAR Action: Tclosection);
Procedure Button2Click (Sender: TOBJECT);
Private
{Private Declarations}
FPACK: tpackage;
Procedure freepack;
public
{Public declarations}
END;
VAR
FORM1: TFORM1;
IMPLEMENTATION
{$ R * .dfm}
Procedure TFORM1.BUTTON1CLICK (Sender: TOBJECT);
VAR
I: integer;
Begin
IF openDialog1.execute the
Begin
Freepack;
FPACK: = tpackage.create (OpenDialog1.FileName);
FPACK.REGCLASSINPACKAGE;
END;
Listbox1.Items.clear;
For i: = 0 to fpack.ideInfocount - 1 do
Begin
Listbox1.items.add (fPack.IdeInfo [i] .iclass.classname);
END;
Memo1.Lines.clear;
Memo1.Lines.Add ('------ ContainsUnitList: -------');
For i: = 0 to fpack.containsunit.count - 1 do
Begin
Memo1.Lines.Add (fPack.ContainSUnit [i]);
END;
Memo1.Lines.Add ('------ DCPBPINAMELIST: -------');
For i: = 0 to fpack.dcpbpiname.count - 1 do
Begin
Memo1.Lines.Add (fPack.dcpbpiname [i]);
END;
Memo1.Lines.Add ('-------- RequirespackageList: -------');
For i: = 0 to fpack.requirespackage.count - 1 DO
Begin
Memo1.Lines.Add (FPACK.REQUIRESPACKAGE [I]);
END;
END;
Procedure TFORM1.FORMCLOSE (Sender: TpoBject; VAR Action: Tclosection);
Begin
Freepack;
END;
Procedure TFORM1.BUTTON2CLICK (Sender: TOBJECT);
VAR
Ctrl: tControl;
Begin
IF (ListBox1.ItemIndex <> -1) and (fPack <> nil) THEN
Begin // Judging If the subclass of TControl is created, it will not be created.
IF (fPack.IdeInfo [listbox1.itemindex] .iclass.inheritsfrom (tcontrol) "
Begin
Ctrl: = NIL; TRY
Ctrl: = tcontrol (fPack.IdeInfo [listbox1.itemindex] .iclass.create (self));
Ctrl.parent: = panel1;
Ctrl.setbounds (0, 0, 100, 100);
Ctrl.visible: = true;
Except
END;
END;
END;
END;
Procedure tform1.freepack;
VAR
I: integer;
Begin
For i: = panel1.controlcount - 1 Downto 0 DO
Panel1.Controls [i] .free;
Freeandnil (FPACK);
END;
End.
The form file is as follows:
Object Form1: TFORM1
LEFT = 87
TOP = 120
Width = 518
HEIGHT = 375
CAPTION = 'FORM1'
Color = CLBTNFACE
Font.charset = default_charset
Font.color = CLWINDOWTEXT
Font.height = -11
Font.name = 'MS SANS Serif'
Font.style = []
OldcreateOrder = FALSE
OnClose = formClose
Pixelsperinch = 96
TEXTHEIGHT = 13
Object Groupbox1: TgroupBox
LEFT = 270
TOP = 0
Width = 240
HEIGHT = 224
Align = alright
CAPTION = 'class'
Taborder = 0
Object Listbox1: TListBox
LEFT = 2
TOP = 15
Width = 236
HEIGHT = 207
Align = alclient
ItemHeight = 13
Taborder = 0
end
end
Object Panel1: TPANEL
LEFT = 0
TOP = 224
Width = 510
HEIGHT = 124
Align = Albottom
Color = CLCREAM
Taborder = 1
end
Object Button1: TButton
LEFT = 8
TOP = 8
Width = 249
HEIGHT = 25
CAPTION = 'load package'
Taborder = 2
Onclick = button1click
end
Object Button2: TButton
LEFT = 8
TOP = 40
Width = 249
HEIGHT = 25
CAPTION = 'Create an instance of the selected class in Panel'
Taborder = 3
Onclick = button2click
end
Object Memo1: TMEMO
LEFT = 8
TOP = 72
Width = 257
HEIGHT = 145
Readonly = True
Scrollbars = ssbothtaborder = 4
end
Object OpenDialog1: TopEndialog
FILTER = '* .bpl | * .bpl'
LEFT = 200
TOP = 16
end
end
On these basis, we can fully build a self-Delphi IDE. The object of the object's properties and settings with the Typinfo unit's RTTI class function can be easily set. I will not be a multi-fold tongue here.
Remember, you must use the way to carry the VCL.bpl when you compile.
