插件管理框架 for Delphi

/article/10242697.html

1 前言

1.1 插件技术

许多软件采用“插件”（PlugIns）来扩展其功能，比如PhotoShop所支持的各类滤镜就是插件；我们所熟知的Winamp，也有许多皮肤以及可视效果插件。再有微软的windows media player，以及QQ，冲浪软件Opera……采用插件技术的软件数不胜数，而各个软件的具体实现方式也是五花八门，各有特点。

插件技术的出发点主要是为了使软件能够灵活地进行扩展功能，而不需要对主程序（框架程序）进行重新编译和发布。它的原理相当简单。软件的功能由框架程序和插件来决定。在框架程序和插件之间具有一个特定的接口，它们两者须通过这个接口来传递数据或控制信息，以实现软件功能。因此，只要符合该接口的程序（或其他功能实体），就称为该框架程序的插件。

插件实体一般分为两种，一种是包含逻辑的程序，比如动态库、Exe程序等；另一种则是一组配置信息。前一种方式多见于作图软件，媒体播放软件，适合实现复杂的功能；后一种方式多用于实现软件的Skin（皮肤）功能，以及其他一些不需要进行复杂运算的功能模块（有许多游戏软件的关卡也是采用此种方式实现，比如阿达软件的连连看）。

本篇给出在实现Dll插件方式框架程序的过程中，对Dll进行管理的框架程序及使用例子，作为读者进行插件程序设计的基础。具体而言，框架程序需要完成插件的装载、功能调用以及卸载三类功能。

1.2 其实…

其实每个控制面板程序，都是操作系统的插件。因为每个.cpl文件就是实现了特定接口的Dll。Windows的服务程序也是如此，它也只是在原有程序的基础上处理了特定的windows消息而已。

其实从广义上讲，每个运行在操作系统上的程序都是操作系统这个软件的“插件”。

其实在Delphi中，已经有一个插件管理的框架，那就是bpl。采用bpl组件包的方式也可以轻松实现功能的插件化扩展。只是该方式有个缺点：不支持其他开发工具（如vb、vc++）进行插件开发。

2 插件框架（untDllManager）

2.1 概述

untDllManager单元中定义了两个基础的类：

TDll：所有Dll类的父类，提供了装载、卸载的相关操作；

TDllManager：Dll类的容器类。支持删除元素方式卸载Dll实体。

以下为类图：

2.2 实现代码

unit untDllManager;

interface

uses
Windows, Classes, SysUtils, Forms;

type

EDllError = Class(Exception);

TDllClass = Class of TDll;
TDll = Class;

TDllEvent = procedure(Sender: TObject; ADll: TDll) of Object;

{ TDllManager
o
提供对 Dll 的管理功能；

o Add
时自动创建 TDll 对象，但不尝试装载；
o Delete
时自动销毁 TDll 对象；
}

TDllManager = Class(TList)
private
FLock: TRTLCriticalSection;
FDllClass: TDllClass;
FOnDllLoad: TDllEvent;
FOnDllBeforeUnLoaded: TDllEvent;
function GetDlls(const Index: Integer): TDll;
function GetDllsByName(const FileName: String): TDll;
protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
public
constructor Create;
destructor Destroy; override;
function Add(const FileName: String): Integer; overload;
function IndexOf(const FileName: String): Integer; overload;
function Remove(const FileName: String): Integer; overload;
procedure Lock;
procedure UnLock;
property DllClass: TDllClass read FDllClass write FDllClass;
property Dlls[const Index: Integer]: TDll read GetDlls; default;
property DllsByName[const FileName: String]: TDll read GetDllsByName;
property OnDllLoaded: TDllEvent read FOnDllLoad write FOnDllLoad;
property OnDllBeforeUnLoaded: TDllEvent read FOnDllBeforeUnLoaded write FOnDllBeforeUnLoaded;
end;

{ TDll
o
代表一个 Dll, Windows.HModule
o
销毁时自动在 Owner 中删除自身；
o
子类可通过覆盖override DoDllLoaded, 以及DoDllUnLoaded进行功能扩展;
}

TDll = Class(TObject)
private
FOwner: TDllManager;
FModule: HMODULE;
FFileName: String;
FPermit: Boolean;
procedure SetFileName(const Value: String);
function GetLoaded: Boolean;
procedure SetLoaded(const Value: Boolean);
procedure SetPermit(const Value: Boolean);
protected
procedure DoDllLoaded; virtual;
procedure DoBeforeDllUnLoaded; virtual;
procedure DoDllUnLoaded; virtual;
procedure DoFileNameChange; virtual;
procedure DoPermitChange; virtual;
public
constructor Create; virtual;
destructor Destroy; override;
function GetProcAddress(const Order: Longint): FARPROC; overload;
function GetProcAddress(const ProcName: String): FARPROC; overload;
property FileName: String read FFileName write SetFileName;
property Loaded: Boolean read GetLoaded write SetLoaded;
property Owner: TDllManager read FOwner;
property Permit: Boolean read FPermit write SetPermit;
end;

implementation

{ TDll }

constructor TDll.Create;
begin
FOwner := nil;
FFileName := '';
FModule := 0;
FPermit := True;
end;

destructor TDll.Destroy;
var
Manager: TDllManager;
begin
Loaded := False;
if FOwner <> nil then
begin
//在拥有者中删除自身
Manager := FOwner;
//未防止在 TDllManager中重复删除，因此需要将
//FOwner设置为 nil; <--
此段代码和 TDllManager.Notify 需要配合
//才能确保正确。

FOwner := nil;
Manager.Remove(Self);
end;
inherited;
end;

function TDll.GetLoaded: Boolean;
begin
result := FModule <> 0;
end;

function TDll.GetProcAddress(const Order: Longint): FARPROC;
begin
if Loaded then
result := Windows.GetProcAddress(FModule, Pointer(Order))
else
raise EDllError.CreateFmt('Do Load before GetProcAddress of "%u"', [DWORD(Order)]);
end;

function TDll.GetProcAddress(const ProcName: String): FARPROC;
begin
if Loaded then
result := Windows.GetProcAddress(FModule, PChar(ProcName))
else
raise EDllError.CreateFmt('Do Load before GetProcAddress of "%s"', [ProcName]);
end;

procedure TDll.SetLoaded(const Value: Boolean);
begin
if Loaded <> Value then
begin
if not Value then
begin
Assert(FModule <> 0);
DoBeforeDllUnLoaded;
try
FreeLibrary(FModule);
FModule := 0;
except
Application.HandleException(Self);
end;
DoDllUnLoaded;
end
else
begin
FModule := LoadLibrary(PChar(FFileName));
try
Win32Check(FModule <> 0);
DoDllLoaded;
except
On E: Exception do
begin
if FModule <> 0 then
begin
FreeLibrary(FModule);
FModule := 0;
end;
raise EDllError.CreateFmt('LoadLibrary Error: %s', [E.Message]);
end;
end;
end;
end;
end;

procedure TDll.SetFileName(const Value: String);
begin
if Loaded then
raise EDllError.CreateFmt('Do Unload before load another Module named: "%s"',
[Value]);
if FFileName <> Value then
begin
FFileName := Value;
DoFileNameChange;
end;
end;

procedure TDll.DoFileNameChange;
begin
// do nonthing.
end;

procedure TDll.DoDllLoaded;
begin
if Assigned(FOwner) and Assigned(FOwner.OnDllLoaded) then
FOwner.OnDllLoaded(FOwner, Self);
end;

procedure TDll.DoDllUnLoaded;
begin
//do nonthing.
end;

procedure TDll.DoPermitChange;
begin
//do nonthing.
end;

procedure TDll.SetPermit(const Value: Boolean);
begin
if FPermit <> Value then
begin
FPermit := Value;
DoPermitChange;
end;
end;

procedure TDll.DoBeforeDllUnLoaded;
begin
if Assigned(FOwner) and Assigned(FOwner.OnDllBeforeUnLoaded) then
FOwner.OnDllBeforeUnLoaded(FOwner, Self);
end;

{ TDllManager }

function TDllManager.Add(const FileName: String): Integer;
var
Dll: TDll;
begin
result := -1;
Lock;
try
if DllsByName[FileName] = nil then
begin
Dll := FDllClass.Create;
Dll.FileName := FileName;
result := Add(Dll);
end
else
result := -1;
finally
UnLock;
end;
end;

constructor TDllManager.Create;
begin
FDllClass := TDll;
InitializeCriticalSection(FLock);
end;

destructor TDllManager.Destroy;
begin
DeleteCriticalSection(FLock);
inherited;
end;

function TDllManager.GetDlls(const Index: Integer): TDll;
begin
Lock;
try
if (Index >=0) and (Index <= Count - 1) then
result := Items[Index]
else
raise EDllError.CreateFmt('Error Index of GetDlls, Value: %d, Total Count: %d', [Index, Count]);
finally
UnLock;
end;
end;

function TDllManager.GetDllsByName(const FileName: String): TDll;
var
I: Integer;
begin
Lock;
try
I := IndexOf(FileName);
if I >= 0 then
result := Dlls[I]
else
result := nil;
finally
UnLock;
end;
end;

function TDllManager.IndexOf(const FileName: String): Integer;
var
I: Integer;
begin
result := -1;
Lock;
try
for I := 0 to Count - 1 do
if CompareText(FileName, Dlls[I].FileName) = 0 then
begin
result := I;
break;
end;
finally
UnLock;
end;
end;

procedure TDllManager.Lock;
begin
OutputDebugString(Pchar('TRLock DM' + IntToStr(GetCurrentThreadId) + ':' + IntToStr(DWORD(Self))));
EnterCriticalSection(FLock);
OutputDebugString(Pchar('Locked DM' + IntToStr(GetCurrentThreadId) + ':' + IntToStr(DWORD(Self))));
end;

procedure TDllManager.Notify(Ptr: Pointer; Action: TListNotification);
begin
if Action = lnDeleted then
begin
//若TDll(Ptr).Owner和Self不同，则
//表明由 TDll.Destroy
触发；
if TDll(Ptr).Owner = Self then
begin
//防止FOwner设置为nil之后相关事件不能触发
TDll(Ptr).DoBeforeDllUnLoaded;
TDll(Ptr).FOwner := nil;
TDll(Ptr).Free;
end;
end
else
if Action = lnAdded then
TDll(Ptr).FOwner := Self;
inherited;
end;

function TDllManager.Remove(const FileName: String): Integer;
var
I: Integer;
begin
result := -1;
Lock;
try
I := IndexOf(FileName);
if I >= 0 then
result := Remove(Dlls[I])
else
result := -1;
finally
UnLock;
end;
end;

procedure TDllManager.UnLock;
begin
LeaveCriticalSection(FLock);
OutputDebugString(Pchar('UnLock DM' + IntToStr(GetCurrentThreadId) + ':' + IntToStr(DWORD(Self))));
end;

end.

3 使用举例

3.1 类图

3.2 客户端组件

从TDll派生出TClientDll；

根据真实的动态库接口添加相关属性；

3.2.1
组件定义

unit untClientDll;

interface

uses

Windows, Classes, SysUtils, untDllManager, untProcDefine;

type

EClientDllError = Class(Exception);

{ TClientDll

o 继承自 TDll;

o 自动获取 ClientInitialize
地址并保存在 ClientInitialize 属性中；

o 自动获取 ClientInsertTrigger
地址并保存在 ClientInsertTrigger 属性中；

}

TClientDll = Class(TDll)

private

FClientInitialize: TClientInitialize;

FClientInsertTrigger: TClientInsertTrigger;

FClientGetDescription: TClientGetDescription;

FClientSetup: TClientSetup;

FDescription: String;

FUseTrigger: Bool;

protected

procedure DoDllLoaded; override;

procedure DoDllUnLoaded; override;

public

constructor Create; override;

property ClientGetDescription: TClientGetDescription read FClientGetDescription;

property ClientInitialize: TClientInitialize read FClientInitialize;

property ClientInsertTrigger: TClientInsertTrigger read FClientInsertTrigger;

property ClientSetup: TClientSetup read FClientSetup;

property Description: String read FDescription write FDescription;

property UseTrigger: Bool read FUseTrigger write FUseTrigger;

end;

implementation

{ TClientDll }

constructor TClientDll.Create;

begin

inherited;

FClientInitialize := nil;

FClientInsertTrigger := nil;

FClientGetDescription := nil;

FClientSetup := nil;

end;

procedure TClientDll.DoDllLoaded;

begin

FClientInitialize := GetProcAddress(csClientInitialize);

if not Assigned(FClientInitialize) then

raise EClientDllError.Create('No found of Proc "ClientInitialize".');

FClientInsertTrigger := GetProcAddress(csClientInsertTrigger);

if not Assigned(FClientInsertTrigger) then

raise EClientDllError.Create('No found of Proc "ClientInsertTrigger".');

//可选接口，即使不存在也不报错。

FClientGetDescription := GetProcAddress(csClientGetDescription);

FClientSetup := GetProcAddress(csClientSetup);

inherited;

end;

procedure TClientDll.DoDllUnLoaded;

begin

inherited;

FClientInitialize := nil;

FClientInsertTrigger := nil;

FClientGetDescription := nil;

FClientSetup := nil;

end;

end.

3.2.2
组件使用

procedure TXXXXServer.LoadClientDll(const FileName: String);

//功能：加载一个ClientDll，并将相关数据传递进去

var

Index: Integer;

Description: String;

UseTrigger: Bool;

AClientDll: TClientDll;

begin

Index := FClientDlls.Add(FileName);

if Index < 0 then

raise EXXXXError.CreateFmt('ClientDll "%s"
之前已经装载.', [FileName]);

//尝试读取地址

try

FClientDlls[Index].Loaded := True;

finally

if not FClientDlls[Index].Loaded then

FClientDlls[Index].Free;

end;

//初始化该Client，同时将相关信息传入

UseTrigger := False;

AClientDll := TClientDll(FClientDlls[Index]);

if Assigned(AClientDll.ClientSetup) then

AClientDll.ClientSetup(mscAppPath + 'Client/', False);

end;

3.3 服务端组件

3.3.1
组件定义

unit untServerDll;

interface

uses

Windows, Classes, SysUtils, untDllManager, untProcDefine;

type

EServerDllError = Class(Exception);

{ TServerDll

o 继承自 TDll;

o 自动获取 QueryInterface
地址并保存在QueryInterface属性中；

}

TServerDll = Class(TDll)

private

FFunctions: TObject;

FQueryInterface: TProcQueryInterface;

protected

procedure DoDllLoaded; override;

procedure DoDllUnLoaded; override;

public

procedure RefreshAllFunctionsPermit;

property Functions: TObject read FFunctions write FFunctions;

property QueryInterface: TProcQueryInterface read FQueryInterface;

end;

implementation

uses

untFunctionProc;

{ TServerDll }

procedure TServerDll.DoDllLoaded;

begin

FQueryInterface := GetProcAddress(csQueryInterface);

if not Assigned(FQueryInterface) then

raise EServerDllError.Create('No found of "QueryInterface" Proc.');

inherited; //此句需要放在后面

end;

procedure TServerDll.DoDllUnLoaded;

begin

inherited;

FQueryInterface := nil;

end;

procedure TServerDll.RefreshAllFunctionsPermit;

var

I: Integer;

begin

Assert(FFunctions <> nil);

for I := 0 to TFunctionList(FFunctions).Count - 1 do

if TFunction(TFunctionList(FFunctions)[I]).Dll = Self then

TFunction(TFunctionList(FFunctions)[I]).Permit := Permit;

end;

end.

3.3.2
组件使用

略。

[文终]