Delphi TWebBrowser：如何停止重定向到新窗口

Question

我遇到TWebBrowser组件与重定向有关的问题。以下是显示Google图片搜索的代码。代码运行时，用户会在下面显示链接的缩略图：“查找此图像的其他尺寸”。如果您点击该链接，则会显示匹配的图片。 “访问网页”和“查看图片”：如果用户随后对图像的一个点击，浏览器会在窗口的中间这给两个按钮的用户访问显示扩大黑带

在这里问题开始。如果我点击了“查看图片”按钮，这个程序将启动Internet Explorer窗口显示消息：

重定向通知

的网页试图将你...

如何停止这个？我不希望一个IE窗口突然出现在我的Delphi应用程序上，我也不想让这个“重定向通知”出现。我希望重定向出现在触发重定向的主窗体的TWebBrowser中。

Unit Unit1; 

interface 

uses 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw, 
    urlmon; 

type 
    TForm1 = class(TForm) 
    WebBrowser1: TWebBrowser; 
    procedure FormCreate(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
var 
    UserAgent : AnsiString; 
begin 
    UserAgent := 'Mozilla/5.0 (compatible, MSIE 11, Windows NT 6.3; Trident/7.0; rv:11.0) like Gecko'; 
    UrlMkSetSessionOption(URLMON_OPTION_USERAGENT, PChar(UserAgent), Length(UserAgent)+1, 0); 
    WebBrowser1.navigate('http://images.google.com/searchbyimage?site=search&image_url=https://www.google.com/images/branding/googlelogo/2x/googlelogo_color_116x41dp.png'); 
end; 

end. 

Answer 1

这里是一个简单的例子来说明如何处理弹出窗口。 您需要考虑到您需要处理其他事件（例如OnWindowSetWidth和OnWindowSetHeight以设置正确的窗口大小。我还删除了您的useragent代码，因为ActiveX浏览器仍将处于IE7模式。您必须设置FEATURE_BROWSER_EMULATION标志将浏览器设置为正确模式 如果您希望在同一浏览器中弹出，您仍然需要创建一个弹出窗口并使用OnBeforeNavigate2事件来捕获重定向Url请注意，这种工作方式具有破坏性并可能会中断网站，在弹出的窗口取决于调用窗口上。

Unit Unit1; 

interface 

uses 
    Winapi.Windows, 
    Winapi.Messages, 
    Generics.Collections, 
    System.SysUtils, 
    System.Variants, 
    System.Classes, 
    Vcl.Controls, 
    Vcl.Dialogs, 
    Vcl.Forms, 
    Vcl.OleCtrls, 
    SHDocVw, 
    MsHtml, 
    Registry, 
    urlmon, Vcl.StdCtrls; 

type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    WebBrowser1: TWebBrowser; 
    procedure FormCreate(Sender: TObject); 
    procedure WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); 
    procedure FormDestroy(Sender: TObject); 
    procedure WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData, 
     Headers: OleVariant; var Cancel: WordBool); 
    private 
    { Private declarations } 
    IsPopup : Boolean; 
    Popups : TObjectList<TForm1>; 
    public 
    { Public declarations } 
    constructor CreatePopup; 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure EmbeddedWebbrowserMode(Mode: Integer); 

const 
    FEATURE_KEY = 'Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION'; 

var 
    AppName: string; 
    Reg: TRegistry; 

begin 
AppName := ExtractFileName(Application.ExeName); 
Reg := TRegistry.Create(); 
try 
    Reg.RootKey := HKEY_CURRENT_USER; 
    if Reg.OpenKey(FEATURE_KEY, False) then 
    begin 
    Reg.WriteInteger(AppName, Mode); 
    Reg.CloseKey; 
    end; 
finally; 
    Reg.Free; 
end; 
end; 

constructor TForm1.CreatePopup; 
begin 
IsPopup := True; 
inherited Create(nil); 
end; 

procedure TForm1.FormCreate(Sender: TObject); 

var 
    UserAgent : AnsiString; 
    Url : string; 

begin 
Popups := TObjectList<TForm1>.Create; 
if IsPopup then 
    Exit; 
EmbeddedWebbrowserMode(11000); 
Url := 'http://images.google.com/searchbyimage?site=search&image_url=https://www.google.com/images/branding/googlelogo/2x/googlelogo_color_116x41dp.png'; 
WebBrowser1.navigate(Url); 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
Popups.Free; 
end; 

procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData, 
    Headers: OleVariant; var Cancel: WordBool); 
begin 
if IsPopup then 
    begin 
    Cancel := True; 
    Close; 
    Form1.WebBrowser1.Navigate(Url); 
    end; 
end; 

procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); 

var 
    Popup : TForm1; 

begin 
Popup := TForm1.CreatePopup; 
Popups.Add(Popup); 
Popup.Visible := False; 
ppDisp := Popup.WebBrowser1.DefaultInterface; 
end; 

end. 

Answer 2

我发现了这需要你更简单的解决方案，只需添加一个第二TWebBrowser组件到你的主窗体：

procedure TMainForm.WebBrowser1NewWindow2(Sender: TObject; 
var ppDisp: IDispatch; var Cancel: WordBool); 
begin 
    ppDisp := WebBrowser2.DefaultDispatch; 
end; 

procedure TMainForm.WebBrowser2BeforeNavigate2(Sender: TObject; 
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, 
Headers: OleVariant; var Cancel: WordBool); 
begin 
    Cancel := True; 
    ShowMessage('Here´s the URL: '+URL); 
    WebBrowser1.Navigate(URL); 
end;