• 阻断弹出式广告的BHO

    • 随着网络免费的大潮的退去,网站变得越来越商业化。浏览一些常去的网站,每看一个页面都会弹出N多的广告窗口,而且都是花花绿绿的Flash和Gif小动画,浪费带宽(我在家还是拨号上网),同时干扰了正常的阅读,非常讨厌。那么如何才能将这些广告屏蔽掉呢?答案就是Browser Helper Object(简称BHO)。

      BHO实际上也是一个简单的IE扩展COM组件,它和其它COM组件的区别就在于其它扩展需要一些用户的手工操作,如点击菜单,点击工具条按钮,在地址栏输入 网址等等触发动作才会被IE加载。而BHO则不同,每当IE启动时,都会自动去加载BHO而无须任何触发条件,另外BHO还可以监听IE的各类事件的通知消息,比如窗 口大小的变化,下载是否完成等事件。

      由于BHO可以在一启动IE就被加载,并能监听各种事件,我们就可以使用BHO扩展实现限制用户浏览某些色情网站,或者搜集用户浏览喜好信息等功能。接下来, 我们就来实现一个能够阻断广告弹出的BHO扩展。

      delphi代码
      1. 创建COM组件   
      2.   
      3.        新建一个ActiveX Library,保存为IEBHO.dpr,然后新建一个名为TIEAdvBHO的COM Object,然后保存生成的文件为CIEBHO.pas,作为BHO扩展,需要实现两 个接口IObjectWithSite和IDispatch,其中 IObjectWithSite接口同前面的工具条扩展一样可以用来获得浏览器的接口,而IDispatch接口,则被用来监听浏览器的事件。下面就是BHO扩展的类定义:   
      4.   
      5. type  
      6.   TTIEAdvBHO = class(TComObject, IObjectWithSite, IDispatch)   
      7.   private  
      8.     FIESite: IUnknown;   
      9.     FIE: IWebBrowser2;   
      10.     FCPC: IConnectionPointContainer;   
      11.     FCP: IConnectionPoint;   
      12.     FCookie: Integer;   
      13.   protected  
      14.     //IObjectWithSite接口方法定义  
      15.     function SetSite(const pUnkSite: IUnknown): HResult; stdcall;   
      16.     function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;   
      17.     //IDispatch接口方法定义  
      18.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;   
      19.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;   
      20.       stdcall;   
      21.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;   
      22.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;   
      23.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;   
      24.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;   
      25.       stdcall;   
      26.     //阻断广告弹出事件处理过程  
      27. procedure DoNewWindow2(var ppDisp: IDispatch; var Cancel: WordBool);   
      28.     procedure DoBeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant;var Headers: OleVariant; var Cancel: WordBool);   
      29. end;   
      30.     
      31.   
      32. IObjectWithSite的接口的实现   
      33.   
      34.     
      35.   
      36. 先看IObjectWithSite的接口的实现,当IE加载BHO扩展后,会调用BHO的扩展,把自身的IUnknown接口作为参数pUnkSite传给扩展,BHO扩展应该从pUnkSite参数中获得浏览器接口IWebBrowser2,同时为了监听浏览器的事件,还需要获得事件链接点接口,IE的支持的事件都定义在DWebBrowserEvents2的双接口中,使用链接点的Advise方法建立对IE事件的监听,注意Advise方法调用后 会返回一个Cookie,需要保存Cookie,后面在退出IE时,需要Cookie作为参数来断开对IE事件的监听。   
      37.   
      38. function TTIEAdvBHO.SetSite(const pUnkSite: IInterface): HResult;   
      39. begin  
      40.   Result := E_FAIL;   
      41.   //保存接口  
      42.   FIESite := pUnkSite;   
      43.   if not Supports(FIESite, IWebBrowser2, FIE) then  
      44. Exit;   
      45.   //获得事件连接点  
      46.   if not Supports(FIE, IConnectionPointContainer, FCPC) then  
      47.     Exit;   
      48.   FCPC.FindConnectionPoint(DWebBrowserEvents2, FCP);   
      49.   //监听事件  
      50.   FCP.Advise(Self, FCookie);   
      51.   Result := S_OK;   
      52. end;   
      53. 后面IE有时会调用IObjectWithSite接口的GetSite方法获得需要的接口,这时可以将保存的接口返回。   
      54.   
      55. function TTIEAdvBHO.GetSite(const riid: TIID;   
      56.   out site: IInterface): HResult;   
      57. begin  
      58.   if Supports(FIESite, riid,site) then  
      59.     Result := S_OK   
      60.   else  
      61.     Result:= E_NOINTERFACE;   
      62. end;   
      63.     
      64.   
      65. IDispatch接口的实现   
      66.   
      67.     
      68.   
      69. 前面我们在SetSite中建立了对IE事件的监听,建立事件监听后每当IE产生了新的事件,它就会调用扩展的IDispatch接口的Invoke方法通知扩展发生的事件类型以及事件参数,并请求扩展对事件进行处理。因此对于BHO扩展来说,IDispatch接口的Invoke方法是必须实现的,而其它的GetTypeInfoCount,GetTypeInfo和GetIDsOfNames方法都无须实现,只要返回结果为E_NOTIMPL,表示未实现该方法就可以了。   
      70.   
      71.     
      72.   
      73. function TTIEAdvBHO.GetIDsOfNames(const IID: TGUID; Names: Pointer;   
      74.   NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;   
      75. begin  
      76.   Result := E_NOTIMPL;   
      77. end;   
      78.     
      79. function TTIEAdvBHO.GetTypeInfo(Index, LocaleID: Integer;   
      80.   out TypeInfo): HResult;   
      81. begin  
      82.   Result := E_NOTIMPL;   
      83.   pointer(TypeInfo) := nil;   
      84. end;   
      85.     
      86. function TTIEAdvBHO.GetTypeInfoCount(out Count: Integer): HResult;   
      87. begin  
      88.   Result := E_NOTIMPL;   
      89.   Count := 0;   
      90. end;   
      91.     
      92.   
      93. 事件的监听   
      94.   
      95.     
      96.   
      97. IE支持的事件都定义在DWebEvents2接口中,如下:   
      98.   
      99.   DWebBrowserEvents2 = dispinterface   
      100.     ['{34A715A0-6587-11D0-924A-0020AFC7AC4D}']   
      101.     procedure StatusTextChange(const Text: WideString); dispid 102;   
      102.     procedure ProgressChange(Progress: Integer; ProgressMax: Integer); dispid 108;   
      103.     procedure CommandStateChange(Command: Integer; Enable: WordBool); dispid 105;   
      104.     procedure DownloadBegin; dispid 106;   
      105.     procedure DownloadComplete; dispid 104;   
      106.     procedure TitleChange(const Text: WideString); dispid 113;   
      107.     procedure PropertyChange(const szProperty: WideString); dispid 112;   
      108. procedure BeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var Flags:   
      109.  OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant;                                  
      110. var Headers: OleVariant; var Cancel: WordBool); dispid 250;   
      111.     procedure NewWindow2(var ppDisp: IDispatch; var Cancel: WordBool); dispid 251;   
      112.     procedure NavigateComplete2(const pDisp: IDispatch; var URL: OleVariant); dispid 252;   
      113.     procedure DocumentComplete(const pDisp: IDispatch; var URL: OleVariant); dispid 259;   
      114.     procedure OnQuit; dispid 253;   
      115.     procedure OnVisible(Visible: WordBool); dispid 254;   
      116.     procedure OnToolBar(ToolBar: WordBool); dispid 255;   
      117.     procedure OnMenuBar(MenuBar: WordBool); dispid 256;   
      118.     procedure OnStatusBar(StatusBar: WordBool); dispid 257;   
      119.     procedure OnFullScreen(FullScreen: WordBool); dispid 258;   
      120.     procedure OnTheaterMode(TheaterMode: WordBool); dispid 260;   
      121.   end;   
      122.     
      123.   
      124. 可以看到每个事件中的后面都有一个dispid关键加上数字如 258 ,260等等。Dispid的数字就是事件类型的标识符号。IDispatch的Invoke方法定义如下:   
      125.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;   
      126. Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;   
      127.   
      128. 当IE调用Invoke方法时,会设定DispId参数为事件的标识符号,这样我们就可以知道IE发生了什么事件。对于要实现 的阻断广告窗口弹出来说,我们只需关心BeforeNavigate2和OnQuit事件就可以了,因为当广告窗口弹出前,会激发 IE的BeforeNavigate2事件,而弹出式窗口一般没有工具条,所以只要BeforeNavigate2事件中判断当前页面是否有 工具条就可以判断是否是弹出窗口,并予以禁止。而当IE退出时,会激发OnQuit事件,在OnQuit事件中应该断开事件 监听,同时清理分配的资源。下面就是截获BeforeNavigate2和OnQuit事件的Invoke方法的实现:   
      129.   
      130. procedure BuildPositionalDispIds(pDispIds: PDispIdList; const dps: TDispParams);   
      131. var  
      132.   i: integer;   
      133. begin  
      134.   Assert(pDispIds <> nil);   
      135.   for i := 0 to dps.cArgs - 1 do  
      136.     pDispIds^[i] := dps.cArgs - 1 - i;   
      137.   if (dps.cNamedArgs <= 0then  
      138.     Exit;   
      139.   for i := 0 to dps.cNamedArgs - 1 do  
      140.     pDispIds^[dps.rgdispidNamedArgs^[i]] := i;   
      141. end;   
      142.     
      143.   
      144. function TTIEAdvBHO.Invoke(DispID: Integer; const IID: TGUID;   
      145.   LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,   
      146.   ArgErr: Pointer): HResult;   
      147. var  
      148.   dps: TDispParams absolute Params;   
      149.   bHasParams: boolean;   
      150.   pDispIds: PDispIdList;   
      151.   iDispIdsSize: integer;   
      152. begin  
      153.   pDispIds := nil;   
      154.   iDispIdsSize := 0;   
      155.   bHasParams := (dps.cArgs > 0);   
      156.   if (bHasParams) then  
      157.   begin  
      158.     iDispIdsSize := dps.cArgs * SizeOf(TDispId);   
      159.     GetMem(pDispIds, iDispIdsSize);   
      160.   end;   
      161.   try  
      162.     if (bHasParams) then  
      163.       BuildPositionalDispIds(pDispIds, dps);   
      164.     Result := S_OK;   
      165.     case DispId of  
      166.       250://BeforeNaviage2事件id  
      167.         begin  
      168.           DoBeforeNavigate2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),   
      169.               POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^,   
      170.               POleVariant(dps.rgvarg^[pDispIds^[2]].pvarval)^,   
      171.               POleVariant(dps.rgvarg^[pDispIds^[3]].pvarval)^,   
      172.               POleVariant(dps.rgvarg^[pDispIds^[4]].pvarval)^,   
      173.               POleVariant(dps.rgvarg^[pDispIds^[5]].pvarval)^,   
      174.               dps.rgvarg^[pDispIds^[6]].pbool^);   
      175.         end;   
      176.       253://OnQuit事件ID  
      177.         begin  
      178.           FCP.Unadvise(FCookie);   
      179.         end;   
      180.     else  
      181.       Result := DISP_E_MEMBERNOTFOUND;   
      182.     end;   
      183.   finally  
      184.     if (bHasParams) then  
      185.       FreeMem(pDispIds, iDispIdsSize);   
      186.   end;   
      187. end;   
      188.     
      189.   
      190. 在Invoke方法中,Params参数包含了被激发的事件包含的参数的数目以及参数的值,而BuildPositionalDispIds 则从Params参数中提取参数值,并放到数组中,然后在BeforeNavigate2事件中,调用DoBeforeNavigate2过程对 事件进行处理,事件参数作为过程参数被传递过去,下面是具体禁止弹出网页的DoBeforeNavigate2的处理过程:   
      191.   
      192. procedure TTIEAdvBHO.DoBeforeNavigate2(const pDisp: IDispatch; var URL,   
      193.   Flags, TargetFrameName, PostData, Headers: OleVariant;   
      194.   var Cancel: WordBool);   
      195. begin  
      196.   if FIE.ToolBar=0 then FIE.Quit;   
      197. end;   
      198.     
      199.   
      200. 在过程中,首先,调用IWebBrowser2接口的Toolbar属性判断页面是否有工具条,如果没有,则调用IE的退出方法关闭弹出窗口。另外在Invoke中还在OnQuit事件激发时,调用事件连接点的UnAdvise方法,断开事件监听。   
      201.   
      202.  注册扩展   
      203.   
      204.  注册扩展非常简单,只要在注册表中关键字HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion   
      205. \explorer\Browser Helper Objects\下添加值为扩展的Guid的字符串形式的下级关键字就可以了。   
      206.   
      207.  type  
      208.   
      209.   TIEAdvBHOFactory = class(TComObjectFactory)   
      210.   public  
      211.     procedure UpdateRegistry(Register: Boolean); override;   
      212.   end;   
      213.     
      214. { TIEAdvBHOFactory }  
      215.     
      216. procedure TIEAdvBHOFactory.UpdateRegistry(Register: Boolean);   
      217. begin  
      218.   inherited;   
      219.   if Register then  
      220.     CreateRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\'                       + GuidToString(ClassID), '', '') 
      221.   else 
      222.     DeleteRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\'                       + GuidToString(ClassID), ''); 
      223. end; 
      224.   
      225. initialization 
      226.   TIEAdvBHOFactory.Create(ComServer, TTIEAdvBHO, Class_TIEAdvBHO, 
      227.     'TIEAdvBHO', '', ciMultiInstance, tmApartment);   
      228. end.   
      229.     
      230.   
      231. 注册扩展后,打开浏览器浏览新浪网站(http://www.sina.com.cn),你会发现平时讨厌的弹出广告窗口都消失了。  
      232.   
      233. 文章来源:http://delphi.sharpplus.com/Delphi/bho.htm  

      标签: delphi, 浏览器, 插件, bho

    • 当前暂无评论 »

      • 发表评论: ( 注意:为了防止广告评论,本站链接已经启用nofollow)
      •   您的名字
      •   E-mail
      •   您的网址(选填)

Powered by Typecho)))   ICP:蜀ICP备05009250号