Перенаправление TWebBrowser на кастомный URL

Delphi , Интернет и Сети , URL

Иногда может возникнуть необходимость перенаправить TWebBrowser на кастомный URL при нажатии на определенную ссылку. Например, вы хотите, чтобы при нажатии на ссылку "FAQ" на странице StackOverflow пользователь переходил на страницу MathStackExchange, а не на внутреннюю страницу FAQ StackOverflow.

Оригинальный вопрос:

1. Навигация к http://www.stackoverflow.com с помощью TWebBrowser.
2. Есть ссылка "FAQ" в верхней панели, которая ведет на https://stackoverflow.com/faq.
3. Нужно перенаправить пользователя, например, на http://math.stackexchange.com при нажатии на ссылку "FAQ".

Альтернативный ответ:

Можно использовать событие OnBeforeNavigate2 TWebBrowser для достижения этого. Вот пример кода:

procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  if URL = 'https://stackoverflow.com/faq' then
  begin
    // Устанавливаем этот флаг в True, чтобы отменить текущую навигацию
    Cancel := True;

    // Меняем этот параметр, который уже объявлен
    URL := 'http://math.stackexchange.com';

    // Останавливаем все текущие навигации и динамические элементы страницы
    (pDisp as IWebBrowser2).Stop;

    // И переходим на целевой URL
    (pDisp as IWebBrowser2).Navigate2(URL, Flags, TargetFrameName, PostData, Headers);
  end;
end;

Подтвержденный ответ:

Другой способ - использовать интерфейс IDocHostUIHandler и метод TranslateUrl. Для этого нужно создать класс, унаследовав его от TWebBrowser и реализовав интерфейс IDocHostUIHandler. Вот пример кода:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SHDocVw, ActiveX, StdCtrls, OleCtrls;

type
  PDocHostUIInfo = ^TDocHostUIInfo;
  TDocHostUIInfo = record
    cbSize: ULONG;
    dwFlags: DWORD;
    dwDoubleClick: DWORD;
  end;

  // Описание интерфейса IDocHostUIHandler...
  IDocHostUIHandler = interface(IUnknown)
    ['{BD3F23C0-D43E-11CF-893B-00AA00BDCE1A}']
    // Описание методов интерфейса...
  end;

  TWebBrowser = class(SHDocVw.TWebBrowser, IDocHostUIHandler)
  private
    // Реализация методов интерфейса IDocHostUIHandler...
  end;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TWebBrowser.ShowContextMenu(const dwID: DWORD; const ppt: PPoint;
  const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.GetHostInfo(var pInfo: TDocHostUIInfo): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
  const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
  const pDoc: IOleInPlaceUIWindow): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.HideUI: HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.UpdateUI: HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.EnableModeless(const fEnable: BOOL): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.OnDocWindowActivate(const fActivate: BOOL): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.OnFrameWindowActivate(const fActivate: BOOL): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.ResizeBorder(const prcBorder: PRect;
  const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.TranslateAccelerator(const lpMsg: PMSG;
  const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.GetOptionKeyPath(var pchKey: POleStr; const dw: DWORD): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.GetDropTarget(const pDropTarget: IDropTarget;
  out ppDropTarget: IDropTarget): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.GetExternal(out ppDispatch: IDispatch): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowser.TranslateUrl(const dwTranslate: DWORD;
  const pchURLIn: POleStr; var ppchURLOut: POleStr): HRESULT;
begin
  // pchURLIn - URL, на который хочет перейти браузер
  // ppchURLOut - URL, на который будет перенаправлен браузер

  if pchURLIn = 'https://stackoverflow.com/faq' then
    ppchURLOut := 'http://math.stackexchange.com';

  Result := S_OK;
end;

function TWebBrowser.FilterDataObject(const pDO: IDataObject;
  out ppDORet: IDataObject): HRESULT;
begin
  Result := E_NOTIMPL;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Navigate('http://www.stackoverflow.com');
end;

end.

В этом примере, при нажатии на ссылку "FAQ", которая ведет на https://stackoverflow.com/faq, пользователь будет перенаправлен на http://math.stackexchange.com.

Создано по материалам из источника по ссылке.

'Перенаправление TWebBrowser на кастомный URL при нажатии на определенную ссылку, например, при нажатии на ссылку 'FAQ' на странице StackOverflow перенаправить пользователя на страницу MathStackExchange, а не на внутреннюю страницу FAQ

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: URL ::