介绍
随着网络免费的大潮的退去，网站变得越来越商业化。浏览一些常去的网站，每看一个页面都会弹出N多的广告窗口，而且都是花花绿绿的Flash和Gif小动画,浪费带宽（我在家还是拨号上网），同时干扰了正常的阅读，非常讨厌。那么如何才能将这些广告屏蔽掉呢？答案就是Browser Helper Object(简称BHO)。
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) thenExit; //获得事件连接点 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)，你会发现平时讨厌的弹出广告窗口都消失了。
