我們可以看到一個函數@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;
function TPackage.GetIDEInfo(Index: Integer): TIDEInfo; begin if (Index in [0..(FPageInfos.Count - 1)]) then begin Result := TIDEInfo(FPageInfos[Index]^); end; end;
