BPL插件框架的二种实现方法

unit untMain;

interface

uses
  Windows, Messages, SysUtils,
  Classes, Graphics,
  Controls, Forms, Dialogs,
  ExtCtrls, Buttons;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    procedure btnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure LoadPlugin(const formClass: string);
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}

procedure TFrmMain.btnClick(Sender: TObject);
var
  h: Integer;
  formClass, bplFile: string;
begin
  if SameText(TSpeedButton(Sender).Caption, '系统一') then
  begin
    bplFile := 'bplTest1.bpl';
    formClass := 'TfrmTest1';
  end;

  if TSpeedButton(Sender).Tag = 0 then
  begin
    if FileExists(bplFile) then
    begin
      h := LoadPackage(bplFile);
      if h = 0 then
      ShowMessage(bplFile + ' 包加载失败')
    else
    begin
      TSpeedButton(Sender).Tag := h;
    end;
  end
  else
    ShowMessage(bplFile + ' 没有找到');
  end;

  LoadPlugin(formClass);
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to Panel1.ComponentCount - 1 do
  begin
    if TSpeedButton(Panel1.Components[i]).Tag <> 0 then
      UnloadPackage(TSpeedButton(Panel1.Components[i]).Tag);
  end;
end;

procedure TFrmMain.LoadPlugin(const formClass: string);
var
  aForm: TForm;
begin
  aForm := TFormClass(FindClass(formClass)).Create(Self);
  aForm.Position := poScreenCenter;
  aForm.Show;
end;

end.

unit untMain;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Generics.Collections,
System.Rtti, Vcl.ExtCtrls, Vcl.Buttons;

type
TFrmMain = class(TForm)
Panel1: TPanel;
SpeedButton1: TSpeedButton;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnClick(Sender: TObject);
private
{ Private declarations }
bplList: TDictionary<string, Integer>;
procedure LoadPlugin(const bplFile, unitClass: string);
public
{ Public declarations }
end;

var
FrmMain: TFrmMain;

implementation

{$R *.dfm}

procedure TFrmMain.btnClick(Sender: TObject);
var
h: Integer;
bplFile: string;
unitClass: string;
begin
if SameText(TSpeedButton(Sender).Caption, '系统一') then
begin
bplFile := 'bplTest1.bpl';
unitClass := 'untTest1.TfrmTest1';
end;

if TSpeedButton(Sender).Tag = 0 then
begin
if FileExists(bplFile) then
begin
h := LoadPackage(bplFile);
if h = 0 then
ShowMessage(bplFile + ' 包加载失败')
else
begin
bplList.Add(bplFile, h);
TSpeedButton(Sender).Tag := h;
end;
end;
end;
LoadPlugin(bplFile, unitClass);
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
bplList := TDictionary<string, Integer>.Create;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
var
i: Integer;
begin
if Assigned(bplList) then
begin
for i in bplList.Values do
UnloadPackage(i);
FreeAndNil(bplList);
end;
end;

procedure TFrmMain.LoadPlugin(const bplFile, unitClass: string);
var
LContext: TRttiContext;
LPackage: TRttiPackage;
LClass: TRttiInstanceType;
aForm: TForm;
begin
if (bplFile = '') or (unitClass = '') then
Exit;

LContext := TRttiContext.Create;
try
try
for LPackage in LContext.GetPackages() do
begin
if SameText(ExtractFileName(LPackage.Name), bplFile) then
begin
LClass := LPackage.FindType(unitClass) as TRttiInstanceType;
aForm := LClass.MetaclassType.Create as TForm;
aForm.Create(nil);
aForm.WindowState := wsNormal;
aForm.Position := poScreenCenter;
aForm.Show;
end;
end;
except
ShowMessage('单元名和类名是大小写敏感的');
end;
finally
LContext.Free;
end;
end;

end.