请教在DELPHI中如何编写插件程序？谢谢，200分！(200分)

我想要详细的原理及相关的实例，谢谢！

我也对这个感兴趣。

等待回答......

Delphi 插件（Plug-ins）创建、调试与使用应用程序扩展

关键词：Delphi控件杂项

有没有使用过Adobe Photoshop？如果用过，你就会对插件的概念比较熟悉。
对外行人来说，插件仅仅是从外部提供给应用程序的代码块而已（举个例子来说，在
一个DLL中）。一个插件和一个普通DLL之间的差异在于插件具有扩展父应用程序功能
的能力。例如，Photoshop本身并不具备进行大量的图像处理功能。插件的加入使其获
得了产生诸如模糊、斑点，以及其他所有风格的奇怪效果，而其中任何一项功能都不
是父应用程序自身所具有的。

对于图像处理程序来说这很不错，可是为什么要花偌大的力气去完成支持插件的商业
应用程序呢？假设，我们举个例子，你的应用程序要产生一些报表。你的客户肯定会
一直要求更新或者增加新的报表。你可以使用一个诸如Report Smith的外部报表生成
器，这是个不怎么样的解决方案，需要发布附加的文件，要对用户进行额外的培训，
等等。你也可以使用QuickReport，不过这会使你身处版本控制的噩梦之中——如果每
改变一次字体你就要Rebuild你的应用程序的话。

然而，只要你把报表做到插件中，你就可以使用它。需要一个新的报表吗？
没问题，只要安装一个DLL，下次应用程序启动时就会看见它了。另外一个例子是处理
来自外部设备（比如条形码扫描器）的数据的应用程序，为了给用户更多的选择，你
不得不支持半打的各种设备。通过将每种设备接口处理例程写成插件，不用对父应用
程序作任何变动就可以获得最大程度的可伸缩性。

入门

在开始写代码之前最重要的事情就是搞清楚你的应用程序到底需要扩展哪些功
能。这是因为插件是通过一个特定的接口与父应用程序交互的，而这个接口将根据你的
需要来定义。在本文中，我们将建立3个插件，以便展示插件与父应用程序相交互的几
种方式。

我们将把插件制作成DLL。不过，在做这项工作之前，我们得先制作一个外壳程
序来载入和测试它们。图1显示的是加载了第一个插件以后的测试程序。第一个插件没有
完成什么大不了的功能，实际上，它所做的只是返回一个描述自己的字符串。不过，它
证明了很重要的一点——不管有没有插件应用程序都可以正常运行。如果没有插件，它
就不会出现在已安装的插件列表中，但是应用程序仍然可以正常的行使功能。

我们的插件外壳程序与普通应用程序之间的唯一不同就在于工程源文件中出现
在uses子句中的Sharemem单元和加载插件文件的代码。任何在自身与子DLL之间传递字符
串参数的应用程序都需要Sharemem单元，它是DelphiMM.dll（Delphi提供该文件）的接
口。要测试这个外壳，需要将DelphiMM.dll文件从Delphi/Bin目录复制到path环境变量
所包含的路径或者应用程序所在目录中。发布最终版本时也需要同时分发该文件。

插件通过LoadPlugins过程载入到这个测试外壳中，这个过程在主窗口的
FormCreate事件中调用，见图2。该过程使用FindFirst和FindNext函数在应用程序所在
目录中查找插件文件。找到一个文件以后，就使用图3所示的LoadPlugins过程将其载入。

{ 在应用程序目录下查找插件文件 }

procedure TfrmMain.LoadPlugins;
var
sr: TSearchRec;
path: string;
Found: Integer;
begin
path := ExtractFilePath(Application.Exename);
try
Found := FindFirst(path + cPLUGIN_MASK, 0, sr);
while Found = 0 do begin
LoadPlugin(sr);
Found := FindNext(sr);
end;
finally
FindClose(sr);
end;
end;

{ 加载指定的插件 DLL. }

procedure TfrmMain.LoadPlugin(sr: TSearchRec);
var
Description: string;
LibHandle: Integer;
DescribeProc: TPluginDescribe;
begin
LibHandle := LoadLibrary(Pchar(sr.Name));
if LibHandle <> 0 then
begin
DescribeProc := GetProcAddress(LibHandle,
cPLUGIN_DESCRIBE);
if Assigned(DescribeProc) then
begin
DescribeProc(Description);
memPlugins.Lines.Add(Description);
end
else
begin
MessageDlg('File "' + sr.Name + '" is not a valid plug-in.',
mtInformation, [mbOK], 0);
end;
end
else
MessageDlg('An error occurred loading the plug-in "' +
sr.Name + '".', mtError, [mbOK], 0);
end;

LoadPlugin方法展示了插件机制的核心。首先，插件被写成DLL。其次，通过
LoadLibrary API它被动态的加载。一旦DLL被加载，我们就需要一个访问它所包含的过
程和函数的途径。API调用GetProcAddress提供这种机制，它返回一个指向所需例程的
指针。在我们这个简单的演示中，插件仅仅包含一个名为DescribePlugin的过程，由常数
cPLUGIN_DESCRIBE指定（过程名的大小写非常重要，传递到GetProcAddress的名称必须
与包含在DLL中的例程名称完全一致）。如果在DLL中没有找到请求的例程，
GetProcAddree将返回nil，这样就允许使用Assigned函数测定返回值。

为了以一种易用的方式存储指向一个函数的指针，有必要为用到的变量创建一个
特定的类型。注意，GetProcAddress的返回值被存储在一个变量中，DescribeProc，属于
TpluginDescribe类型。下面是它的声明：

type

TPluginDescribe = procedure(var Desc: string); stdcall;

由于过程存在于DLL内部，它通过标准调用转换编译所有导出例程，因此需要使
用stdcall指示字。这个过程使用一个var参数，当过程返回的时候它包含插件的描述。

要调用刚刚获得的过程，只需要使用保存地址的变量作为过程名，后面跟上任何
参数。就我们的例子而言，声明：

DescribeProc(Description)

将会调用在插件中获得的描述过程，并且用描述插件功能的字符串填充Description变量。

构造插件

我们已经创建好了父应用程序，现在该轮到创建我们希望加载的插件了。插件
文件是一个标准的Delphi DLL，所以我们从Delphi IDE中创建一个新DLL工程，保存它。
由于导出的插件函数将用到字符串参数，所以要在工程的uses子句中把Sharemen单元放
在最前面。图4列出的就是我们这个简单插件的工程源文件。

uses
Sharemem, SysUtils, Classes,
main in 'main.pas';

{$E plg.}

exports
DescribePlugin;

begin

end.

虽然插件是一个DLL文件，但是没有必要一定要给它一个.DLL的扩展名。实际上，
一个原因就足以让我们有理由改变扩展名：当父应用程序寻找要加载的文件时，新的扩展
名可以作为特定的文件掩模。通过使用别的扩展名（我们的例子使用了*.plg），你可以
在一定程度上确信应用程序只会载入相应的文件。编译指示字$X可以实现这个改变，也可
以通过Project Options对话框的Application页来设置扩展名。

第一个例子插件的代码是很简单的。图5显示了包含在一个新单元中的代码。注
意，DescribePlugin原型与外壳应用程序中的TpluginDescribe类型相一致，使用附加的
export保留字指定该过程将被导出。被导出的过程名称也将会出现在主工程源代码的
exports段中（在图4中列出）。

unit main;

interface

procedure DescribePlugin(var Desc: string);
export; stdcall;

implementation

procedure DescribePlugin(var Desc: string);
begin
Desc := 'Test plugin v1.00';
end;

end.

在测试这个插件之前，要先把它复制到主应用程序的路径下。最简单的办法就是
在主目录的子目录下创建插件，然后把输出路径设置为主路径（Project Options对话框
的Directories/Conditionals也可以作这个设置）。

调试

现在介绍一下Delphi 3中一个较好的功能：从IDE中调试DLL的能力。在DLL工程
中可以通过Run paramaters对话框指定某程序为宿主应用程序，这就是指向将调用DLL的
应用程序的路径（在我们这个例子中，就是刚刚创建的测试外壳程序）。然后你就可以
在DLL代码中设置断点并且按F9运行它——就像在一个普通应用程序中做的那样。Delphi
会运行指定的宿主程序，并且，通过编译带有调试信息的DLL，把你指引到DLL代码内的
断点处。

---

Delphi 插件（Plug-ins）创建、调试与使用应用程序扩展（续）

关键词：Delphi控件杂项

延伸父应用

这个简单的插件不错，不过它不能做什么有用的事情。第二个例子就是纠正这个问题。
这个插件的目标就是在父应用程序的主菜单中加入一个项目。这个菜单项目，当被单击
时，就会执行插件内的一些代码。图6显示外壳程序的改进版，两个插件都已经加载。在
这个版本的外壳程序中，一个名为Plug-in的新菜单项目，被添加到主菜单中。插件会在
运行时加入一个菜单项。

为了实现这个目的，我们必须在插件DLL中定义第二个接口。现有的DLL只导出了一个过
程，DescribePlugin。第二个插件将声明一个叫做InitPlugin的过程。不过，在这个过程
可以在主应用程序中看到以前，必须修改LoadPlugin来配合它。

图7所示的代码展示了改进的过程。

procedure TfrmMain.LoadPlugin(sr: TSearchRec);
var
Description: string;
LibHandle: Integer;
DescribeProc: TPluginDescribe;
InitProc: TPluginInit;
begin
LibHandle := LoadLibrary(Pchar(sr.Name));
if LibHandle <> 0 then
begin
// 查找 DescribePlugin.
DescribeProc := GetProcAddress(LibHandle,
cPLUGIN_DESCRIBE);
if Assigned(DescribeProc) then
begin
// 调用 DescribePlugin.
DescribeProc(Description);
memPlugins.Lines.Add(Description);
// 查找 InitPlugin.
InitProc := GetProcAddress(LibHandle, cPLUGIN_INIT);
if Assigned(InitProc) then
begin
// 调用 InitPlugin.
InitProc(mnuMain);
end;
end

else
begin
MessageDlg('File "' + sr.Name + '" is not a valid plugin.',
mtInformation, [mbOK], 0);
end;
end
else
begin
MessageDlg('An error occurred loading the plugin "' +
sr.Name + '".', mtInformation, [mbOK], 0);
end;
end;

如你所见，当GetProcAddress第一次查找调用描述过程之后，又调用了一次
GetProcAddress。这一次，我们要寻找的是常量cPLUGIN_INIT，定义如下：

const
cPLUGIN_INIT = 'InitPlugin';

返回值存储在TpluginInit类型的变量中，定义如下：

type

TPluginInit = procedure(ParentMenu: TMainMenu); stdcall;

当InitPlugin方法被执行时，父应用程序的主菜单被当作一个参数传递给它。这个过程
可以按照自己的意愿修改菜单。由于所有GetProcAddress的返回值都用assigned测试，
新版本的LoadPlugin过程仍然会加载不包含InitPlugin过程的第一个插件。在这个过程
中第一次调用寻找DescribePlugin方法会通过，第二次寻找InitPlugin会无响应失败。

现在新的接口已经定义好了，可以为新的InitPlugin方法编写代码了。像原先一样，
新插件的实现代码存在于一个单独的单元中。图8显示了修改过的包含InitPlugin方法
的main.pas。

unit main;

interface

uses Dialogs, Menus;

type
THolder = class
public
procedure ClickHandler(Sender: TObject);
end;

procedure DescribePlugin(var Desc: string);
export; stdcall;
procedure InitPlugin(ParentMenu: TMainMenu);
export; stdcall;

var
Holder: THolder;

implementation

procedure DescribePlugin(var Desc: string);
begin
Desc := 'Test plugin 2 - Menu test';
end;

procedure InitPlugin(ParentMenu: TMainMenu);
var
i: TMenuItem;
begin
// 创建新菜单项.
i := NewItem('Plugin &Test', scNone, False, True,
Holder.ClickHandler, 0, 'mnuTest');
ParentMenu.Items[1].Add(i);
end;

procedure THolder.ClickHandler;
begin
ShowMessage('Clicked!');
end;

initialization
Holder := THolder.Create;

finalization
Holder.Free;
end.

很明显，对原始插件的第一个改变就是增加了InitPlugin过程。像原先一样，带有
export关键字的原型被加入到单元顶端的列表中，过程名也被加入到工程源代码的
exports子句列表中。这个过程使用NewItem函数创建一个新的菜单项，返回值是TmenuItem
对象。新菜单项通过下列语句被加入到应用程序主菜单中：

ParentMenu.Items[1].Add(I);

在测试外壳主菜单上的Items[1]是菜单项Plug-in，所以这个语句在Plugin菜单条上添
加一个叫Plug-in Test的菜单项。

为了处理对新菜单项的响应，作为它的第五个参数，NewItem可以接受一个TNotifyEvent
类型的过程，这个过程将在菜单项被点击时调用。不幸的是，按照定义，这种类型的过程
是一个对象方法，然而在我们的插件中并没有对象。如果我们想用通常的指针来指向函数，
那么得到的将只会是Delphi编译器的抱怨。所以，唯一的解决办法就是创建一个处理菜单
点击的对象。这就是Tholder类的用处。它只有一个方法，是一个叫做ClickHandler的过程。
一个叫做Holder的全局变量，在修改过的main.pas的var段中被声明为Tholder类型，并且
在单元的initialization段中被创建。现在我们就有一个对象了，我们可以拿它的方法
（Holder.ClickHandler）当作NewItem函数的参数。

搞了这一通，ClickHandler除了显示一个“Clicked!”消息对话框以外什么以没干。也
许这不怎么有趣，不过它仍然证明了一点：插件DLL成功的修改了父应用的主菜单，表现
了它的新用途。并且如同第一个例子一样，不管这个插件在不在应用程序都能执行。

由于我们创建了一个对象来处理菜单点击，那么在不再需要这个插件时，就要释放这个
对象。修改后的单元中会在finalization段中处理这件事情。Finalization端时与
initialization段相对应的，如果前面有一个initialization段，那么在应用程序终止时
finalization段一定会得到执行。把下面的语句

Holder.Free

加到finalization段中，以确保Holder对象会被正确的释放。

显而易见，虽然这个插件只是修改了外壳应用的主菜单，但是它可以轻易地操纵传递
到InitPlugin过程中的任何其他对象。如果有必要，插件也可以打开自己的对话框，向
列表框（List boxes）和树状视图（tree views）中添加项目，或者在画布（canvas）
中绘画。

事件驱动的插件

到现在为止我们所描述的技术可以产生一种通用的扩展应用程序的方法。通过增加新菜
单、窗体和对话框，就可以实现全新的功能而不必对父应用做任何修改。不过仍然有一个
限制：这只是一种单侧（one-sided）机制。正如所看到的，系统依赖用户的某些操作才
能启动插件代码，比如点击菜单或者类似的动作。代码运行起来以后，又要依靠另外一个
用户动作来停止它，例如，关闭插件可能已经打开的窗体。克服这种缺陷的一种可行的方
法就是使插件可以响应父应用中的动作——模仿在Delphi中工作地很好的事件驱动编程模
型的确有效。

在最后一个例子插件中，我们将创建一种机制，插件可以藉此响应父应用中产生的事件。
通常情况下，可以通过判定需要触发哪些事件、在父应用中为每个事件创建一个Tlist对象
来实现。然后每个Tlist对象都被传递到插件的初始化过程中，如果插件想在某个事件中
执行动作，它就把负责执行的函数地址加入到对应的TList中。父应用在适当的时刻循环
这些函数指针的列表，按次序调用每个函数。通过这种方法，就为多个插件在同一事件中
执行动作提供了可能。

应用程序产生的事件完全依赖于程序已确定的功能。例如，一个TCP/IP网络应用程序可能
希望通过TclientSocket的onRead事件通知插件数据抵达，而一个图形应用程序可能对调
色板的变化更感兴趣。

为了说明事件驱动的插件应答的概念，我们将创建一个用于限制主窗口最小尺寸的插件。
这个例子有点儿造作，因为把这个功能做到应用程序里边会比这简单的多。不过这个例子
的优点在语容易编码而且易于理解，而这正是本文想要做到的。

很明显，我们要做的第一件事情就是决定到底要产生哪些事件。在本例中，答案很简单：
要限制一个应用程序窗口的尺寸，有必要捕获并且修改Windows消息WM_GETMINMAXSINFO。
因此，要创建一个完成这项功能的插件，我们必须捕获这个消息并且在这个消息处理器中
调用插件例程。这就是我们要创建的事件。

接下来我们要创建一个TList来处理这个事件。在主窗体的initialization段中将会创建
lstMinMax对象，然后，创建一个消息处理器来捕获Windows消息WM_GETMINMAXINFO。图9中
的代码显示了这个消息处理器。

{ 捕获 WM_GETMINMAXINFO. 为每个消息调用插件例程. }

procedure TfrmMain.MinMaxInfo(var msg: TMessage);
var
m: PMinMaxInfo; file://在 Windows.pas 中定义.
i: Integer;
begin
m := pointer(msg.Lparam);
for i := 0 to lstMinMax.count -1 do begin
TResizeProc(lstMinMax)(m.ptMinTrackSize.x,
m.ptMinTrackSize.y);
end;
end;

外壳应用的LoadPlugin过程必须再次修改以便调用初始化例程。这个新初始化函数把
我们的TList当作参数接受，在其中加入修改消息参数的函数地址。图10显示了LoadPlugin
过程的最终版本，它可以执行到目前为止所讨论的全部几个插件的初始化工作。

{ 加载指定的插件DLL. }

procedure TfrmMain.LoadPlugin(sr: TSearchRec);
var
Description: string;
LibHandle: Integer;
DescribeProc: TPluginDescribe;
InitProc: TPluginInit;
InitEvents:TInitPluginEvents;
begin
LibHandle:=LoadLibrary(Pchar(sr.Name));
ifLibHandle<>0then
begin
//查找DescribePlugin.
DescribeProc:=GetProcAddress(LibHandle, cPLUGIN_DESCRIBE);
if Assigned(DescribeProc) then
begin
// 调用 DescribePlugin.
DescribeProc(Description);
memPlugins.Lines.Add(Description);
file://查找InitPlugin.
InitProc := GetProcAddress(LibHandle, cPLUGIN_INIT);
if Assigned(InitProc) then
begin
file://调用InitPlugin.
InitProc(mnuMain);
end;
// 为第三方插件查找 InitPluginEvents
InitEvents := GetProcAddress(LibHandle,
cPLUGIN_INITEVENTS);
if Assigned(InitEvents) then
begin
// 调用 InitPlugin.
InitEvents(lstMinMax);
end;
end
else
begin
MessageDlg('File "' + sr.Name +
'" is not a valid plugin.',
mtInformation, [mbOK], 0);
end;
end
else
begin
MessageDlg('An error occurred loading the plugin "' +
sr.Name + '".', mtInformation, [mbOK], 0);
end;
end;

图 10: LoadPlugin 的最终版本

最后一步是创建插件自身。如同前面的几个例子，插件展示一个标志自身的描述过程。
它也带有一个初始化例程，在本例中只是接受一个TList作为参数。最后，它还包含一个
没有引出（Export）的历程，叫做AlterMinTrackSize，它将修改传递给它的数值。图11
显示了最终插件的完整代码。

unit main;

interface

uses Dialogs, Menus, classes;

procedure DescribePlugin(var Desc: string);
export; stdcall;
procedure InitPluginEvents(lstResize: TList);
export; stdcall;
procedure AlterMinTrackSize(var x, y: Integer); stdcall;

implementation

procedure DescribePlugin(var Desc: string);
begin
Desc := 'Test plugin 3 - MinMax';
end;

procedure InitPluginEvents(lstResize: TList);
begin
lstResize.Add(@AlterMinTrackSize);
end;

procedure AlterMinTrackSize(var x, y: Integer);
begin
x := 270;
y := 220;
end;

end.

InitPluginEvents过程是这个插件的初始化例程。它接受一个TList作为参数。这个
TList就是在父应用程序中创建的保存相应函数地址的列表。下面的语句：

lstResize.Add(@AlterMinTrackSize);

把AlterMinTrackSize函数的地址加入到了这个列表中。它被声明为类型stdcall以便
与其他过程相配，不过用不着export指示字。由于函数被直接通过它的地址调用，所以也
就没有必要按照通常的方式把它从DLL中引出。

所以，事件序列如下所列：

1、 在应用程序初始化时，创建一个TList对象。

2、 在启动时这个列表被传递到插件的初始化过程InitPluginEvents中。

3、 插件过程把一个过程的地址加入到列表中。

4、 每次窗口大小改变时所产生的Windows消息WM_GETMINMAXINFO被我们的应用程序所捕获。

5、 该消息被我们的消息处理器TfrmMain.MainMaxInfo所处理，见图10。

6、 消息处理器遍历列表并调用它所包含的函数，把当前的X和Y最小窗口尺寸作为参数传递
。要注意，TList类只是存储指针，所以如果想用保存的地址做些什么事情的话，我们必须
把指针转换成所需要的类型——在本例中，要转换成TresizeProc。

TResizeProc = procedure (var x, y: Integer); stdcall;

7、 插件过程AlterMinTrackSize（列表中的指针所指向的），接受X和Y值作为可变的var
参数并且修改它们。

8、 控制权返回到父应用的消息处理器，按照最小窗口尺寸的新值继续运行下去。

9、 应用程序退出时TList会在主代码的finalization段被释放。

结论

使用该体系结构时，可能利用Delphi提供的package功能是个不错的主意。在通常情况
下，我不是一个分割运行时模块的狂热爱好者，但是当你认为任一包含大量代码的Delphi
DLL超过200KB时，它就开始变得有意义了。

这篇文章应该还是有些用处的，至少它可以让你思考一些程序设计方面的问题，比如
如何让它变得更加灵活。我知道如果我在以前的应用程序中使用一些这种技术的话，我就
可以省掉在修改程序方面的好多工作。我并不想把插件作为一种通用的解决方案。很明显，
有些情况下额外的复杂度无法验证其正确性，或者应用程序压根儿就不打算把自身搞成
几块可扩展的单元。还有一些其它的方法也可以达成同样的效果。Delphi自身提供了一个
接口来创作能集成到IDE中的模块，比起我所说明的技术这种方法更加面向对象（或者说
更“干净”），而我也确信你可以在自己的应用中模仿这一技术。在运行时加载Delphi包
也不是做不到的。探索一下这种可能性吧。

[本文所介绍的技术在Delphi 4下工作的很好。实际上，Delphi 4增加了工程选项，使
这类应用程序加强DLL（application-plus-DLL）的开发变得更加容易了。]

这个问题以前讨论过了
http://www.delphibbs.com/delphibbs/dispq.asp?LID=433604

是否我需要为每一个预定义的功能在主程序里都为插件留一个说明及调用代码？那功能一多，不是太麻烦了吗？能否真正即插即用？
用插件的方式以后主程序可以都不用升级了吗？
换程序外观的程序怎么做的？

网页作坊不就有插件功能吗，去问问他的作者陈大年去。

先来简单的饿，在漫漫进步。高手就是你了

好东西

我正在做一个类似的东西，差不多完成了（除了文档）
请留下Email, 我给你，也可讨论一下 sunrace2000@163.com

to sunrace2000:
请寄一份给我，谢谢
xie_p_f@21cn.com

sunrace2000@163.com,我的EMAIL是BCAHZ@SINA.COM,谢谢！

sunrace2000

也给我发一个？：）bitbird@126.com

to sunrace2000:
请寄一份给我，谢谢
pursuer_zhao@263.net

既然有这么多的朋友关注PlugIn技术，那我干脆贴出来请各位指教了！
其实我是在一个《工厂模拟运作系统》中采用PlugIn技术的，现在把其中的薪资管理模块的源代码提取出来。
顺便提一下，《工厂》的PlugIn参考了网络上的几篇关于插件的技术文档，在此，向他们表示感谢！
需要说明的是：先建立PMP目录，存放界面代码，PMP中还有PlugIn目录，不用说了，当然是放插件的。

//*******************
以下是界面源代码
//*******************

program PMP;

uses
Forms,
mainUnit in 'mainUnit.pas' {MainForm},
PlugInMagUnit in 'PlugInMagUnit.pas' {PlugInMagForm};

{$R *.RES}

begin
Application.Initialize;
Application.Title:='严力电子';
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

//****************

unit mainUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ComCtrls, ToolWin, ExtCtrls, Buttons, StdCtrls;

type
TMainForm = class(TForm)
MainMenu: TMainMenu;
mnuFile: TMenuItem;
mnuDateLogIn: TMenuItem;
mnuDateDefend: TMenuItem;
mnuSystemConfig: TMenuItem;
mnuPay: TMenuItem;
mnuHelp: TMenuItem;
mnuQuit: TMenuItem;
StatusBar1: TStatusBar;
CoolBar1: TCoolBar;
mnuTotal: TMenuItem;
mnu: TMenuItem;
mnuPlugInMag: TMenuItem;
procedure mnuQuitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure mnuClick(Sender: TObject);
procedure mnuPlugInMagClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
procedure LoadPlugIns;
procedure FreePlugIns;
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation
uses
PlugInMagUnit;

var PlugIns: TList;
type
TPmpPlugIn=class
Name: string;
InsertMenu:string;
OwnerMenu: string;
Version: string;
Description: string;
Address: Integer;
Call: Pointer;
end;

GetNameFunction=function: PChar;
Initalize=procedure(AHandle: THandle);
var
StopSearch: Boolean;

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+'*.dll',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,Ext,Files);
Dirs.Free;
end;




{$R *.DFM}

procedure TMainForm.LoadPlugIns;
var
Files: TStrings;
i: Integer;
PmpPlugIn: TPmpPlugIn;
newMenu: TMenuItem;
MenuID: integer;
begin
Files:=TStringList.Create;
PlugIns:=TList.Create;
SearchFileExt(ExtractFilePath(Application.Exename)+'/PlugIn/','.dll',Files);
//edit1.Text:=inttostr(files.count);
for i:=0 to Files.Count-1 do
begin
try
PmpPlugIn:=TPmpPlugIn.Create;
PmpPlugIn.Address:=LoadLibrary(Pchar(Files));
PmpPlugIn.Name:=GetNameFunction(GetProcAddress(PmpPlugIn.Address,'GetName'));
PmpPlugIn.InsertMenu:=GetNameFunction(GetProcAddress(PmpPlugIn.Address,'GetInsertMenu'));
PmpPlugIn.OwnerMenu:=GetNameFunction(GetProcAddress(PmpPlugIn.Address,'GetOwnerMenu'));
PmpPlugIn.Version:=GetNameFunction(GetProcAddress(PmpPlugIn.Address,'GetVersion'));
PmpPlugIn.Description:=GetNameFunction(GetProcAddress(PmpPlugIn.Address,'GetDescription'));
PmpPlugIn.Call:=GetProcAddress(PmpPlugIn.Address,'Initalize');

PlugIns.Add(PmpPlugIn);
NewMenu:=TMenuItem.Create(self);
NewMenu.Caption:=PmpPlugIn.OwnerMenu;
NewMenu.OnClick:=mnuClick;
NewMenu.Tag:=i;

for MenuId:=0 to mainmenu.Items.Count-1 do
if mainmenu.Items[menuID].Name=PmpPlugIn.InsertMenu then
mainmenu.Items[menuID].Add(NewMenu);
//=====================================

PlugInMagForm.StringGrid1.RowCount:=PlugInMagForm.StringGrid1.RowCount+1;
PlugInMagForm.StringGrid1.Cells[0,i+1]:=PmpPlugIn.Name;
PlugInMagForm.StringGrid1.Cells[1,i+1]:=PmpPlugIn.Version;
PlugInMagForm.StringGrid1.Cells[2,i+1]:=PmpPlugIn.Description;

except
//on EAccessViolation do messagedlg('加载无效插件',mterror,[mbOK],0);
end;


end;
Files.Free;
end;

procedure TMainForm.FreePlugIns;
var
i: Integer;
begin
for i:=0 to PlugIns.Count-1 do
begin
FreeLibrary(TPmpPlugIn(PlugIns).Address);
end;
end;

procedure TMainForm.mnuQuitClick(Sender: TObject);
begin
close;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
PlugInMagForm:=TPlugInMagForm.Create(self);
PlugInMagForm.stringgrid1.Cols[0].Text:='插件名称';
PlugInMagForm.stringgrid1.Cols[1].Text:='版本';
PlugInMagForm.stringgrid1.Cols[2].Text:='功能说明';
//==============================
LoadPlugIns;
//=================

end;

procedure TMainForm.mnuClick(Sender: TObject);
begin
Initalize(TPmpPlugIn(PlugIns[TMenuItem(Sender).Tag]).Call)(Application.Handle);
end;

procedure TMainForm.mnuPlugInMagClick(Sender: TObject);
begin
PlugInMagForm.ShowModal;

end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
freeplugins;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if application.MessageBox('你确定要退出系统吗？','退出系统',MB_ICONQUESTION+MB_YESNO)=IDYES then
CanClose:=true
else CanClose:=false;

end;

end.
//************************

unit PlugInMagUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Grids, DBGrids;

type
TPlugInMagForm = class(TForm)
BitBtn1: TBitBtn;
StringGrid1: TStringGrid;
private
{ Private declarations }
public
{ Public declarations }
end;

var
PlugInMagForm: TPlugInMagForm;

implementation

{$R *.DFM}

end.




//*********************
以下是插件模板
//*********************

library temptle;


uses
SysUtils,
Classes,
Windows,
Messages,
Forms,
TemptleUnit in 'TemptleUnit.pas' {TemptleForm};

function GetName: Pchar; far;
begin
Result := '模板';
end;
function GetInsertMenu: PChar;far;
begin
Result:='mnuHelp';
end;
function GetOwnerMenu: PChar;far;
begin
Result:='模板';
end;
function GetVersion: PChar;far;
begin
Result:='V1.00';
end;
function GetDescription: PChar;far;
begin
Result:='插件模板';
end;

procedure Initalize(AppHandle: THandle); far;
begin
try
Application.Handle:=AppHandle;
TemptleForm:=TTemptleForm.Create(application);
TemptleForm.ShowModal;
except
end;
end;



exports
GetName,GetInsertMenu,GetOwnerMenu,GetVersion,GetDescription,Initalize;

begin
end.

//*****************

unit TemptleUnit;

interface

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

type
TTemptleForm = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
TemptleForm: TTemptleForm;

implementation

{$R *.DFM}

end.
//***********************
以上在Delphi5.0中编译成功，不完善的地方，还请各位网友指教，我的Email: sunrace2000@163.com


蒋卫军
2001/5/18

多人接受答案了。