如何將TWebBrowser控件重定向到自定義URL？

Question

例子：

1. 我瀏覽到http://www.stackoverflow.com使用網絡瀏覽器控制
2. 有一個鏈接到最上面一欄常見問題，與目標https://stackoverflow.com/faq
3. 我需要重定向例如到http://math.stackexchange.com當我點擊FAQ鏈接

Answer 1

最簡單的方法，爲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方法的實現。請注意，我使用了插入類，所以如果您將此代碼放入您的單元中，則只有表單上的那些Web瀏覽器或此單元中創建的那些Web瀏覽器纔會出現此行爲。

如果您點擊Button1，您將被導航到http://www.stackoverflow.com，如果您點擊指向https://stackoverflow.com/faq的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.