用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;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 = '{3d898c55-74cc-4b7c-b5f1-45913f368388}';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. 代码很长，然而要害的是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 事变中编写代码考察效劳器并转到精确的站点上去。　　之上步调在win2k、delphi 5下编写 win98、win2k下编纂经过，即使大师须要源步调大概对于com编制程序须要有什么的指点的话，欢送到我的网页 http://www.applevb.com 考察，我承诺同大师一道商量。