Delphi TWebBrowser: How to stop redirection to new window

Question

I am having a problem with the TWebBrowser component with regards to redirection. Below is code that displays a Google image search. When the code is run, the user is shown a thumbnail below which is the link: "Find other sizes of this image". If you click that link, you shown matching images. If the user then clicks on one of the images, the browser will display an expanding black band in the middle of the window which gives the user access to two buttons: "Visit page" and "View image":

And here where the problem begins. If I click the "View image" button, this app will launch an Internet Explorer window displaying the message:

Redirect Notice

The previous page is sending you to...

How do I stop this? I do not want an IE window to be popping up over my Delphi app, nor do I want this "Redirect Notice" to appear. I want the redirect to appear in the main form's TWebBrowser that triggered the redirect.

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

I found a much simpler solution which requires you to simply add a second TWebBrowser component to your main form:

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;

Answer 2

Here is a brief example how to handle popups. You need to take into account that you need to handle additional events (like OnWindowSetWidth and OnWindowSetHeight to set the correct window size. I also removed your useragent code, because the ActiveX browser will still be in IE7 mode. You must set the FEATURE_BROWSER_EMULATION flag to set the browser in the correct mode. If you want the popup in the same browser, you still need to create a popup and use the OnBeforeNavigate2 event to catch the redirection Url. Please note that this way of working is disruptive and may break sites where the popup window depends on the calling window.

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.