delphi - 如何将 TWebBrowser 控件重定向到自定义 URL？

Question

例子：

http://www.stackoverflow.com我使用 Web 浏览器控件导航到
顶部栏中有一个指向常见问题解答的链接，带有目标https://stackoverflow.com/faq
http://math.stackexchange.com当我单击常见问题链接时，我需要重定向到例如

score 9 · Accepted Answer

正如kobik建议的那样，最简单的方法是使用TWebBrowser.OnBeforeNavigate2事件。这是示例。

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
    // 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界面的。除了控制菜单和工具栏的可见性、上下文菜单配置和它提供的一些事件，比如说重定向功能。

更具体的说，就是IDocHostUIHandler.TranslateUrl方法。该方法使主机能够修改要加载的 URL。如果需要，它会公开 Web 浏览器控件将要导航的输入 URL 和重定向它的输出 URL。

以下示例显示了该IDocHostUIHandler.TranslateUrl方法的实现。请注意，我使用了 interposed 类，因此如果您将此代码放入您的单元中，则只有表单上的那些 Web 浏览器或在此单元中动态创建的那些 Web 浏览器会获得此行为。

如果您单击 Button1，您将被导航到http://www.stackoverflow.com，如果您单击指向的 FAQ 链接，https://stackoverflow.com/faq您将被重定向到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 = '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.

delphi - 如何将 TWebBrowser 控件重定向到自定义 URL？

1 回答 1

Related

Reference