用delphi开发阻断弹出式广告的BHO

BHO实际上也是一个简单的IE扩展COM组件,它和其它COM组件的区别就在于其它扩展需要一些用户的手工操作,如点击菜单,点击工具条按钮,在地址栏输入 网址等等触发动作才会被IE加载。


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


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



创建COM组件

       新建一个ActiveX Library,保存为IEBHO.dpr,然后新建一个名为TIEAdvBHO的COM Object,然后保存生成的文件为CIEBHO.pas,作为BHO扩展,需要实现两 个接口IObjectWithSite和IDispatch,其中 IObjectWithSite接口同前面的工具条扩展一样可以用来获得浏览器的接口,而IDispatch接口,则被用来监听浏览器的事件。



下面就是BHO扩展的类定义:

type

  TTIEAdvBHO = class(TComObject, IObjectWithSite, IDispatch)

  private

    FIESite: IUnknown;

    FIE: IWebBrowser2;

    FCPC: IConnectionPointContainer;

    FCP: IConnectionPoint;

    FCookie: Integer;

  protected

    //IObjectWithSite接口方法定义

    function SetSite(const pUnkSite: IUnknown): HResult; stdcall;

    function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;


    //IDispatch接口方法定义

    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;


    //阻断广告弹出事件处理过程

    procedure DoNewWindow2(var ppDisp: IDispatch; var Cancel: WordBool);

    procedure DoBeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant;var Headers: OleVariant; var Cancel: WordBool);

end;

 

IObjectWithSite的接口的实现

 

先看IObjectWithSite的接口的实现,当IE加载BHO扩展后,会调用BHO的扩展,把自身的IUnknown接口作为参数pUnkSite传给扩展,BHO扩展应该从pUnkSite参数中获得浏览器接口IWebBrowser2,同时为了监听浏览器的事件,还需要获得事件链接点接口,IE的支持的事件都定义在DWebBrowserEvents2的双接口中,使用链接点的Advise方法建立对IE事件的监听


注意Advise方法调用后 会返回一个Cookie,需要保存Cookie,后面在退出IE时,需要Cookie作为参数来断开对IE事件的监听。


function TTIEAdvBHO.SetSite(const pUnkSite: IInterface): HResult;

begin

  Result := E_FAIL;


  //保存接口

  FIESite := pUnkSite;

  if not Supports(FIESite, IWebBrowser2, FIE) then

     Exit;


  //获得事件连接点

  if not Supports(FIE, IConnectionPointContainer, FCPC) then

    Exit;


  FCPC.FindConnectionPoint(DWebBrowserEvents2, FCP);


  //监听事件

  FCP.Advise(Self, FCookie);


  Result := S_OK;

end;


后面IE有时会调用IObjectWithSite接口的GetSite方法获得需要的接口,这时可以将保存的接口返回。

function TTIEAdvBHO.GetSite(const riid: TIID;

  out site: IInterface): HResult;

begin

  if Supports(FIESite, riid,site) then

    Result := S_OK

  else

    Result:= E_NOINTERFACE;

end;

 

IDispatch接口的实现

 

前面我们在SetSite中建立了对IE事件的监听,建立事件监听后每当IE产生了新的事件,它就会调用扩展的IDispatch接口的Invoke方法通知扩展发生的事件类型以及事件参数,并请求扩展对事件进行处理。


因此对于BHO扩展来说,IDispatch接口的Invoke方法是必须实现的,而其它的GetTypeInfoCount,GetTypeInfo和GetIDsOfNames方法都无须实现,只要返回结果为E_NOTIMPL,表示未实现该方法就可以了。

 

function TTIEAdvBHO.GetIDsOfNames(const IID: TGUID; Names: Pointer;

  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;

begin

  Result := E_NOTIMPL;

end;

 

function TTIEAdvBHO.GetTypeInfo(Index, LocaleID: Integer;

  out TypeInfo): HResult;

begin

  Result := E_NOTIMPL;

  pointer(TypeInfo) := nil;

end;

 

function TTIEAdvBHO.GetTypeInfoCount(out Count: Integer): HResult;

begin

  Result := E_NOTIMPL;

  Count := 0;

end;

 

事件的监听

 

IE支持的事件都定义在DWebEvents2接口中,如下:

  DWebBrowserEvents2 = dispinterface

    ['{34A715A0-6587-11D0-924A-0020AFC7AC4D}']

    procedure StatusTextChange(const Text: WideString); dispid 102;

    procedure ProgressChange(Progress: Integer; ProgressMax: Integer); dispid 108;

    procedure CommandStateChange(Command: Integer; Enable: WordBool); dispid 105;

    procedure DownloadBegin; dispid 106;

    procedure DownloadComplete; dispid 104;

    procedure TitleChange(const Text: WideString); dispid 113;

    procedure PropertyChange(const szProperty: WideString); dispid 112;

    procedure BeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var Flags:

       OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant;                               

       var Headers: OleVariant; var Cancel: WordBool); dispid 250;

    procedure NewWindow2(var ppDisp: IDispatch; var Cancel: WordBool); dispid 251;

    procedure NavigateComplete2(const pDisp: IDispatch; var URL: OleVariant); dispid 252;

    procedure DocumentComplete(const pDisp: IDispatch; var URL: OleVariant); dispid 259;

    procedure OnQuit; dispid 253;

    procedure OnVisible(Visible: WordBool); dispid 254;

    procedure OnToolBar(ToolBar: WordBool); dispid 255;

    procedure OnMenuBar(MenuBar: WordBool); dispid 256;

    procedure OnStatusBar(StatusBar: WordBool); dispid 257;

    procedure OnFullScreen(FullScreen: WordBool); dispid 258;

    procedure OnTheaterMode(TheaterMode: WordBool); dispid 260;

  end;

 

可以看到每个事件中的后面都有一个dispid关键加上数字如 258 ,260等等。Dispid的数字就是事件类型的标识符号。IDispatch的Invoke方法定义如下:


    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;

             Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;


当IE调用Invoke方法时,会设定DispId参数为事件的标识符号,这样我们就可以知道IE发生了什么事件。


对于要实现 的阻断广告窗口弹出来说,我们只需关心BeforeNavigate2和OnQuit事件就可以了,因为当广告窗口弹出前,会激发 IE的BeforeNavigate2事件,而弹出式窗口一般没有工具条,所以只要BeforeNavigate2事件中判断当前页面是否有 工具条就可以判断是否是弹出窗口,并予以禁止。


而当IE退出时,会激发OnQuit事件,在OnQuit事件中应该断开事件 监听,同时清理分配的资源。


下面就是截获BeforeNavigate2和OnQuit事件的Invoke方法的实现:


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 TTIEAdvBHO.Invoke(DispID: Integer; const IID: TGUID;

  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,

  ArgErr: Pointer): HResult;

var

  dps: TDispParams absolute Params;

  bHasParams: boolean;

  pDispIds: PDispIdList;

  iDispIdsSize: integer;

begin

  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);


    Result := S_OK;

    case DispId of

      250://BeforeNaviage2事件id

        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^);

        end;

      253://OnQuit事件ID

        begin

          FCP.Unadvise(FCookie);

        end;

    else

      Result := DISP_E_MEMBERNOTFOUND;

    end;

  finally

    if (bHasParams) then

      FreeMem(pDispIds, iDispIdsSize);

  end;

end;

 

在Invoke方法中,Params参数包含了被激发的事件包含的参数的数目以及参数的值,

而BuildPositionalDispIds 则从Params参数中提取参数值,并放到数组中,

然后在BeforeNavigate2事件中,调用DoBeforeNavigate2过程对 事件进行处理,事件参数作为过程参数被传递过去,


下面是具体禁止弹出网页的DoBeforeNavigate2的处理过程:

procedure TTIEAdvBHO.DoBeforeNavigate2(const pDisp: IDispatch; var URL,

  Flags, TargetFrameName, PostData, Headers: OleVariant;

  var Cancel: WordBool);

begin

  if FIE.ToolBar=0 then FIE.Quit;

end;

 

在过程中,首先,调用IWebBrowser2接口的Toolbar属性判断页面是否有工具条,如果没有,则调用IE的退出方法关闭弹出窗口。另外在Invoke中还在OnQuit事件激发时,调用事件连接点的UnAdvise方法,断开事件监听。


 注册扩展


 注册扩展非常简单,只要在注册表中关键字


HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\


下添加值为扩展的Guid的字符串形式的下级关键字就可以了。

 type

  TIEAdvBHOFactory = class(TComObjectFactory)

  public

    procedure UpdateRegistry(Register: Boolean); override;

  end;

 

{ TIEAdvBHOFactory }

 

procedure TIEAdvBHOFactory.UpdateRegistry(Register: Boolean);

begin

  inherited;

  if Register then

    CreateRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\'                       + GuidToString(ClassID), '', '')

  else

    DeleteRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\'                       + GuidToString(ClassID), '');

end;

 

initialization

  TIEAdvBHOFactory.Create(ComServer, TTIEAdvBHO, Class_TIEAdvBHO,

    'TIEAdvBHO', '', ciMultiInstance, tmApartment);

end.

 

注册扩展后,打开浏览器浏览新浪网站(http://www.sina.com.cn),你会发现平时讨厌的弹出广告窗口都消失了。


相关推荐

[!--temp.pl--]