bpl插件系统开发(3)

上篇说了一些理论的东西,现在总结一下,我们的程序发布时应该想这样子:
主程序

一个完全由接口驱动的程序,它调用各种接口完成软件的功能.(当然并不是绝对的,如果你的某个功能并不需要外部来提供的化)

插件s(注意,加了s复数形式)

放在同一目录下,一个完整的插件应该有两个同名文件,一个是含有实现某接口的bpl,一个是描述该插件功能的xml.

主程序启动时,将加载所有的插件,在运行过程中调用某个接口时,将会向一个PluginLoader请求该接口,该
1fff7
PluginLoader会返回一个插件变量给调用者,而它是使用在bpl中的类来完成该调用.

over.

下面给出一个bplLoader类的代码例子,它可以被你的主程序调用,就是插件管理类

{*******************************************************}
{
codemyth.Group
copyright 2004-2005

codemyth(at)gmail(dot)com

Create at 2005-7-20 11:22:26

插件容器类,用于载入插件

Change history:

}
{*******************************************************}

unit uPluginLoader;

interface

uses codemyth.utils, codemyth.util.objectlist, uIPlugin, Xmlplugin, Classes,
SysUtils;

type

TPluginLoader = class( TObject )
private
FPluginList: TObjectList; //存储插件调用接口
function GetPlugin( const id: string ): IPlugin;
function GetCount: integer;
function GetPluginByIndex( const index: integer ): IPlugin;
protected
procedure UnloadPlugin( const id: string ); overload; //卸载指定的插件
procedure UnloadPlugin( const index: Integer ); overload; //卸载指定的插件
procedure LoadPlugin( const XmlFile: string ); //载入位于某目录下的插件
procedure UnloadPlugins; //卸载所有裁入的插件接口
public
constructor Create;
destructor Destroy; override;
public
procedure LoadPlugins( Directory: string ); //载入插件
property Plugin [const id: string]: IPlugin read GetPlugin;
property PluginByIndex [const index: integer]: IPlugin read
GetPluginByIndex;
property Count: integer read GetCount;
end;

implementation

{ TPluginLoader }

constructor TPluginLoader.Create;
begin
FPluginList := TObjectList.Create;
end;

destructor TPluginLoader.Destroy;
begin
UnloadPlugins;
FPluginList.Free;
inherited;
end;

function TPluginLoader.GetCount: integer;
begin
result := FPluginList.Count;
end;

function TPluginLoader.GetPlugin( const id: string ): IPlugin;
var
index : Integer;
begin
index := FPluginList.IndexOfName( id );
Check( index >= 0, Format( '未找到%s插件.', [id] ) );

result := GetPluginByIndex( index );
end;

function TPluginLoader.GetPluginByIndex( const index: integer ): IPlugin;
begin
Check( Index < FPluginList.Count,
IntToStr( index ) + '超出范围 ,没有该索引.' );

result := IPlugin(Pointer(FPluginList.Objects [index]));
end;

procedure TPluginLoader.LoadPlugin( const XmlFile: string );
var
BplFile : string;
XmlRoot : IXMLPluginType;
ImplClass : TPersistentClass;
obj : TPersistent;
Intf : IPlugin;
BplHandle : Cardinal;
begin
BplFile := ChangeFileExt( XmlFile, '.bpl' );
XmlRoot := Xmlplugin.Loadplugin( XmlFile );

//载入bpl
BplHandle := LoadPackage( BplFile );

//存入接口变量
ImplClass := GetClass( XmlRoot.Class_ );
check( ImplClass <> nil,
Format( '没有在%s中找到%s类.', [BplFile, XmlRoot.Class_] ) );

obj := ImplClass.Create;
Check( Supports( obj,
StringToGUID( '{48BF4000-B028-4B57-9955-B1A8305DA394}' ), Intf ),
ImplClass.ClassName + '不支持插件接口IPlugin.' );

//存入plugin,不允许id重复
if FPluginList.IndexOfName( XmlRoot.Id ) = -1 then
begin
FPluginList.AddObject( XmlRoot.Id + '=' + IntToStr( BplHandle )
, Pointer(Intf) );
end;
end;

procedure TPluginLoader.LoadPlugins( Directory: string );
var
i : Integer;
begin
with TStringList.Create do
begin
try
Text := GetFilesList( Directory, '.xml' );
for i := 0 to Count - 1 do
if FileExists( ChangeFileExt( Strings , '.bpl' ) ) then
LoadPlugin( Strings [i] );
finally
Free;
end;
end;
end;

procedure TPluginLoader.UnloadPlugin( const id: string );
var
index : Integer;
begin
index := FPluginList.IndexOfName( id );
Check( index >= 0, Format( '未找到%s插件.', [id] ) );

UnloadPlugin( index );
end;

procedure TPluginLoader.UnloadPlugin( const index: Integer );
begin

UnloadPackage( StrToInt( FPluginList.ValueFromIndex [index] ) );

FPluginList.Delete( index );
end;

procedure TPluginLoader.UnloadPlugins;
var
i : integer;
begin
for i := FPluginList.Count - 1 downto 0 do UnloadPlugin( i );
end;

end.

XmlConfig单元,XmlPlugin单元是一个由delphi XmlBinding向导生成的单元,用来读写plugin的xml配置文件

uIPlugin单元,是插件接口声明类

[i]{*******************************************************}
{
codemyth.Group
copyright 2004-2005

codemyth(at)gmail(dot)com

Create at 2005-7-20 10:22:47

插件系统公用定义,容器和插件均应包含该单元定义

Change history:

}
{*******************************************************}

unit uIPlugin;

interface

type

//插件信息体
TPluginInfo = record
Id: string; //插件id ,与xml文件中一样
Name: string; //插件名称
Version: string; //插件版本
Description: string; //插件简介描述
Vendor: string;
end;

//插件接口,开发之插件应实现该接口,容器使用该接口调用插件
{
容器调用的例子,得到IPlugin的实例thePlugin后
1.显示插件信息
ShowMessage(thePlugin.GetInfo.Name);
2.配置插件执行环境参数
thePlugin.EditConfig
3.执行插件
thePlugin.SetRunParam;
thePlugin.Execute;
thePlugin.GetRunResult; //处理插件执行结果
}
IPlugin = interface
['{48BF4000-B028-4B57-9955-B1A8305DA394}']
function GetRunResult: TObject; //用于向容器返回执行Execute后的结果
//用于容器传如执行参数,通常会显示一个Form让用户输入,如果用户存入了
procedure SetRunParam;
function GetInfo: TPluginInfo; //向容器返回插件的信息
{
用于容器调用配置插件的持久性配置,
通常会显示插件内的一个配置Form,
并可以将Form中的用户输入存入插件配置目录
}
procedure EditConfig;
procedure Execute; //执行插件
end;

implementation

end.

另两个codemyth开头的单元是我自己的函数包,其中codemyth.util.objectList声明了TObjectList类,它继承自TstringList类,但它可以自动销毁Objects中存储的对象实例而已.你可以用TstringList代替它,但你就需要自己释放TPluginList中的接口变量列表(虽然接口不需要释放,他通过引用计数来自释放