★如何防止弹出网页窗口

Question

前几天写了一个IE的TOOLBAR，用到了IWebbrowser2,TOOLBAR的功能太少，想加一个类似Gogle的工具栏的屏蔽网页弹出的功能，用Delphi如何实现呢？

Answer 1

procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
↑加到{Private declaration}procedure TForm1.WMActivate(var Msg: TWMActivate);
var
  S: String;
  wnd: HWND;
  I: Integer;
begin
  If Msg.Active=0 then
  begin
    wnd := Msg.ActiveWindow;
    I := GetWindowTextLength(wnd);
    SetLength(S, I + 1);
    //the text of the specified window's title bar
    GetWindowText(Wnd, PChar(S), I + 1);
    If Pos('Internet Explorer', S) > 0 then
      Sendmessage(wnd,WM_CLOSE,0,0);
  end;
end;説明：此方法可屏蔽「Internet Explorer」框的出現、不知是不是你要的?

Answer 2

哦，以前电脑爱好者上给出一个方法是检查弹出窗口的属性或者标题，如果满足一定条件就关闭之，很好的。你去它的网站找找提供source了的

Answer 3

我有BHO源码，新建IE窗口前都会通知它，你可通过它屏蔽广告窗口或其它的窗口，邮箱地址是什么，发给你

Answer 4

procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
↑加到{Private declaration}procedure TForm1.WMActivate(var Msg: TWMActivate);
var
  S: String;
  wnd: HWND;
  I: Integer;
begin
  If Msg.Active=0 then
  begin
    wnd := Msg.ActiveWindow;
    I := GetWindowTextLength(wnd);
    SetLength(S, I + 1);
    //the text of the specified window's title bar
    GetWindowText(Wnd, PChar(S), I + 1);
    If Pos('Internet Explorer', S) > 0 then
      Sendmessage(wnd,WM_CLOSE,0,0);
  end;
end;説明：此方法可屏蔽「Internet Explorer」框的出現、不知是不是你要的?

Answer 5

我能做的只是通过一外部程序来屏蔽广告：
{--- 功能：---}
1.屏蔽广告。
2.屏蔽Flash动画，以及浮动在页面里的Flash动画。
{--- 原理：---}
1.广告窗口的WorkerW类和Shell DocObject View类的rect.top的值是相同的;
2.正常IE窗口的WorkerW类和Shell DocObject View类的rect.top的值是不相同的;
{--- 运行环境： ---}
1.Delphi7.0 + WinXP。
2.采用VC自带的SPY++查看窗口类名。 
//////////////////////////// 2004-9-10 by hottey  ////////////////////////////
//
program Kill;uses
  Windows;const
  WM_CLOSE = $0010;var
  {--- 定时器ID ---}
  iTimerID: integer;
  MSg: TMsg;
  {--- 初始为0，表明从第一个窗口开始查找 ---}
  Next: HWND = 0;////定时器回调函数
function Killer(hWd: HWND; umsg: UINT; iTimerID: UINT; dwTime: DWORD):LRESULT;var
  reca, recb: TRect;
  IehWnd, WorkerW, View, Flash: HWND;
begin
  Result := 0;
  ｛--- 寻找类名为'IEFrame'的IE窗口，从Next=0开始查找 ---｝
  IehWnd := FindWindowEx(0, Next, 'IEFrame', nil);
  if IehWnd <> 0 then
  begin
    WorkerW:= FindWindowEx(IehWnd, 0, 'WorkerW', nil);
    View:= FindWindowEx(IehWnd, 0, 'Shell DocObject View', nil);
    {--- Flash为网页上Flash动画的句柄 ---}
    Flash := FindWindowEx(GetWindow(View, GW_CHILD), 0, 'MacromediaFlashPlayer
ActiveX', nil);
    if Flash <> 0 then
    {--- 关闭网页上所有的Flash动画---}
      PostMessage(Flash, WM_CLOSE, 0, 0);
    {--- 判断WorkerW和Shell DocObject View的rect.top的值，相等则表明此IE窗口为
广告窗口 ---}
    Windows.GetWindowRect(WorkerW, reca);
    Windows.GetWindowRect(View, recb);
    if (reca.Top = recb.Top) then
    {--- 关闭广告窗口 ---}
        PostMessage(IehWnd, WM_CLOSE, 0, 0)
    else
    {--- IehWnd不是广告窗口，则从IehWnd这个窗口后继续查找(Next := IehWnd) ---}      Next := IehWnd;
  end else
    {--- 桌面上若无IE窗口则将Next清0，方便下次查找 ---}
    Next := 0;
end;///程序开始
begin
  ｛--- 设置定时器,Killer是它的回调函数 ---｝
  iTimerID := SetTimer(0, 0, 100, @Killer);
  MessageBox(0,'广告杀手已经启动','提示：',0);
  ｛--- 消息循环 ---｝
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end.///程序最后应该杀死定时器  KillTimer(0, iTimerID); 
///本例中没有这样做:-P
///问：本来我用SPY++查看时广告窗口和正常IE窗口的IEFrame类(即主窗口)的
///Client Rect的Left 和 Top值应该不一样的，广告{3,29}－IE{4,30}但用
///GetClientRect()；函数得到的却是广告{0,0}－IE{0,0}...无奈啊…………

Answer 6

fei19790920(饭桶的马甲（抵制日货）) 大哥：
ＢＨＯ源码我要啊！发给在下一份好吗？
[email protected]

Answer 7

应该是禁止javascript弹出的窗口吧

Answer 8

fei19790920(饭桶的马甲（抵制日货）)谢谢，

Answer 9

功能就是类似gogle,3721,百度的工具栏上的拦截广告窗口，哪位大侠有代码或者思路提供以下阿，谢谢。

Answer 10

參考<<delphi 深度探索>>II, 比較專業的實現方法

Answer 11

晕，突然发现自己也有这本书，以前倒是忘记看了，贴出来：
//////////////////////////////////CIEBHO.pas///////////////////////////////////
{-----------------------------------------------------------------------------
 Unit Name: CIEBHO
 Author:    hubdog(陈省)
 Email:     [email protected]
 Purpose:   演示如何实现一个可以阻断广告弹出的BHO
 History:
            2003-4-23 创建本单元
-----------------------------------------------------------------------------}unit CIEBHO;{$WARN SYMBOL_PLATFORM OFF}interfaceuses
  Windows, ActiveX, Classes, ComObj, Shdocvw, udbg;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;const
  Class_TIEAdvBHO: TGUID = '{D032570A-5F63-4812-A094-87D007C23012}';implementationuses ComServ, Sysutils, ComConst;{ TTIEAdvBHO }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;procedure TTIEAdvBHO.DoNewWindow2(var ppDisp: IDispatch;
  var Cancel: WordBool);
begin
  //判断页面是否显示完全
//  Debugger.LogMsg('NewWindow2');
//  if FIE.ReadyState<>REFRESH_COMPLETELY then
//  begin
//    //不完全，禁止
//    Cancel:=False;
//    ppDisp:=FIE.Application;
//  end;
end;function TTIEAdvBHO.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;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;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;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
//      251://NEWWINDOW2事件ID
//        begin
//          DoNewWindow2(IDispatch(dps.rgvarg^[pDispIds^[0]].pdispval^),
//              dps.rgvarg^[pDispIds^[1]].pbool^);
//        end;
      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;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;procedure DeleteRegKeyValue(Root: DWORD; Key: string; ValueName: string = '');
var
  KeyHandle: HKEY;
begin
  if ValueName = '' then
    RegDeleteKey(Root, PChar(Key));
  if RegOpenKey(Root, PChar(Key), KeyHandle) = ERROR_SUCCESS then
  try
    RegDeleteValue(KeyHandle, PChar(ValueName));
  finally
    RegCloseKey(KeyHandle);
  end;
end;procedure CreateRegKeyValue(Root: DWORD; const Key, ValueName, Value: string);
var
  Handle: HKey;
  Status, Disposition: Integer;
begin
  Status := RegCreateKeyEx(ROOT, PChar(Key), 0, '',
    REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil, Handle,
    @Disposition);
  if Status = 0 then
  begin
    Status := RegSetValueEx(Handle, PChar(ValueName), 0, REG_SZ,
      PChar(Value), Length(Value) + 1);
    RegCloseKey(Handle);
  end;
  if Status <> 0 then
    raise EOleRegistrationError.CreateRes(@SCreateRegKeyError);
end;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.

Answer 12

//////////////////////////////IEBHO_TLB.pas//////////////////////////////////
unit IEBHO_TLB;// ************************************************************************ //
// WARNING                                                                    
// -------                                                                    
// The types declared in this file were generated from data read from a       
// Type Library. If this type library is explicitly or indirectly (via        
// another type library referring to this type library) re-imported, or the   
// 'Refresh' command of the Type Library Editor activated while editing the   
// Type Library, the contents of this file will be regenerated and all        
// manual modifications will be lost.                                         
// ************************************************************************ //// PASTLWTR : 1.2
// File generated on 2003-4-23 13:01:52 from Type Library described below.// ************************************************************************  //
// Type Lib: C:\Documents and Settings\hubdog.UNIT-LYSOB8L0QB\My Documents\Develop\Delphi\Delphi深度探索二\IE\IEBHO.tlb (1)
// LIBID: {AC166DD1-E716-4ACC-8DAC-CA805486AB5F}
// LCID: 0
// Helpfile: 
// HelpString: IEBHO Library
// DepndLst: 
//   (1) v2.0 stdole, (C:\WINDOWS\System32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interfaceuses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
  // *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:        
//   Type Libraries     : LIBID_xxxx                                      
//   CoClasses          : CLASS_xxxx                                      
//   DISPInterfaces     : DIID_xxxx                                       
//   Non-DISP interfaces: IID_xxxx                                        
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  IEBHOMajorVersion = 1;
  IEBHOMinorVersion = 0;  LIBID_IEBHO: TGUID = '{AC166DD1-E716-4ACC-8DAC-CA805486AB5F}';
implementationuses ComObj;end.

Answer 13

//////////////////////////////////IEBHO.dpr///////////////////////////////////
library IEBHO;uses
  ComServ,
  CIEBHO in 'CIEBHO.pas',
  IEBHO_TLB in 'IEBHO_TLB.pas';exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;{$R *.TLB}{$R *.RES}begin
end.