Delphi带包编译实现插件方式开发

Delphi带包编译实现插件方式开发

转载自：http://blog.csdn.net/henreash/article/details/7029844

 

1.    新建一个exe执行文件作为主框架,并建立一个存放插件类的单元,建立插件类TTestClass.接着新添加一个单元TestClasses1,在其中添加一个继承于TTestClass的类TTestClass1,并在单元的initialization节中调用基类TTestClasses1的RegistClass方法注册类型.

其中RegistClass方法为类方法；

    class procedure RegistClass;

    class function GetRegistClasses: TStrings;

步骤：

1.1、     创建一个Application ， 如下图

 

 

保存单元UMain.pas ，项目文件为 Main.dpr, 即编译出来的exe为 Main.exe

窗体如下图：

 

 

UMain.pas代码为：

unit UMain;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

 

type

  TForm1 = class(TForm)

    btn1: TButton;

    btn2: TButton;

    cbClassName: TComboBox;

    procedure btn1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure FormCreate(Sender: TObject);

    procedure btn2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

  HModel: Cardinal;

  HDll: Cardinal;

 

implementation

uses

  TestClasses;

 

{$R *.dfm}

 

//按钮1的单击事件

procedure TForm1.btn1Click(Sender: TObject);

var

  oList: TStrings;

  i: Integer;

  oClass: TTestClassClass;

  oObj: TTestClass;

begin

  oList := TTestClass.GetRegistClasses;

  for i := 0 to oList.Count - 1 do

  begin

    oClass := TTestClassClass(oList.Objects[i]);

    oObj := oClass.Create;

    ShowMessage(oClass.ClassName);

    oObj.ShowSomeMessage;

    oObj.Free;

  end;

 

end;

 

//窗口的关闭事件

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  UnloadPackage(HModel);//卸载运行时包

end;

 

//窗口的创建事件

procedure TForm1.FormCreate(Sender: TObject);

var

  oList: TStrings;

  I: Integer;

begin

  HModel := LoadPackage('Package1.bpl');

  HDll := LoadLibrary('PjtDll.dll');

 

  oList := TTestClass.GetRegistClasses;

 

  cbClassName.Items.BeginUpdate;

  cbClassName.Items.Clear;

  for I := 0 to oList.Count - 1 do

  begin

    cbClassName.Items.Add(oList.ValueFromIndex[I]);

  end;

  if (oList.Count > 0) then

    cbClassName.ItemIndex := 0;

 

  cbClassName.Items.EndUpdate;

 

end;

//按钮2的单击事件

procedure TForm1.btn2Click(Sender: TObject);

var

  oList: TStrings;

  i: Integer;

  oClass: TTestClassClass;

  oObj: TTestClass;

  pClass: TClass;

  strClass: string;

begin

  oList := TTestClass.GetRegistClasses;

  oClass := TTestClassClass(oList.Objects[oList.IndexOf(cbClassName.Text)]);

  oObj := oClass.Create;

  pClass := oObj.ClassType;

  while (pClass <> nil) do

  begin

    strClass := strClass + #10#13 + '-- ' + pClass.ClassName;

    pClass := pClass.ClassParent;

 

  end;

  ShowMessage(strClass) ;//oClass.ClassName);

  oObj.ShowSomeMessage;

  oObj.Free;

 

end;

 

end.

 

 

1.2、     创建TestClasses.pas

File-->New-->Unit, 命名为TestClasses.pas,代码如下：

unit TestClasses;

 

interface

uses Windows, Classes, SysUtils;

 

type

  TTestClassClass = class of TTestClass;

  TTestClass = class(TObject) //

    class procedure RegistClass;//类过程

    class function GetRegistClasses: TStrings;//类函数

 

    procedure ShowSomeMessage; virtual; //定义虚方法，子类实现

  end;

  

implementation

var

  FClassList: TStringList;

 

  { TTestClass }

 

class function TTestClass.GetRegistClasses: TStrings;

begin

  Result := FClassList;

end;

 

class procedure TTestClass.RegistClass;

begin

  FClassList.AddObject(Self.ClassName, TObject(Self));

end;

 

procedure TTestClass.ShowSomeMessage;

begin

  raise Exception.Create('not implementation');

end;

 

initialization

  if (not Assigned(FClassList)) then

    FClassList := TStringList.Create;

 

finalization

  if (Assigned(FClassList)) then

    FreeAndNil(FClassList);

end.

 

 

1.3、     类似1.2， 添加TestClasses1.pas,代码如下：

unit TestClasses1;

 

interface

uses Windows, Classes, TestClasses, Dialogs;

type

  TTestClasses1 = class(TTestClass)

    procedure ShowSomeMessage; override;

  end;

implementation

 

{ TTestClasses1 }

 

procedure TTestClasses1.ShowSomeMessage;

begin

  ShowMessage('TestClasses1');

end;

 

initialization

  TTestClasses1.RegistClass;

end.

2.    创建运行时包,将TestClasses单元添加到Contains中,并新建一个TestClasses2单元(同TestClasses1).

2.1、创建运行时包

     a、File-->New-->Other , 如下图：

b、在Contains，添加TestClasses.pas, 新建TestClasses2.pas(和1.2一样) ,并添加到Contains中

 

TestClasses2.pas代码如下：

unit TestClasses2;

 

interface

uses Windows, Classes, TestClasses, Dialogs;

type

  TTestClasses2 = class(TTestClass)

    procedure ShowSomeMessage; override;

  end;

 

implementation

 

{ TTestClasses2 }

 

procedure TTestClasses2.ShowSomeMessage;

begin

  ShowMessage('TestClasses2');

 

end;

 

initialization

  TTestClasses2.RegistClass ;

 

end.

c、编译 Package1，然后安装，到 Delphi7的安装目录中的Borland\Delphi7\Projects\Bpl中取出Package1.bpl,放到和Main.exe的同意目录下。

3.    创建DLL工程,将TestClasses单元添加到工程中,并创建一个TestClasses4单元(同TestClasses1)

3.1、创建dll

a、创建Dll，命名为PjtDll.dpr, 即编译出来为PjtDll.dll

  File-->New-->Other , 如下图：

b、添加TestClasses.pas到 Dll中，同时创建TestClasses3.pas(步骤如：1.2  创建TestClasses) ,

TestClasses3.pas代码如下：

unit TestClasses3;

 

interface

uses Windows, Classes, TestClasses, Dialogs;

type

  TTestClasses3 = class(TTestClass)

    procedure ShowSomeMessage; override;

  end;

 

implementation

 

{ TTestClasses3 }

 

procedure TTestClasses3.ShowSomeMessage;

begin

  ShowMessage('TestClasses3');

 

end;

 

initialization

  TTestClasses3.RegistClass ;

end.

4.    将第1,3两步创建的工程改为带包编译（需包括步骤2所创建的包）

   步骤：菜单栏-->Project-->Options的Packages页面中；

4.1、Main.exe带包编译设置如下图

4.2、PjtDll.dpr带包编译设置如下图：

5.    在exe项目中调用LoadLibrary导入dll及LoadPackage 导入bpl ；

 

实现效果:
带包编译的情况下,点击按钮可以分别调用bpl,dll,exe中创建的TestClasses子类方法.具体开发中在主程序中动态查找bpl或dll并将其装载即可使用其中的类及方法.

 

 

转载自：http://blog.csdn.net/henreash/article/details/7029844