如何制作插件？

我知道一点
等以下
利用Delphi编写IE扩展
在自己的程序中使用过WebBrowser控件的朋友都知道，WebBrowser控件定义了诸如BeforeNavigate、DownloadComplete 等事件，我们可以通过编写事件处理代码实现对WebBrowser控件的操作。那么如何实现对IE的事件响应和处理呢？同建立IE面板一样。我们需要建立一个实现IObjectWithSite接口的COM组件，不同的是，我们还需要实现IDispatch接口，在IObjectWithSite接口的SetSite方法中获得IE的WebBrowser接口并建立自身与WebBrowser的连接，然后如果在IE的Webbrowser对象中发生什么事件的话，那么IE就会回调连接的IDispatch接口的Invoke方法。我们通过在Invoke方法中编写代码就可以获得IE事件了。这个利用的是COM编程的回调接口原理。
下面我们首先来实现代码。点击Delphi菜单 File | New 。在 ActiveX 页面中选择Active Library ，然后点击 OK 按钮。然后用同样的方法建立一个COM Object。在COM Object Wizard 窗口中，将复选框 Included type library 去掉。然后在Class Name中输入IEHelper，在Implemented Interface 中输入：IDispatch；IObjectwithSite 。然后点击 OK 按钮建立一个COM组件。
保存工程，将工程保存为IEHelper.dpr，将Unit1保存为IEHelperUnit.pas。下面是IEHelperUnit.pas的具体代码：
unit iehelperunit;
interface
uses
WIndows, Comobj, ActiveX, SHDOCVW, MSHTML,Dialogs;
type
TIEHelperFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register: Boolean); override;
end;
TIEHelper = class(TComObject, IDispatch, IObjectWithSite)
public
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
private
IE: IWebbrowser2;
Cookie: Integer;
end;
const
Class_IEHelper: TGUID = ’{3D898C55-74CC-4B7C-B5F1-45913F368388}’;
implementation
uses ComServ, Registry, SysUtils;
procedure DoStatusTextChange(const Text: WideString);
begin
end;
procedure DoProgressChange(Progress: Integer; ProgressMax: Integer);
begin
end;
procedure DoCommandStateChange(Command: Integer; Enable: WordBool);
begin
end;
procedure DoDownloadBegin;
begin
end;
procedure DoDownloadComplete;
begin
end;
procedure DoTitleChange(const Text: WideString);
begin
end;
procedure DoPropertyChange(const szProperty: WideString);
begin
end;
procedure DoBeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant; var Headers: OleVariant; var Cancel: WordBool);
begin
if URL<>’http://www.applevb.com/’then begin
Showmessage(’你不可以浏览其它站点’);
Cancel:=True;
URL:=’http://www.applevb.com’;
(pDisp as IWebbrowser2).Navigate2(URL,Flags,TargetFrameName,PostData,Headers);
end;
end;
procedure DoNewWindow2(var ppDisp: IDispatch; var Cancel: WordBool);
begin
end;
procedure DoNavigateComplete2(const pDisp: IDispatch; var URL: OleVariant);
begin
end;
procedure DoDocumentComplete(const pDisp: IDispatch; var URL: OleVariant);
begin
end;
procedure DoOnQuit;
begin
end;
procedure DoOnVisible(Visible: WordBool);
begin
end;
procedure DoOnToolBar(ToolBar: WordBool);
begin
end;
procedure DoOnMenuBar(MenuBar: WordBool);
begin
end;
procedure DoOnStatusBar(StatusBar: WordBool);
begin
end;
procedure DoOnFullScreen(FullScreen: WordBool);
begin
end;
procedure DoOnTheaterMode(TheaterMode: WordBool);
begin
end;
procedure BuildPositionalDispIds(pDispIds: PDispIdList; const dps: TDispParams);
var
i: integer;
begin
Assert(pDispIds <> nil);
for i := 0 to dps.cArgs - 1 do
pDispIds^[i] := dps.cArgs - 1 - i;
if (dps.cNamedArgs <= 0) then Exit;
for i := 0 to dps.cNamedArgs - 1 do
pDispIds^[dps.rgdispidNamedArgs^[i]] := i;
end;
function TIEHelper.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
type
POleVariant = ^OleVariant;
var
dps: TDispParams absolute Params;
bHasParams: boolean;
pDispIds: PDispIdList;
iDispIdsSize: integer;
begin
Result := DISP_E_MEMBERNOTFOUND;
pDispIds := nil;
iDispIdsSize := 0;
bHasParams := (dps.cArgs > 0);
if (bHasParams) then
begin
iDispIdsSize := dps.cArgs * SizeOf(TDispId);
GetMem(pDispIds, iDispIdsSize);
end;
try
if (bHasParams) then BuildPositionalDispIds(pDispIds, dps);
case DispId of
102:
begin
DoStatusTextChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
108:
begin
DoProgressChange(dps.rgvarg^[pDispIds^[0]].lval, dps.rgvarg^[pDispIds^[1]].lval);
Result := S_OK;
end;
105:
begin
DoCommandStateChange(dps.rgvarg^[pDispIds^[0]].lval, dps.rgvarg^[pDispIds^[1]].vbool);
Result := S_OK;
end;
106:
begin
DoDownloadBegin();
Result := S_OK;
end;
104:
begin
DoDownloadComplete();
Result := S_OK;
end;
113:
begin
DoTitleChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
112:
begin
DoPropertyChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
250:
begin
DoBeforeNavigate2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval), POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^, POleVariant(dps.rgvarg^[pDispIds^[2]].pvarval)^, POleVariant(dps.rgvarg^[pDispIds^[3]].pvarval)^, POleVariant(dps.rgvarg^[pDispIds^[4]].pvarval)^, POleVariant(dps.rgvarg^[pDispIds^[5]].pvarval)^, dps.rgvarg^[pDispIds^[6]].pbool^);
Result := S_OK;
end;
251:
begin
DoNewWindow2(IDispatch(dps.rgvarg^[pDispIds^[0]].pdispval^), dps.rgvarg^[pDispIds^[1]].pbool^);
Result := S_OK;
end;
252:
begin
DoNavigateComplete2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval), POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;
259:
begin
DoDocumentComplete(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval), POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;
253:
begin
DoOnQuit();
Result := S_OK;
end;
254:
begin
DoOnVisible(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
255:
begin
DoOnToolBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
256:
begin
DoOnMenuBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
257:
begin
DoOnStatusBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
258:
begin
DoOnFullScreen(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
260:
begin
DoOnTheaterMode(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
end;
finally
if (bHasParams) then FreeMem(pDispIds, iDispIdsSize);
end;
end;
function TIEHelper.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TIEHelper.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
pointer(TypeInfo) := nil;
end;
function TIEHelper.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
Count := 0;
end;
function TIEHelper.GetSite(const riid: TIID; out site: IUnknown): HResult;
begin
// Result := S_OK;
if Assigned(IE) then result:=IE.QueryInterface(riid, site)
else
Result:= E_FAIL;
end;
function TIEHelper.SetSite(const pUnkSite: IUnknown): HResult;
var
cmdTarget: IOleCommandTarget;
Sp: IServiceProvider;
CPC: IConnectionPointContainer;
CP: ICOnnectionPoint;
begin
if Assigned(pUnkSite) then begin
cmdTarget := pUnkSite as IOleCommandTarget;
Sp := CmdTarget as IServiceProvider;
if Assigned(Sp)then
Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
if Assigned(IE) then begin
IE.QueryInterface(IConne

解决方案 »

免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货

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; beginend.        虽然插件是一个DLL文件，但是没有必要一定要给它一个.DLL的扩展名。实际上，
一个原因就足以让我们有理由改变扩展名：当父应用程序寻找要加载的文件时，新的扩展
名可以作为特定的文件掩模。通过使用别的扩展名（我们的例子使用了*.plg），你可以
在一定程度上确信应用程序只会载入相应的文件。编译指示字$X可以实现这个改变，也可
以通过Project Options对话框的Application页来设置扩展名。        第一个例子插件的代码是很简单的。图5显示了包含在一个新单元中的代码。注
意，DescribePlugin原型与外壳应用程序中的TpluginDescribe类型相一致，使用附加的
export保留字指定该过程将被导出。被导出的过程名称也将会出现在主工程源代码的
exports段中（在图4中列出）。unit main; interface  procedure DescribePlugin(var Desc: string);
     export; stdcall;implementationprocedure 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
       // 调用 Descr
现在新的接口已经定义好了，可以为新的InitPlugin方法编写代码了。像原先一样，
新插件的实现代码存在于一个单独的单元中。图8显示了修改过的包含InitPlugin方法
的main.pas。unit main; interfaceuses 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; implementationprocedure 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[i])(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; interfaceuses Dialogs, Menus, classes;   procedure DescribePlugin(var Desc: string);
     export; stdcall;
  procedure InitPluginEvents(lstResize: TList);
     export; stdcall;
  procedure AlterMinTrackSize(var x, y: Integer); stdcall;

implementationprocedure 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中引出。所以，
接上边
procedure TIEHelperFactory.AddKeys;
var S: string;
begin
S := GUIDToString(CLASS_IEHelper);
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey(’Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\’ + S, TRUE)
then CloseKey;
finally
free;
end;
end;
procedure TIEHelperFactory.RemoveKeys;
var S: string;
begin
S := GUIDToString(CLASS_IEHelper);
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
DeleteKey(’Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\’ + S);
finally
free;
end;
end;
procedure TIEHelperFactory.UpdateRegistry(Register: Boolean);
begin
inherited UpdateRegistry(Register);
if Register then AddKeys else RemoveKeys;
end;
initialization
TIEHelperFactory.Create(ComServer, TIEHelper, Class_IEHelper,
’IEHelper’, ’’, ciMultiInstance, tmApartment);
end.
代码很长，但是关键的是TIEHelper.SetSite方法以及TIEHelper.Invoke方法。在TIEHelper.SetSite方法中注意以下语句：
if Assigned(Sp)then
Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
if Assigned(IE) then begin
IE.QueryInterface(IConnectionPointContainer, CPC);
CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
CP.Advise(Self, Cookie)
上面的语句作用是，首先获得IE的Webbrowser接口，然后寻找到连接点。并通过Advise方法建立COM自身与连接点的连接。
当连接建立成功后，IE在有事件引发后，会调用连接到自身的IDispatch接口对象的Invoke方法。不同的事件对应不同的DispID编码，我们可以在程序中判断DispID并做相应的处理。在上面的程序中，我们只处理了BeforeNavigate2 事件，处理函数是DoBeforeNavigate2，在该函数中，如果浏览的站点不是’http://www.applevb.com/’的话，程序会提示：’你不可以浏览其它站点’并强行转到http://www.applevb.com。
很多的软件，象“护花使者”以及“3721”一类的中文网址”都是利用上面的原理来实现对IE浏览器事件响应的，例如3721，当用户输入一个中文词并浏览时，COM组件可以在BeforeNavigate2 事件中编写代码访问服务器并转到正确的站点上去。
以上程序在Win2K、Delphi 5下编写 Win98、Win2K下编辑通过，如果大家需要源程序或者对于COM编程需要有什么的指教的话，欢迎到我的主页 http://www.applevb.com 访问，我愿意同大家一起探讨。