The package of Delphi is the core technology of Delphi IDE. Without a package, there will be no visual programming of Delphi. The package can also be used in our development projects. The advantage is that it can share code, reduce the project size, and upgrade and patch the project simply by replacing the package file. However, to load a package, we need to know the existing classes in the package. I don't want to discuss about how to dynamically load packages. But Delphi's IDE is very special. It can be registered and created without having to know in advance what classes your package has. However, Borland does not disclose the format of BPL files. Can we implement IDE functions on our own?
First, we know. To use a component package in IDE, You need to register it, that is, to create a process such:
Procedure Register;
Begin
RegisterComponents (IDE page, [component class]);
End;
This process is called for registration during IDE loading.
Secondly, we know through Borland's documentation that BPL is just a special format of DLL files. Since IDE can call the registration process, the registration process must be of the export type (exports. In this case, we can figure it out. Write a package file. It contains two units: Test, and TestBtn. Both units have a registration process and are compiled into BPL files. Now we can use the exclusive tool to figure out the secrets.We can see a function @ Test @ Register $ qqrv. It is almost certain that this function is the registration function that BPL exports the Register in the Test unit, and that @ Testbtn @ Register $ qqrv must be the registration function of the Testbtn unit. We can make an experiment to prove our idea. Add ShowMessage to the Register function of the Test unit ('hello, you have called the Register function ');
Then, let's call the function @ Test @ Register $ qqrv in the package and write a project to see if the Register process in the Test unit can be called.
Var
H: Integer;
Regproc: procedure ();
Begin
H: = 0;
H: = LoadPackage (TestPackage. bpl );
Try
If H <> 0 then
Begin
RegProc: = GetProcAddress (H, @ Test @ Register $ qqrv); // load the function in the package
If Assigned (RegProc) then
Begin
Regproc (); // call a function
End;
End;
Finally
If H <> 0 then
Begin
Unloadpackage (h );
H: = 0;
End;
End;
End;
The result of the call is indeed the Register process of the terst unit in the package. But how do I get the registered classes? To register a component, use the registercomponents function. Fortunately, the source code of the VCL system is open. Let's see how registercomponents is implemented.
In the classes unit, we can see that:
Procedure registercomponents (const page: string;
Const componentclasses: array of tcomponentclass );
Begin
If assigned (registercomponentsproc) then
Registercomponentsproc (page, componentclasses)
Else
Raise ecomponenterror. createres (@ sregistererror );
End;
A function pointer is drawn, and Delphi's ide performs specific work in the function referred to by this pointer. We can also use it to implement 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 named registercomponentsproc: = @ myregcomponentsproc appears to solve the problem.
Slow down! Registercomponentsproc is in the classes unit. However, the classes unit in bpl is in another runtime package VCL. BPL. The registercomponentsproc Pointer Modified by our project is compiled in our project, and the space is different. Therefore, our project must be compiled into a runtime package VCL. BPL. But in this way, we can only load the BPL files compiled by the compiler of the same version as the compiler we use. That is to say, DELPHI6 can only load the BPL files compiled by DELPHI6 or bcb6, and so on.
But there is another problem that cannot be solved, that is, how can we know the units in a package? It can be obtained through the getpackageinfo process.
I have encapsulated the package loading process into a class. The code of the entire program is as follows: {*************************************** ********************************}
{}
{Dynamically Loaded 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 name
FRequiresPackage: TStrings; // required package
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 FContainsUnit;
Property RequiresPackage: TStrings read FRequiresPackage;
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; Flags: Byte; Param:
Pointer );
Begin
Case NameType
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
Begin
IDEInfo: = 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 FPackHandle <> 0 then
Begin
Unregistermoduleclasses (fpackhandle );
Clearpageinfo;
Fpageinfos. Free;
Unloadpackage (fpackhandle );
Fpackhandle: = 0;
End;
Inherited destroy;
End; Function tpackage. getideinfocount: integer;
Begin
Result: = fpageinfos. count;
End; Function tpackage. getideinfo (Index: integer): tideinfo;
Begin
If (index in [0 .. (fpageinfos. Count-1)]) then
Begin
Result: = tideinfo (fpageinfos [Index] ^ );
End;
End; Procedure tpackage. loadpackage;
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 be used only when the project file requires VCL and RTL packages.
// Because we need to direct the global function pointer classes. registercomponentsproc to ourselves
// Function (this function is prepared for IDE. Ide will set the function for it, and our program will also imitate ide To set the function for it ).
// If it is not a package with VCL or RTL, we only set the function pointer of the classes unit.
// Instead of including the global package.
//
// What is interesting is that if our project runs without a package, we can use it to view the latest versions at the same time.
// The Borland compiler generates a package file without 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 (UnitName) + @ Register $ qqrv;
// The following string @ Register $ qqrv is fixed by Borland, which is the same as Delphi5, 6, 7, BCB5, and 6.
// Delphi3 is Name +. Register @ 51F89FF7. But Delphi4 has no hands and has never been tested.
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.
The call is as follows:
{*************************************** ********************************}
{}
{Main program 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: TCloseAction );
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 then
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: tobject; var action: tcloseaction );
Begin
Freepack;
End; Procedure TForm1.Button2Click (Sender: TObject );
Var
Ctrl: TControl;
Begin
If (ListBox1.ItemIndex <>-1) and (FPack <> nil) then
Begin // determines if the TControl subclass is not created and cannot be seen.
If (FPack. IDEInfo [ListBox1.ItemIndex]. iClass. InheritsFrom (TControl) then
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
Maximum = 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 = 1, 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
Maximum = 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 the instance of the selected class on the Panel
TabOrder = 3
OnClick = Button2Click
End
Object Memo1: TMemo
Left = 8
Top = 72
Width = 257
Height = 145
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 4
End
Object OpenDialog1: TOpenDialog
Filter = *. BPL | *. BPL
Left = 1, 200
Top = 16
End
End
Based on these, we can build our own Delphi IDE. The RTTI class functions of TYPInfo can be used to obtain and set object attributes, I am not paying much attention here.
Remember, the VCL. BPL package must be carried during compilation. |
