All geek questions in one place

How to redirect a TWebBrowser control to a custom URL?

Example:

+4
source share
1 answer

The easiest way: kobik is to use TWebBrowser.OnBeforeNavigate2 . Here is an example.

 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 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;

There is another, more complicated method, how to achieve the same. This is about using the IDocHostUIHandler interface. In addition to controlling the visibility of menus and toolbars, setting the context menu and some of the events that it provides, say, the possibility of redirection.

To be more specific, this is the IDocHostUIHandler.TranslateUrl method. This method allows the host to change the download URL. It provides the input URL where the web browser control will be moved, and the output URL to which you redirect it if you want.

The following example shows an implementation of the IDocHostUIHandler.TranslateUrl method. Keep in mind that I used a dedicated class, so if you put this code in your block, this will only result in those web browsers in the form or created in this module.

If you click Button1, you will go to http://www.stackoverflow.com and if you click on the frequently asked questions link, which is directed to https://stackoverflow.com/faq , you will be redirected to 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.
+8
source

Source: https://habr.com/ru/post/1387236/

More articles:


All Articles