Delphi的包是Delphi IDE的核心技术,没有包也就没有了Delphi的可视化编程。包也可以用在我们开发的项目中,其好处是可以代码共享,减小工程尺寸,单纯通过替换包文件就能实现工程的升级和补丁。但是我们要加载包,就要知道包中已经存在的类。关于如何动态加载包的资料比比皆是我就不想就此问题讨论了。但是Delphi的IDE很是特殊,它无需事先知道你的包有哪些类就能注册组建,创建组建。但是Borland没有公开BPL文件的格式。我们自己是否可以实现IDE的功能呢? 首先我们知道。一个组件包想要能在IDE中使用就要进行注册也就是要创建一个过程例如: Procedure Register; Begin RegisterComponents(IDE中的页面, [组件类]); End; 在IDE加载时就要调用这个过程进行注册。 其次我们通过Borland的文档又知道BPL只是一种特殊格式的DLL文件。那么既然IDE可以调用得到注册过程那么注册过程一定要是导出类型(exports)的才行。既然如此我们可以想办法弄明白。写一个包文件。里面包含Test、和TestBtn两个单元。两个单元分别都有注册过程,然后编译成BPL文件。好了我们可以用EXESCOPE这个工具来弄清楚其中的奥秘。 我们可以看到一个函数@Test@Register$qqrv。几乎可以肯定这个函数就是BPL把Test单元中的Register导出的注册函数,而那个@Testbtn@Register$qqrv就一定是Testbtn这个单元的注册函数。可以做一个实验来证明我们的想法,在Test单元的Register的函数中加上ShowMessage(‘你好,你调用了注册函数’); 然后在我们来调用一下包中的函数@Test@Register$qqrv,随便写一个工程看看是不是可以调用得到Test单元中的Register过程。 var H : Integer; regproc : procedure(); begin H := 0; H := LoadPackage(''''TestPackage.bpl''''); try if H <> 0 then begin RegProc := GetProcAddress(H,''''@Test@Register$qqrv'''');//载入包中的函数 if Assigned(RegProc) then begin regproc();//调用函数 end; end; finally if H <> 0 then begin UnloadPackage(H); H := 0; end; end; end; 调用的结果,果然调用到了包中Terst单元的Register过程。但是如何得到注册了哪些类呢?注册组件要用RegisterComponents函数。好在VCL体系的源代码是开放的,我们看看RegisterComponents是如何实现的吧。 在Classes单元我们可以看到: procedure RegisterComponents(const Page: string; const ComponentClasses: array of TComponentClass); begin if Assigned(RegisterComponentsProc) then RegisterComponentsProc(Page, ComponentClasses) else raise EComponentError.CreateRes(@SRegisterError); end; 画线的是一个函数指针,Delphi的IDE就是在这个指针所指的函数里去作具体的工作。我们也可以利用它来实现我们的注册。 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; 然后一条语句RegisterComponentsProc:= @MyRegComponentsProc;似乎就解决问题了。 慢着!RegisterComponentsProc是在Classes单元。但是BPL中的Classes单元是在另一个运行时的包VCL.BPL里面。而我们工程所修改的RegisterComponentsProc的指针是编译在我们的工程中,空间是不同的。所以我们的工程一定要编译成带运行时包VCL.BPL的才行。但是这样一来的话我们也就只能载入和我们所用的编译器相同版本编译器编译出来的BPL文件了,也就是说Delphi6只能载入Delphi6或者BCB6编译出来的BPL文件以此类推。 但是还有一个问题没有解决,那就是如何知道一个包中到底有那些各单元呢?可以通过GetPackageInfo过程来获得。 我已经把加载包的过程封装到了一个类中。整个程序的代码如下:
{ *********************************************************************** } { } { 动态加载Package的类 } { } { wr960204(王锐)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; //单元名 FRequiresPackage: TStrings; //需要的的包 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 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 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;
funct[1] [2] [3] 下一页 |