外加的功能模块。
优点在于可以随时发布功能扩展,用户安装插件后,扩展系统功能。
也可公布插件接口,由第三方开发者编写,在不公布核心框架的前提下,可由由第三方为系统扩展功能。最典型的如:PhotoShop
插件通常是具有准标接口的DLL,可以由许多开发工具生成,如VC,Delphi,BCB都可以。
在Delphi中有一些控件,可以让程序具有插件机制。例如,这个控件:
unit PlugIn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
PPluginData = ^TPluginData;
TPluginData = packed record // 插件接口数据
Count: integer;
Instance: Longint;
end;
type
TPluginModule = class // 插件模块信息
FileName: string;
ProcCount: integer;
Instance: LongInt;
Address: Integer;
end;
type
TPluginProc = class // 插件接口函数信息
ProcName: string;
Name: String;
Hint: String;
Info: String;
Address: Integer;
ResID: string;
end;
type
TPluginError = (peNoProc,peNoUnloadProc,peNoModule);
TPluginErrorProc = procedure(Error: TPluginError)of object;
TPluginLoad = procedure(index: integer; Bitmap: TBitmap; PluginProc: TPluginProc)of object;
TPluginUnLoad = procedure(index: integer)of object;
TPlugInInit = function (Owner: Integer): PPluginData;
TPluginExecute = procedure;
TPluginRegister = function(Index,InfoType: Integer): PChar;
TProcInfo = function(Index,InfoType:Integer)
Char;
TPluginInfo=function
Char;
TUnloading=procedure;
TPlugIn = class(TComponent)
private
FUnload,FRegister, FInit: String;
FDir, FExt: string;
FList: TList;
FFileList: TStringList;
FCount, FIndex: integer;
BM: TBitmap;
FPluginLoad: TPluginLoad;
FPluginUnLoad: TPluginUnLoad;
FPluginError: TPluginErrorProc;
StopSearch: Boolean;
FFileCount: integer;
FModuleList:TStringList;
procedure SetFileList(s: TStringList);
procedure ScanDir(Dir, extension: string);
function CalculateFirstIndex(Module:string):integer;
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure LoadPlugin(Module: string);
procedure LoadAllPlugins;
procedure RunPlugin(index: integer);
procedure UnLoadPlugin(index: integer);
procedure UnLoadAllPlugins;
procedure UnloadModule(Module:string);
procedure ScanDirectory;
function GetPluginProc(index:integer):TPluginProc;
published
property InitializeString: string read FInit write FInit;
property RegisterNameString: string read FRegister write FRegister;
property UnloadString:string read FUnload write FUnload;
property Files: TStringList read FFileList write SetFileList;
property OnLoadPlugin: TPluginLoad read FPluginLoad write FPluginLoad;
property OnUnloadPlugin: TPluginUnload read FPLuginUnload write FPluginUnload;
property OnError: TPluginErrorProc read FPluginError write FPluginError;
property Count: integer read FCount;
property Directory: string read FDir write FDir;
property Extension: string read FExt write FExt;
end;
procedure Register;
const
itProcName=0;
itName=1;
itHint=2;
itInfo=3;
itResID=4;
implementation
constructor TPlugIn.Create(AOwner: TComponent);
begin
inherited;
FInit := 'Initialize'; // 默认的插件初始化函数名
FRegister := 'RegisterProcs'; // 默认的插件接口函数登记函数名
FUnload:='Unload';
FExt := 'dll';
FDir := '';
FList := TList.Create;
FFileList := TStringList.Create;
FModuleList:=TStringList.Create;
FIndex := 0;
FCount := 0;
FFileCount := 0;
BM := TBitmap.Create;
end;
destructor TPlugIn.Destroy;
begin
FList.Free;
FFileList.Free;
FModuleList.Free;
BM.Free;
inherited;
end;
(*启动一个指定的插件*)
procedure TPlugin.LoadPlugin(Module: string);
var
PlugMod: TPluginModule;
PlugProc: TPluginProc;
PluginData: PPluginData;
i: integer;
begin
if FModuleList.IndexOf(Module)>-1 then
exit;
PlugMod := TPluginModule.Create;
PlugMod.FileName := Module;
PlugMod.Address := LoadLibrary (PChar (Module) );
PluginData := TPluginInit( GetProcAddress( PlugMod.Address, PChar(FInit)))(HInstance);
PlugMod.ProcCount := PluginData^.Count;
PlugMod.Instance := PluginData^.Instance;
if PlugMod.ProcCount<1 then
begin
if Assigned(FPluginError) then FPluginError(peNoProc);
PlugMod.Free;
exit;
end;
FModuleList.AddObject(Module,TObject(PlugMod));
inc(FFileCount);
for i := 0 to PlugMod.ProcCount - 1 do
begin
PlugProc := TPluginProc.Create;
PlugProc.Address := PlugMod.Address;
PlugProc.ProcName :=TPluginRegister(GetProcAddress (PlugProc.Address,PChar(FRegister)))(i,itProcName);
PlugProc.Name :=TPluginRegister(GetProcAddress (PlugProc.Address,PChar(FRegister)))(i,itName);
PlugProc.Hint :=TPluginRegister(GetProcAddress (PlugProc.Address,PChar(FRegister)))(i,itHint);
PlugProc.Info :=TPluginRegister(GetProcAddress (PlugProc.Address,PChar(FRegister)))(i,itInfo);
PlugProc.ResID:=TPluginRegister(GetProcAddress (PlugProc.Address,PChar(FRegister)))(i,itResID);
if PlugProc.ResID<>'' then
BM.Handle := LoadBitmap(PlugMod.Instance, PChar(PlugProc.ResID));
FList.Add(PlugProc);
if Assigned(FPluginLoad) then
FPluginLoad(FIndex, BM, PlugProc);
inc(FIndex);
inc(FCount);
end;
end;
{装载找搜索到的所有插件文件}
procedure TPlugin.LoadAllPlugins;
var
i: integer;
begin
for i := 0 to FFileList.Count - 1 do
LoadPlugin(FFileList
);
end;
(*运行插件内指定的函数*)
procedure TPlugin.RunPlugin(index: integer);
var
FCall: pointer;
begin
if (FList.Count - 1<index) or
(index<0) then exit;
TPluginExecute( GetProcAddress(
TPluginProc( Flist[ index ] ).Address,
PChar(TPluginProc(Flist[index]).ProcName)
));
end;
(*Unloads individual plugin procedures
Does not free the library though*)
procedure TPlugin.UnloadPlugin(index: integer);
begin
if (FList.Count<index - 1)or(index<0)then exit;
//FreeLibrary( TPluginProc ( Flist [index ] ).Address );
dec(FCount);
if Assigned(FPluginUnload) then
FPluginUnload(index);
end;
procedure TPlugin.UnloadAllPlugins;
var
i: integer;
begin
if FCount<1 then exit;
for i := 0 to FCount - 1 do
UnloadPlugin(i);
end;
procedure TPlugin.SetFileList(s: TStringList);
begin
FFileList.Assign(s);
end;
function TPlugin.GetPluginProc(index:integer):TPluginProc;
begin
result:=TPluginProc(FList[index]);
end;
(*Original code to scan directories for plugins
was developed by William Yang and used in his
example of developing plugins. I have modified
*slightly* and used it here. The bulk of the code
is his, though*)
procedure TPlugin.ScanDir(Dir, Extension: String);
var
Found: TSearchRec;
Sub: String;
i: Integer;
Dirs: TStrings;
Finished: Integer;
begin
StopSearch := False;
Dirs := TStringList.Create;
Finished := FindFirst(Dir + '*.*', 63, Found);
while (Finished = 0) and not (StopSearch) do
begin
if (Found.Name[1] <> '.') then
begin
if (Found.Attr and faDirectory = faDirectory) then
Dirs.Add(Dir + Found.Name)
else
if Pos(UpperCase(Extension), UpperCase(Found.Name))>0 then
FFileList.Add(Dir + Found.Name);
end;
Finished := FindNext(Found);
end;
FindClose(Found);
if not StopSearch then
for i := 0 to Dirs.Count - 1 do
ScanDir(Dirs, Extension);
Dirs.Free;
end;
procedure TPlugin.ScanDirectory;
begin
ScanDir(FDir, '.' + FExt);
end;
(*Calculates the index of the first plugin
procedure within the specified module.
Returns -1 if the module has not been loaded.*)
function TPlugin.CalculateFirstIndex(Module:String):integer;
var
n,i,count:integer;
begin
result:=-1;
count:=0;
i:=FModuleList.IndexOf(module);
if i<0 then exit;
for n:=0 to i-1 do
count:=count+TPluginModule(FModuleList.Objects).ProcCount;
result:=count;
end;
(*Unloads an entire module,freeing the library
and unloading all plugin procs loaded from
the module.(I think this one has a couple of
bugs in it).*)
procedure TPlugin.UnloadModule(Module:string);
var
count,n,index,i:integer;
PM:TPluginModule;
begin
PM:=TPluginModule.Create;
index:=FModuleList.IndexOf(Module);
if index<0 then exit;
i:=CalculateFirstIndex(Module);
PM:=TPluginModule(FModuleList.Objects[index]);
count:=PM.ProcCount;
for n:=i to i+count-1 do
UnloadPlugin;
try
TUnloading(GetProcAddress(PM.Instance,PChar(FUnload)));
except
begin
end;
end;
FreeLibrary(PM.Address);
FModuleList.Delete(index);
end;
procedure Register;
begin
RegisterComponents(Samples', [TPlugin]);
end;
end.
它规定:
1.插件具有以下方法作为接口:
function Initialize(Owner: Integer): PPluginData; // 取插件信息
function RegisterProcs(Index,InfoType: Integer): PChar; // 登记接口函数
2.接口数据为:
TPluginData // 插件函数表
3.插件中的方法形式为:
procedure Proc;