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

BPL插件框架的二种实现方法
1）非RTTI方式适用于所有的DELPHI版本

unit untMain;interfaceuses  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.

2）RTTI方式，适用于2009以上版本

unit untMain;interfaceuses  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.