Delphi创建插件程序

设计思想：主程序每次启动时，在指定目录下查找dll文件，然后将其加载到菜单；设计插件应用要约定好接口函数，这样才方便主程序调用，按此接口编写程序，即可扩展出多个功能的插件。接下来按照如下两个步骤完成插件的创建与应用：

一、插件应用程序的创建，代码参考如下：

library Plugin1; uses SysUtils, Classes, Unit1 in 'Unit1.pas' {Plugin1Frm}; {$R *.res} exports ShowPlugin, GetCaption; begin end.

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TPlugin1Frm = class(TForm) Edit1: TEdit; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; //打开窗体 function ShowPlugin(AHandle: THandle; ACation: String): Boolean; Stdcall; //输出标题 function GetCaption: PChar; Stdcall; implementation {$R *.dfm} function ShowPlugin(AHandle: THandle; ACation: String): Boolean; var PForm: TPlugin1Frm; begin result := True; try Application.Handle := AHandle; PForm := TPlugin1Frm.Create(Application); try PForm.Caption := ACation; PForm.ShowModal; finally PForm.Free; end; except result := False; end; end; function GetCaption: PChar; begin Result := '插件应用1'; end; //DLL自身的事件 procedure TPlugin1Frm.Button1Click(Sender: TObject); begin Edit1.Text := '欢迎使用插件1'; end; end.

参照以上代码可编写多个插件的Dll，供主程序调用。

二、调用插件主程序的创建，代码参考如下：

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus; type TForm1 = class(TForm) MainMenu1: TMainMenu; File1: TMenuItem; New1: TMenuItem; Open1: TMenuItem; Save1: TMenuItem; Edit1: TMenuItem; Copy1: TMenuItem; Cut1: TMenuItem; Paste1: TMenuItem; N_Plugins: TMenuItem; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private procedure LoadPlugins; //初始化插件 ，也就装载插件，并在菜单提供调用 procedure PluginsClick(Sender: TObject); //插件菜单点击事件 procedure FreePlugins; //释放插件 public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} type //定义接口函数类型 TShowPlugin = function (AHandle: THandle; ACation: String): Boolean; Stdcall; TGetCaption = function : PChar; Stdcall; //定义TPluginInfo类，存放caption,Address,call等信息 TPluginInfo = class Caption: String; //存取加载后，GetCaption返回的标题 Address: THandle;//存取加载DLL的句柄 Call: Pointer; //存取ShowPlugin函数句柄 end; var ShowPlugin: TShowPlugin; //声明接口函数类型 Plugins: TList; //存放每一个DLL加载后的相关信息 bStopSearch: Boolean; //停止查找标志 //查找文件，并存于Files中 //TSearchRec 结构是内含文件大小、名称、属性与时间等信息 //TSearchRec 中的属性是一个整数值, 可能的值有: //faReadOnly 1 只读文件 //faHidden 2 隐藏文件 //faSysFile 4 系统文件 //faVolumeID 8 卷标文件 //faDirectory 16 目录文件 //faArchive 32 归档文件 //faSymLink 64 链接文件 //faAnyFile 63 任意文件 procedure SearchFileExt(Const dir, Ext: String; Files: TStrings); var Found: TSearchRec; Sub: String; i: Integer; Dirs: TStrings; Finished: Integer; begin bStopSearch := False; Dirs := TStringList.Create; Finished := FindFirst(Dir + '*.*', 63, Found); //找到则返回0 while (Finished = 0) and (not bStopSearch) do begin if (Found.Name[1] <> '.') then begin if (Found.Attr and faDirectory = faDirectory) then //找的是文件夹 则将重新组织查找路径 Dirs.Add(Dir + Found.Name) else if Pos(UpperCase(Ext), UpperCase(Found.Name)) > 0 then //如果查找到的文件名中存在Ext扩展名则加入Files Files.Add(Dir + Found.Name); end; Finished := FindNext(Found); end; FindClose(Found); if not bStopSearch then for i := 1 to Dirs.Count - 1 do //递归查找下级目录中的文件 SearchFileExt(Dirs[i], Ext, Files); Dirs.Free; end; { TForm1 } //释放插件 procedure TForm1.FreePlugins; var i: Integer; begin //将加载的插件全部释放（即动态加载的动态库） for i := 0 to Plugins.Count - 1 do begin FreeLibrary(TPluginInfo(Plugins[i]).Address); end; //释放plugIns对象 Plugins.Free; end; //初始化插件 ，也就装载插件，并在菜单提供调用 procedure TForm1.LoadPlugins; var Files: TStrings; i: Integer; PluginInfo: TPluginInfo; NewMenu: TMenuItem; GetCaption: TGetCaption; begin Files := TStringList.Create; Plugins := TList.Create; //查找指定目录下的.dll文件，并存于Files对象中 SearchFileExt(ExtractFilePath(Application.ExeName) + 'Plugins/', '.dll', Files); //加载查找到的DLL for i := 0 to Files.Count - 1 do begin PluginInfo := TPluginInfo.Create; PluginInfo.Address := LoadLibrary(PChar(Files[i])); if PluginInfo.Address = 0 then raise Exception.Create('装载' + PChar(Files[i]) + '失败！'); try @GetCaption := GetProcAddress(PluginInfo.Address, 'GetCaption'); PluginInfo.Caption := GetCaption; PluginInfo.Call := GetProcAddress(PluginInfo.Address, 'ShowPlugin'); Plugins.Add(PluginInfo); //创建菜单，并将菜单标题，调用窗体菜单的Onclick事件赋值 NewMenu := TMenuItem.Create(self); NewMenu.Caption := PluginInfo.Caption; NewMenu.OnClick := PluginsClick; NewMenu.Tag := i; N_Plugins.Add(NewMenu); except raise Exception.Create('初始化失败！'); end; end; Files.Free; end; //插件菜单点击事件 procedure TForm1.PluginsClick(Sender: TObject); begin //根据菜单的tag属性对应函数调用的地址（即取TList的元素） @ShowPlugin := TPluginInfo(Plugins[TMenuItem(Sender).Tag]).Call; //执行ShowPlugin函数 if not ShowPlugin(Application.Handle, TPluginInfo(Plugins[TMenuItem(Sender).Tag]).Caption) then ShowMessage('打开窗体错误'); end; procedure TForm1.FormCreate(Sender: TObject); begin LoadPlugins; end; procedure TForm1.FormDestroy(Sender: TObject); begin FreePlugins; end; end.

最后的效果如下下图所示：