Delphi3以降で使えるパッケージ機能を使うと，実行時に追加のパッケージを
ロードして機能を増やすことが出来ます．

○　機能を分割する単位でパッケージを作る．下段はcontains
　Project1.dpr/exe    母艦的役割のアプリケーション
    Unit1.pas
　Extpkg1.dpk/dpl     追加機能その１（フォームを追加）
    Unit2.pas
  Extpkg2.dpk/dpl     追加機能その２（カスタムコンポの追加）
    Unit3.pas
  pkgcommon.dpk/dpl   共通に参照されるパッケージ
    RegPkg.pas

○　Extpkg1，Extpkg2に含まれるユニットの中では，exeに含まれるユニットをuses
　しないほうがよい．参照して良いのはpkgcommonに含まれるものだけ

○　exeやpkgcommon内のunitからExtpkg1,Extpkg2のユニットをusesしてはいけない

○　Extpkg1, Extpkg2は相互に参照しないほうがよい．でないと個別にロードできる
利点を失ってしまうから．しかし同時にロードする組み合わせを考えておけば
うまいこといくようにも作れる．

○　exeのオプションでは実行時パッケージを使うにし，使用するパッケージとして
pkgcommon.dplを追加しておく．

○　使うパッケージ，DLL等はexeのあるフォルダに全部放り込んで置く

＜Extpkg1の内容＞
　新しいフォームを作って表示できるようにする

＜Extpkg2の内容＞
　新しいコンポーネントを追加して，exeや他のパッケージが持っている
フォームに貼り付けられるようにする
＃ これで気分はコンポーネントパレット状態(^^;

○　exeを実行し，ボタンをクリックする

○　パッケージが他のパッケージをrequireしている場合は，そいつも自動で
ロードする．その過程で，再帰呼出の中でコールバックを使うことになるため，
自前のスタックStack:TListに一時変数を取っている．リエントラントにはならん．

-------------- Unit1（exeのメインフォーム）抜粋 ------------------
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
  public
    HPkg: HMODULE;
    Next: integer;
  end;

// 追加フォームの表示
procedure TForm1.Button1Click(Sender: TObject);
begin
  // フォームパッケージをロード
  HPkg := LoadExtPackage(GetModuleFileNamePath + 'Extpkg1');
  Screen.Forms[Screen.FormCount-1].ShowModal;
  UnLoadPackage(HPkg);
end;

// 追加コンポクラスを取り込み
procedure TForm1.Button2Click(Sender: TObject);
var  Count: integer;
begin
  // コンポーネントパッケージをロード
  HPkg := LoadExtPackage(GetModuleFileNamePath + 'Extpkg2');
  Count := ListBox1.Items.Count;
  while Count < ExtControlClassList.Count do begin
    ListBox1.Items.AddObject(
        TControlClass(ExtControlClassList[Count]).ClassName,
        ExtControlClassList[Count] );
    inc(Count);
  end;
end;

// カスタムコンポを張り付け
procedure TForm1.ListBox1DblClick(Sender: TObject);
var i: integer; Control: TControl;
begin
  i := ListBox1.ItemIndex;
  if i < 0 then Exit;
  Control := TControlClass(ListBox1.Items.Objects[i]).Create(Self);
  Control.Parent := Self;
  Control.Top := Next;
  inc(Next, Control.Height);
end;

------------------ Unit2　抜粋 タダのフォーム ---------------------
uses RegPkg;

initialization
  RegisterExtForm(TForm2, Form2);

finalization
  UnRegisterExtForm(TForm2);

----------- unit3　抜粋 実行時追加型(^^;カスタムコンポの宣言 ----------
uses RegPkg;

  TMyControl1 = class(TLabel)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TMyControl2 = class(TLabel)
  public
    constructor Create(AOwner: TComponent); override;
  end;

constructor TMyControl1.Create;
begin
  inherited Create(AOwner);
  Caption := '11111111';
end;

constructor TMyControl2.Create;
begin
  inherited Create(AOwner);
  Caption := '2 2 2 2 2';
end;

initialization
  RegisterExtControlClasses([TMyControl1, TMyControl2]);

finalization
  UnRegisterExtControlClasses([TMyControl1, TMyControl2]);

---------------------- RegPkg 全文 ---------------------------------
unit RegPkg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX;

procedure RegisterExtForm(FormClass: TFormClass; var AForm);
procedure RegisterExtControlClasses(
            ControlClasses: array of TPersistentClass);
procedure UnRegisterExtForm(FormClass: TFormClass);
procedure UnRegisterExtControlClasses(
            ControlClasses: array of TPersistentClass);

procedure SetRequiredPackageList(HPkg: HMODULE; const List: TStrings);
function  LoadExtPackage(PkgName: string): HMODULE;
function  GetModuleFileName: string;
function  GetModuleFileNamePath: string;

var
  ExtPackageList: TList;
  ExtControlClassList: TList;

implementation

procedure RegisterExtForm(FormClass: TFormClass; var AForm);
begin
  RegisterClass(FormClass);
  Application.CreateForm(FormClass, AForm);
end;

procedure RegisterExtControlClasses(
            ControlClasses: array of TPersistentClass);
var  i: integer;
begin
  RegisterClasses(ControlClasses);
  for i := 0 to High(ControlClasses) do
    ExtControlClassList.Add(ControlClasses[i]);
end;

procedure UnRegisterExtForm(FormClass: TFormClass);
var  i: integer;
begin
  with Application do begin
    for i := ComponentCount-1 downto 0 do begin
      if Components[i] is FormClass then
        Components[i].Free;
    end;
  end;
  UnRegisterClass(FormClass);
end;

procedure UnRegisterExtControlClasses(
            ControlClasses: array of TPersistentClass);
var  i: integer;
begin
  UnRegisterClasses(ControlClasses);
  for i := 0 to High(ControlClasses) do
    ExtControlClassList.Remove(ControlClasses[i]);
end;

var
  Stack: TList;

procedure InfoProc( const Name: string; NameType: TNameType;
                    Flags: Byte; Param: Pointer);
begin
  if NameType = ntRequiresPackage then
    TStringList(Stack.Last).Add( Name );
end;

procedure SetRequiredPackageList(HPkg: HMODULE; const List: TStrings);
var  Flags: Integer;
begin
  List.Clear;
  Stack.Add(List);
  try
    GetPackageInfo(HPkg, nil, Flags, InfoProc);   // callback
  finally
    Stack.Delete(Stack.Count-1);
  end;
end;


function EnumModuleFunc(HInstance: Longint; Data: Pointer): Boolean;
var  ModuleName: string;
  Indx: integer;
  List: TStringList;
  Buffer: array[0..261] of Char;
begin
  List := Stack.Last;
  SetString( ModuleName, Buffer,
          Windows.GetModuleFileName(HInstance,Buffer,SizeOf( Buffer )) );
  ModuleName := ExtractFileName(ModuleName);
  ModuleName := ChangeFileExt( ModuleName, '' );
  Indx := List.IndexOf( ModuleName );
  if Indx >= 0 then
    List.Delete(Indx);  // delete the package names already loaded
  Result := True;
end;

function LoadExtPackage(PkgName: string): HMODULE;
var i: integer;
  Path: string;
  List: TStringList;
begin
  Result := LoadLibrary(PChar(PkgName + '.dpl'));
  if (Result > -1) and (Result <= 32) then
    raise EPackageError.CreateFmt(sErrorLoadingPackage,
      [PkgName, SysErrorMessage(GetLastError)]);
  List := TStringList.Create;
  Stack.Add(List);
  try
    try
      SetRequiredPackageList(Result, List);
      Path := ExtractFilePath(PkgName);
      EnumModules( EnumModuleFunc, nil );  // callback
      for i := 0 to List.Count-1 do
        LoadExtPackage( Path + List[i] );  // recursion
      InitializePackage(Result);
      ExtPackageList.Add(Pointer(Result));
    except
      FreeLibrary(Result);
      raise;
    end;
  finally
    Stack.Delete(Stack.Count-1);
    List.Free;
  end;
end;

function  GetModuleFileName: string;
var Buffer: array[0..261] of Char;
begin
  SetString( Result, Buffer,
          Windows.GetModuleFileName(HInstance,Buffer,SizeOf( Buffer )) );
end;

function  GetModuleFileNamePath: string;
begin
  Result := ExtractFilePath(GetModuleFileName);
end;

initialization
  Stack := TList.Create;
  ExtPackageList := TList.Create;
  ExtControlClassList := TList.Create;

finalization
  ExtControlClassList.Free;
  ExtPackageList.Free;
  Stack.Free;

end.
                                                  ＴＮ(CQJ01721)

Original document by ＴＮ            氏 ID:(CQJ01721)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。