请教高手关于：“利用Delphi编写IE扩展”

我把“利用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的具体代码：<贴子太长，源码部分付后>代码很长，但是关键的是tiehelper.setsite方法以及tiehelper.invoke方法。在tiehelper.setsite方法中注意以下语句：if assigned(sp)thensp.queryservice(iwebbrowserapp, iwebbrowser2, ie);if assigned(ie) then beginie.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 事件中编写代码访问服务器并转到正确的站点上去。

解决方案 »

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

unit iehelperunit;interfaceuseswindows, comobj, activex, shdocvw, mshtml,dialogs;typetiehelperfactory = class(tcomobjectfactory)privateprocedure addkeys;procedure removekeys;publicprocedure updateregistry(register: boolean); override;end;tiehelper = class(tcomobject, idispatch, iobjectwithsite)publicfunction 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;privateie: iwebbrowser2;cookie: integer;end;constclass_iehelper: tguid = '{41CA0320-1B63-11D8-8166-00055DE656A1}';implementationuses comserv, registry, sysutils;procedure dostatustextchange(const text: widestring);beginend;procedure doprogresschange(progress: integer; progressmax: integer);beginend;procedure docommandstatechange(command: integer; enable: wordbool);beginend;procedure dodownloadbegin;beginend;procedure dodownloadcomplete;beginend;procedure dotitlechange(const text: widestring);beginend;procedure dopropertychange(const szproperty: widestring);beginend;procedure dobeforenavigate2(const pdisp: idispatch; var url: olevariant; var flags: olevariant; var targetframename: olevariant; var postdata: olevariant; var headers: olevariant; var cancel: wordbool);beginif url<>'http://www.applevb.com/' then beginshowmessage('你不可以浏览其它站点');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);beginend;procedure donavigatecomplete2(const pdisp: idispatch; var url: olevariant);beginend;procedure dodocumentcomplete(const pdisp: idispatch; var url: olevariant);beginend;procedure doonquit;beginend;procedure doonvisible(visible: wordbool);beginend;procedure doontoolbar(toolbar: wordbool);beginend;procedure doonmenubar(menubar: wordbool);beginend;procedure doonstatusbar(statusbar: wordbool);beginend;procedure doonfullscreen(fullscreen: wordbool);beginend;procedure doontheatermode(theatermode: wordbool);beginend;procedure buildpositionaldispids(pdispids: pdispidlist; const dps: tdispparams);vari: integer;beginassert(pdispids <> nil);for i := 0 to dps.cargs - 1 dopdispids^[i] := dps.cargs - 1 - i;if (dps.cnamedargs <= 0) then exit;for i := 0 to dps.cnamedargs - 1 dopdispids^[dps.rgdispidnamedargs^[i]] := i;end;function tiehelper.invoke(dispid: integer; const iid: tguid; localeid: integer;flags: word; var params; varresult, excepinfo, argerr: pointer): hresult;typepolevariant = ^olevariant;vardps: tdispparams absolute params;bhasparams: boolean;pdispids: pdispidlist;idispidssize: integer;beginresult := disp_e_membernotfound;pdispids := nil;idispidssize := 0;bhasparams := (dps.cargs > 0);if (bhasparams) thenbeginidispidssize := dps.cargs * sizeof(tdispid);getmem(pdispids, idispidssize);end;tryif (bhasparams) then buildpositionaldispids(pdispids, dps);case dispid of102:begindostatustextchange(dps.rgvarg^[pdispids^[0]].bstrval);result := s_ok;end;108:begindoprogresschange(dps.rgvarg^[pdispids^[0]].lval, dps.rgvarg^[pdispids^[1]].lval);result := s_ok;end;105:begindocommandstatechange(dps.rgvarg^[pdispids^[0]].lval, dps.rgvarg^[pdispids^[1]].vbool);result := s_ok;end;106:begindodownloadbegin();result := s_ok;end;104:begindodownloadcomplete();result := s_ok;end;113:begindotitlechange(dps.rgvarg^[pdispids^[0]].bstrval);result := s_ok;end;112:begindopropertychange(dps.rgvarg^[pdispids^[0]].bstrval);result := s_ok;end;
250:begindobeforenavigate2(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:begindonewwindow2(idispatch(dps.rgvarg^[pdispids^[0]].pdispval^), dps.rgvarg^[pdispids^[1]].pbool^);result := s_ok;end;252:begindonavigatecomplete2(idispatch(dps.rgvarg^[pdispids^[0]].dispval), polevariant(dps.rgvarg^[pdispids^[1]].pvarval)^);result := s_ok;end;259:begindodocumentcomplete(idispatch(dps.rgvarg^[pdispids^[0]].dispval), polevariant(dps.rgvarg^[pdispids^[1]].pvarval)^);result := s_ok;end;253:begindoonquit();result := s_ok;end;254:begindoonvisible(dps.rgvarg^[pdispids^[0]].vbool);result := s_ok;end;255:begindoontoolbar(dps.rgvarg^[pdispids^[0]].vbool);result := s_ok;end;256:begindoonmenubar(dps.rgvarg^[pdispids^[0]].vbool);result := s_ok;end;257:begindoonstatusbar(dps.rgvarg^[pdispids^[0]].vbool);result := s_ok;end;258:begindoonfullscreen(dps.rgvarg^[pdispids^[0]].vbool);result := s_ok;end;260:begindoontheatermode(dps.rgvarg^[pdispids^[0]].vbool);result := s_ok;end;end;finallyif (bhasparams) then freemem(pdispids, idispidssize);end;end;function tiehelper.getidsofnames(const iid: tguid; names: pointer;namecount, localeid: integer; dispids: pointer): hresult;beginresult := e_notimpl;end;function tiehelper.gettypeinfo(index, localeid: integer;out typeinfo): hresult;beginresult := e_notimpl;pointer(typeinfo) := nil;end;function tiehelper.gettypeinfocount(out count: integer): hresult;beginresult := 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)elseresult:= e_fail;end;function tiehelper.setsite(const punksite: iunknown): hresult;varcmdtarget: iolecommandtarget;sp: iserviceprovider;cpc: iconnectionpointcontainer;cp: iconnectionpoint;beginif assigned(punksite) then begincmdtarget := punksite as iolecommandtarget;sp := cmdtarget as iserviceprovider;if assigned(sp)thensp.queryservice(iwebbrowserapp, iwebbrowser2, ie);if assigned(ie) then beginie.queryinterface(iconnectionpointcontainer, cpc);cpc.findconnectionpoint(dwebbrowserevents2, cp);cp.advise(self, cookie)end;end;result := s_ok;end;procedure tiehelperfactory.addkeys;var s: string;begins := guidtostring(class_iehelper);with tregistry.create dotryrootkey := hkey_local_machine;if openkey('Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + s, true)then closekey;finallyfree;end;end;procedure tiehelperfactory.removekeys;var s: string;begins := guidtostring(class_iehelper);with tregistry.create dotryrootkey := hkey_local_machine;deletekey('Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + s);finallyfree;end;end;procedure tiehelperfactory.updateregistry(register: boolean);begininherited updateregistry(register);if register then addkeys else removekeys;end;initializationtiehelperfactory.create(comserver, tiehelper, class_iehelper,'iehelper', '', cimultiinstance, tmapartment);end.
你的代码执行到这里了吗？
procedure dobeforenavigate2(const pdisp: idispatch; var url: olevariant; var flags: olevariant; var targetframename: olevariant; var postdata: olevariant; var headers: olevariant; var cancel: wordbool);beginif url<>'http://www.applevb.com/' then beginshowmessage('你不可以浏览其它站点');cancel:=true;url:='http://www.applevb.com';(pdisp as iwebbrowser2).navigate2(url,flags,targetframename,postdata,headers);end;end;
如何实现，请帮忙。最好给个实例。
email: [email protected]
检查internet选项/高级、启用第三方浏览器扩展是否打开
http://www.euromind.com/iedelphi/index.htm
这里资料比较全。
回复： satanmonkey(撒旦) ：
我找不到这一项呀？
估计你的IE是5.0
5。0用BHO有Bug
升级到5。5以上。