Delphi创建插件程序

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.  

文章转载：http://blog.csdn.net/kampan/article/details/6444139