如何将TWebBrowser控件重定向到自定义URL？ [英] How do I redirect the TWebBrowser control to a custom URL?

问题描述

示例：

1. 我导航到 http://www.stackoverflow.com 与我的网页浏览器控件


2. 有一个链接到常见问题在顶部的酒吧，目标 http://stackoverflow.com/faq


3. 我需要重定向到 http://math.stackexchange.com 时，点击常见问题链接

1. I navigate to http://www.stackoverflow.com with my web browser control
2. there's a link to FAQ in the top bar, with target http://stackoverflow.com/faq
3. I need to redirect e.g. to the http://math.stackexchange.com when I click the FAQ link

推荐答案

最简单的方法，如 kobik 建议使用 TWebBrowser.OnBeforeNavigate2 事件。这里是一个例子。

The easiest way, as kobik suggested is to use TWebBrowser.OnBeforeNavigate2 event. Here is the example.

procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  if URL = 'http://stackoverflow.com/faq' then
  begin
    // setting this flag to True will cancel the current navigation
    Cancel := True;

    // changing this declared parameter doesn't affect anything
    // I've used it just because it's already declared
    URL := 'http://math.stackexchange.com';

    // interrupt all pending navigations and stop dynamic page elements
    (pDisp as IWebBrowser2).Stop;

    // and navigate to the target URL
    (pDisp as IWebBrowser2).Navigate2(URL, Flags, TargetFrameName, PostData, Headers);
  end;
end;

还有另一个更复杂的方法如何实现相同。这是关于使用 IDocHostUIHandler 界面。除了控制菜单和工具栏的可见性，上下文菜单配置及其提供的一些事件之外，还有一个重定向功能。

There's another, more complicated method how to achieve the same. It's about using the IDocHostUIHandler interface. Except the control of the menus and toolbars visibility, context menu configuration and some events it provides, let's say, the redirect capability.

更具体地说，它是 IDocHostUIHandler.TranslateUrl 方法。此方法使主机可以修改要加载的URL。如果需要，它会暴露网页浏览器控件要导航的输入网址和重定向的输出网址。

To be more specific, it's the IDocHostUIHandler.TranslateUrl method. This method enables the host to modify the URL to be loaded. It exposes the input URL where the web browser control is going to navigate and the output URL where you redirect it, if you want.

以下示例显示了 IDocHostUIHandler.TranslateUrl 方法。请注意，我已经使用了插入的类，所以如果你把这个代码放在你的单位，只有表单上的网页浏览器或这个单位中创建的网页浏览器会动态地获得这个行为。

The following example shows the implementation of the IDocHostUIHandler.TranslateUrl method. Please note that I've used the interposed class so if you put this code into your unit, only those web browsers on the form or those created in this unit dynamically will get this behavior.

如果您点击Button1，您将被导航到 http://www.stackoverflow.com ，如果您点击定向到 http：// stackoverflow的常见问题解答链接。 com / faq ，您将被重定向到 http：//math.stackexchange .com 。

If you click on the Button1 you'll be navigated to the http://www.stackoverflow.com and if you click on the FAQ link which is directed to the http://stackoverflow.com/faq you'll be redirected to the http://math.stackexchange.com.

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;

// *********************************************************************//
// Interface: IDocHostUIHandler
// Flags:     (0)
// GUID:      {BD3F23C0-D43E-11CF-893B-00AA00BDCE1A}
// *********************************************************************//
  IDocHostUIHandler = interface(IUnknown)
    ['{BD3F23C0-D43E-11CF-893B-00AA00BDCE1A}']
    function ShowContextMenu(const dwID: DWORD; const ppt: PPoint;
      const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT; stdcall;
    function GetHostInfo(var pInfo: TDocHostUIInfo): HRESULT; stdcall;
    function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
      const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
      const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
    function HideUI: HRESULT; stdcall;
    function UpdateUI: HRESULT; stdcall;
    function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
    function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function ResizeBorder(const prcBorder: PRect; const pUIWindow: IOleInPlaceUIWindow;
      const fRameWindow: BOOL): HRESULT; stdcall;
    function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
      const nCmdID: DWORD): HRESULT; stdcall;
    function GetOptionKeyPath(var pchKey: POleStr; const dw: DWORD): HRESULT; stdcall;
    function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT; stdcall;
    function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
    function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POleStr; var ppchURLOut: POleStr): HRESULT; stdcall;
    function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
  end;

  TWebBrowser = class(SHDocVw.TWebBrowser, IDocHostUIHandler)
  private
    function ShowContextMenu(const dwID: DWORD; const ppt: PPoint;
      const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT; stdcall;
    function GetHostInfo(var pInfo: TDocHostUIInfo): HRESULT; stdcall;
    function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
      const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
      const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
    function HideUI: HRESULT; stdcall;
    function UpdateUI: HRESULT; stdcall;
    function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
    function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function ResizeBorder(const prcBorder: PRect; const pUIWindow: IOleInPlaceUIWindow;
      const fRameWindow: BOOL): HRESULT; stdcall;
    function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
      const nCmdID: DWORD): HRESULT; stdcall;
    function GetOptionKeyPath(var pchKey: POleStr; const dw: DWORD): HRESULT; stdcall;
    function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT; stdcall;
    function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
    function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POleStr; var ppchURLOut: POleStr): HRESULT; stdcall;
    function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
  end;

type
  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 is the URL where the browser is going to navigate
  // ppchURLOut is the URL where the browser will navigate

  if pchURLIn = 'http://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.

这篇关于如何将TWebBrowser控件重定向到自定义URL？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！