delphi - TWebBrowserコントロールをカスタムURLにリダイレクトするにはどうすればよいですか？

Question

例：

http://www.stackoverflow.comWebブラウザコントロールで移動します
トップバーにFAQへのリンクがあります。https://stackoverflow.com/faq
http://math.stackexchange.comFAQリンクをクリックしたときなどにリダイレクトする必要があります

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。私は介在クラスを使用したので、このコードをユニットに入れると、フォーム上の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