umain.pas.~23~

delphi插件编程演示

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus;

type
  //定义接口函数类型
  TShowDllForm = function(aHandle: THandle; ACaption: String): boolean; stdcall; //窗体显示
  TGetCaption = function(aHandle: tHandle): pchar; stdcall; //取标题,用于菜单项

  //定义TMyPlugin类,存放 Caption、Address,Call信息
  TMyPlugin = Class
     Caption: string; //存取加载后的DLL中GetCaption返回的标题
     Address: THandle; //存取加载后的DLL的句柄
     Call: Pointer; //存取ShowDllForm函数的句柄,指针类型
  end;
  
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    plugins1: TMenuItem;
  private
    { Private declarations }
    procedure LoadPlugins; //初始化插件（装入插件，并在菜单提供调用）
    procedure PluginsClick(Sender:TObject); //插件菜单点击事件
    procedure FreePlugins; //释放插件
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  ShowDllForm: TShowDllForm; //声明接口函数类型
  Plugins: TList; //指针列表,存放每一个DLL加载后的相关信息
  StopSearch: boolean;

implementation

{$R *.dfm}

//通用过程，查找指定的文件，并存于Files中
procedure SearchFileExt(const Dir, Ext: string; Files: TStrings);
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(Ext), UpperCase(found.name))>0 then
          files.add(dir+found.name);
    end;
    finished := findnext(found);
  end;
  findclose(found);
  if not StopSearch then
    for i:=0 to dirs.count-1 do
      searchfileext(Dirs[i], Ext, Files);
  Dirs.Free;
end;

//装载插件
procedure TFrmMain.loadPlugins;
var
  files: tstrings; //存放文件查找结果的文件列表
  i: integer;
  MyPlugin: TMyPlugin; //存放插件信息的自定义的变量
  NewMenu: TMenuItem;
  GetCaption: TGetCaption; //获取插件标题的过程引用
begin
  files := tstringlist.Create; //文件列表
  Plugins := tlist.Create; //建立指针列表
  //查找当前目录的子目录plugins下的 .dll文件，并存于 "files 文件列表"中
  SearchFileExt(Extractfilepath(application.ExeName)+'Plugins\','.dll',files);
   //从文件列表中加载找到的DLL
  for i:=0 to files.Count-1 do
  begin
     myPlugin := TMyPlugin.Create;
     myPlugin.Address := loadlibrary(pchar(files[i])); //装载DLL，返回句柄
     if myplugin.Address=0 then
        showmessage('加载'+files[i]+'失败!')
     else begin 
       try
          @GetCaption:=GetProcAddress(myPlugin.Address,'GetCaption'); //通过DLL句柄取得“获取插件标题”过程的入口地址
          myPlugin.Caption:=GetCaption(application.Handle); //返回插件标题
          myPlugin.Call:=GetProcAddress(myPlugin.Address,'ShowDllForm'); //获取并保存窗体显示过程的入口地址
          Plugins.Add(myPlugin); //加入至指针列表
          //创建菜单，并将菜单标题OnClick事件赋值
          NewMenu:=TMenuItem.Create(self);
          NewMenu.Caption:=myplugin.Caption;
          newmenu.OnClick:=PluginsClick; //绑定事件
          NewMenu.Tag:=i; //用此标识作为插件事件的区分
          plugins1.Add(newMenu); //加入菜单项
       except
          showmessage('初始化失败!');
          raise;
       end;
     end;
  end;
  files.Free;   
end;

//插件菜单项点击事件
procedure TFrmMain.PluginsClick(Sender:TObject);
begin
   //根据菜单项的TAG属性对应函数调用的地址
   @ShowDllForm:=TMyPlugin(plugins[tmenuitem(sender).Tag]).Call;
   //执行ShowDllForm函数
   if not Showdllform(application.handle,TMyPlugin(plugins[TMenuItem(sender).Tag]).Caption) then
      showmessage('打开窗体错误!');
end;

//释放插件
procedure TFrmMain.FreePlugins;
var
  i:integer;
begin
  for i:=0 to plugins.Count-1 do
  begin
     freelibrary(tmyplugin(plugins[i]).Address); //按DLL的句柄释放内存
  end;
  plugins.free;

end;

procedure TFrmPluginMain.FormCreate(Sender: TObject);
begin
  //在表单建立时初始化插件列表
  self.LoadPlugins;
end;

procedure TFrmPluginMain.FormDestroy(Sender: TObject);
begin
  //表单释放时，释放插件
  self.FreePlugins;
end;

procedure TFrmPluginMain.Exit1Click(Sender: TObject);
begin
  self.close;
end;


end.