delphi中dll综合运用的例子(动态加载插件)

1,新建dll客户端模块
---------------dll工程文件PlugIns.dll-------------------------------
library PlugIns;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
SysUtils,
Classes,
PlugInFrm in 'PlugInFrm.pas' {FrmPlugIns};

{$R *.res}

//输出接口函数
exports
ShowDLLForm,GetCaption;

begin
end.

-------------新建模块PlugInFrm.pas的窗体文件---------------
unit PlugInFrm;

interface

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

type
TFrmPlugIns = class(TForm)
    Label1: TLabel;
private
    { Private declarations }
public
    { Public declarations }
end;

//定义ShowDLLForm,用于打开本窗体
function ShowDLLForm(AHandle: THandle; ACaption: string): Boolean; Stdcall;

//输出标题
function GetCaption: Pchar; stdcall;

implementation

{$R *.dfm}

//输出标题
function GetCaption: Pchar; stdcall;
begin
Result := '插件演示NO1';
end;

//打开本窗体
function ShowDLLForm(AHandle: THandle; ACaption: string): Boolean;
var
DLL_Form: TfrmPlugins;
begin
result := true;
try
    application.Handle := AHandle; //传递应用程序地址
    DLL_Form := TFrmPlugins.Create(Application);//创建窗体
    try
      DLL_Form.caption := Acaption;//给窗体标题赋值
      DLL_Form.ShowModal; //模式显示窗体
    finally
      DLL_Form.Free;
    end;
except
    result := false;
end;
end;

end.

2,新建工程主模块

-------------------新建主窗体文件MainFrm.pas--------------
unit MainFrm;

interface

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

type
TFrmMain = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N_Plugins: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
private
    { Private declarations }
    FForm: TForm;
    procedure LoadPlugIns; //初始化插件 ，也就装载插件，并在菜单提供调用
    procedure PlugInsClick(Sender: TObject); //插件菜单点击事件
    procedure FreePlugIns; //释放插件
public
    { Public declarations }
end;

var
FrmMain: TFrmMain;

implementation

{$R *.dfm}

type
//定义接口函数类型
TShowDLLForm = function(AHandle: THandle; ACaption: string): Boolean; Stdcall;
TGetCaption = function: Pchar; StdCall;

EDLLLoadError = class(Exception);
//定义TTestPlugIn类，存放caption,Address,call等信息
TTestPlugIn = class
    Caption: string;//存取加载后，GetCaption返回的标题
    Address: THandle; //存取加载DLL的句柄
    Call: Pointer; //存取ShowDLLForm函数句柄
end;

var
ShowDllForm: TShowDllForm; //声明接口函数类型
Plugins: TList; //存放每一个DLL加载后的相关信息
StopSearch: Boolean;

//查找文件，并存于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) //Add to the directories list.
      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;
TestPlugIn: TTestPlugIn;
NewMenu: TMenuItem;
GetCaption: TGetCaption;
begin
Files := TStringList.Create;
Plugins := TList.Create;
//查找指定目录下的.dll文件，并存于Files对象中
SearchFileExt(ExtractFilepath(Application.Exename), '.dll', Files);
//加载查找到的DLL
for i := 0 to Files.Count - 1 do
begin
    TestPlugIn := TTestPlugIn.Create;
    TestPlugIn.Address := LoadLibrary(PChar(Files[i]));
    if TestPlugIn.Address = 0 then
      raise EDLLLoadError.Create('装载' + PChar(Files[i]) + '失败');
    try
      @GetCaption := GetProcAddress(TestPlugIn.Address, 'GetCaption');
      TestPlugIn.Caption := GetCaption;
      TestPlugIn.Call := GetProcAddress(TestPlugIn.Address, 'ShowDLLForm');
      PlugIns.Add(TestPlugIn);
      //创建菜单，并将菜单标题，Onclick事件赋值
      NewMenu := TMenuItem.Create(Self);
      NewMenu.Caption := TestPlugIn.Caption;
      NewMenu.OnClick := PlugInsClick;
      NewMenu.Tag := i;
      N_plugins.Add(NewMenu); //每次在菜单下新增一个模块菜单
    except
      raise EDLLLoadError.Create('初始化失败');
    end;
end;
Files.Free;
end;

//插件菜单点击事件
procedure TfrmMain.PlugInsClick(Sender: TObject);
begin
//根据菜单的tag属性对应函数调用的地址
@showDllForm := TTestPlugIn(PlugIns[TMenuItem(Sender).Tag]).Call;
//执行showDllForm函数
if not showDllForm(application.Handle, TTestPlugIn(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(TTestPlugIn(PlugIns[i]).Address);
end;
//释放plugIns对象
PlugIns.Free;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
LoadPlugIns;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FreePlugins;
end;

end.
-------------------------end-----------------------