利用Delphi编写IE扩展     就是如何使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(iconnectionpointcontainer, cpc);
        cpc.findconnectionpoint(dwebbrowserevents2, cp);
        cp.advise(self, cookie)
      end;
  end;
  result := s_ok;
end;


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 事件中编写代码访问服务器并转到正确的站点上去。