mainfrm.pas

《delphi深度编程及其项目开发》

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

    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.