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;