umain.pas

delphi插件编程演示

unit uMain;

interface

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

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;
    StatusBar1: TStatusBar;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  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;
   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函数
  try
    ShowDLLForm(application.handle,TMyPlugin(plugins[TMenuItem(sender).Tag]).Caption);
  except
    showmessage('打开窗体错误!');
  end;
end;

//释放插件
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  self.LoadPlugins;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  self.FreePlugins;
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;

end.