我们可以看到一个函数@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过程来获得。 我已经把加载包的过程封装到了一个类中。整个程序的代码如下：
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;
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
