Modify window.external to enable JS to invoke the Delphi method

Original address: http://hi.baidu.com/rarnu/blog/item/4ec80608022766d663d986ea.html

In JS, there is a special object, window.external, which can invoke the external method provided by the browser.
A very simple example is to add the current page to the Favorites folder
Window.external.addFavorite ("Http://blog.csdn.NET/youthon", " Hong Shi 's blog");
You can write a script like this.
So what if I want to define external myself so that I can use the IE core Browser as a UI container within my own software?
This article resolves this issue.
First, the production of TLB
In File | New | Under the other menu, select Create a new type Library, which is within the ActiveX page.
Then, as shown, create a new interface and create a new Dosearchdata method under the interface, which will need to be added to external in the future.

When you finish adding, click the Save As TLB button and a TLB file will be generated, where I name it getdata.tlb
second, realize IDocHostUIHandler interface
This part is relatively simple, find the relevant C + + code from MSDN, convert it to Delphi. The code is as follows:
Unitdochostuihandler;

Interface
Uses
Windows, ActiveX;
Const
Dochostuiflag_dialog =$00000001;
Dochostuiflag_disable_help_menu =$00000002;
Dochostuiflag_no3dborder =$00000004;
Dochostuiflag_scroll_no =$00000008;
Dochostuiflag_disable_script_inactive = $00000010;
Dochostuiflag_opennewwin =$00000020;
Dochostuiflag_disable_offscreen =$00000040;
Dochostuiflag_flat_scrollbar =$00000080;
Dochostuiflag_div_blockdefault =$00000100;
Dochostuiflag_activate_clienthit_only = $00000200;
Dochostuiflag_overridebehaviorfactory = $00000400;
Dochostuiflag_codepagelinkedfonts =$00000800;
Dochostuiflag_url_encoding_disable_utf8 = $00001000;
Dochostuiflag_url_encoding_enable_utf8 = $00002000;
Dochostuiflag_enable_forms_autocomplete = $00004000;
Dochostuiflag_enable_inplace_navigation = $00010000;
Dochostuiflag_ime_enable_reconversion = $00020000;
Dochostuiflag_theme =$00040000;
Dochostuiflag_notheme =$00080000;
Dochostuiflag_nopics =$00100000;
Dochostuiflag_no3douterborder =$00200000;
Dochostuiflag_disable_edit_ns_fixup = $;
Dochostuiflag_local_machine_access_check =$1;
Dochostuiflag_disable_untrustedprotocol = $;
Dochostuidblclk_default = 0;
Dochostuidblclk_showproperties = 1;
Dochostuidblclk_showcode = 2;
Dochostuitype_browse = 0;
Dochostuitype_author = 1;

Type
Tdochostuiinfo = Record
Cbsize:ulong;
Dwflags:dword;
Dwdoubleclick:dword;
Pchhostcss:pwchar;
Pchhostns:pwchar;
End
Pdochostuiinfo = ^tdochostuiinfo;
IDocHostUIHandler = Interface (IUnknown)
[' {bd3f23c0-d43e-11cf-893b-00aa00bdce1a} ']
Functionshowcontextmenu (const dwid:dword;constppt:ppoint;
Constpcmdtreserved:iunknown;constpdispreserved:idispatch): HResult;
stdcall;
Functiongethostinfo (Var pinfo:tdochostuiinfo): Hresult;stdcall;
Functionshowui (const Dwid:dword;
Constpactiveobject:ioleinplaceactiveobject;
Constpcommandtarget:iolecommandtarget;const Pframe:ioleinplaceframe;
Constpdoc:ioleinplaceuiwindow): Hresult;stdcall;
function Hideui:hresult;stdcall;
function Updateui:hresult;stdcall;
Functionenablemodeless (const fenable:bool): Hresult;stdcall;
Functionondocwindowactivate (const factivate:bool): Hresult;stdcall;
Functiononframewindowactivate (const factivate:bool): Hresult;stdcall;
Functionresizeborder (const prcborder:prect;
Constpuiwindow:ioleinplaceuiwindow;const fframewindow:bool): HResult;
stdcall;
Functiontranslateaccelerator (const LPMSG:PMSG;CONSTPGUIDCMDGROUP:PGUID;
Constncmdid:dword): Hresult;stdcall;
Functiongetoptionkeypath (var pchkey:polestr;const dw:dword): HResult;
stdcall;
Functiongetdroptarget (const pdroptarget:idroptarget;
Out ppdroptarget:idroptarget): HResult; stdcall;
Functiongetexternal (out Ppdispatch:idispatch): Hresult;stdcall;
Functiontranslateurl (const DWTRANSLATE:DWORD;CONSTPCHURLIN:POLESTR;
VARPPCHURLOUT:POLESTR): Hresult;stdcall;
Functionfilterdataobject (const pdo:idataobject;
Out ppdoret:idataobject): HResult; stdcall;
End

Implementation

End.
Third, implement a container with IE components
Since Delphi's WebBrowser control does not support the direct extension of external, we need to write a separate container to implement the IDocHostUIHandler interface. And through the Ioleobject.setclientsite method of the ActiveX unit, we fill in our own container.
This section of the code directly refers to the implementation of the EMBEDDEDWB component, the specific code is as follows:
Unit Nulcontainer;

Interface

Uses
Windows, ActiveX, SHDocVw, Dochostuihandler;

Type
Tnulwbcontainer = Class (TObject,
Iunknown,ioleclientsite, IDocHostUIHandler)
Private
Fhostedbrowser:twebbrowser;
Proceduresetbrowseroleclientsite (const site:ioleclientsite);
Protected
Functionqueryinterface (const iid:tguid; out OBJ): HResult; stdcall;
Function_addref:integer; stdcall;
Function_release:integer; stdcall;
Functionsaveobject:hresult; stdcall;
Functiongetmoniker (Dwassign:longint;
Dwwhichmoniker:longint;
Out mk:imoniker): HResult; stdcall;
Functiongetcontainer (
Out Container:iolecontainer): HResult; stdcall;
Functionshowobject:hresult; stdcall;
Functiononshowwindow (Fshow:bool): HResult; stdcall;
Functionrequestnewobjectlayout:hresult; stdcall;
Functionshowcontextmenu (const dwid:dword; const Ppt:ppoint;
Const Pcmdtreserved:iunknown; Const pdispreserved:idispatch): HResult;
stdcall;
Functiongethostinfo (Var pinfo:tdochostuiinfo): HResult; stdcall;
Functionshowui (const Dwid:dword;
Const Pactiveobject:ioleinplaceactiveobject;
Const Pcommandtarget:iolecommandtarget; Const Pframe:ioleinplaceframe;
Const Pdoc:ioleinplaceuiwindow): HResult; stdcall;
Functionhideui:hresult; stdcall;
Functionupdateui:hresult; stdcall;
Functionenablemodeless (const fenable:bool): HResult; stdcall;
Functionondocwindowactivate (const factivate:bool): HResult; stdcall;
Functiononframewindowactivate (const factivate:bool): Hresult;stdcall;
Functionresizeborder (const prcborder:prect;
Const Puiwindow:ioleinplaceuiwindow; Const fframewindow:bool): HResult;
stdcall;
Functiontranslateaccelerator (const lpmsg:pmsg; const PGUIDCMDGROUP:PGUID;
Const Ncmdid:dword): HResult; stdcall;
Functiongetoptionkeypath (var pchkey:polestr; const Dw:dword): HResult;
stdcall;
Functiongetdroptarget (const pdroptarget:idroptarget;
Out ppdroptarget:idroptarget): HResult; stdcall;
Functiongetexternal (out Ppdispatch:idispatch): HResult; stdcall;
Functiontranslateurl (const dwtranslate:dword; const PCHURLIN:POLESTR;
var ppchurlout:polestr): HResult; stdcall;
Functionfilterdataobject (const pdo:idataobject;
Out ppdoret:idataobject): HResult; stdcall;
Public
Constructorcreate (const hostedbrowser:twebbrowser);
Destructordestroy; Override
Propertyhostedbrowser:twebbrowser read Fhostedbrowser;
End

Implementation

Uses
Sysutils;

{Tnulwbcontainer}

Constructor Tnulwbcontainer.create (const hostedbrowser:twebbrowser);
Begin
Assert (Assigned (Hostedbrowser));
Inherited Create;
Fhostedbrowser: = Hostedbrowser;
Setbrowseroleclientsite (self as IOleClientSite);
End

destructor Tnulwbcontainer.destroy;
Begin
Setbrowseroleclientsite (nil);
inherited;
End

function tnulwbcontainer.enablemodeless (const fenable:bool): HResult;
Begin
Result: = S_OK;
End

function tnulwbcontainer.filterdataobject (const pdo:idataobject;
Out ppdoret:idataobject): HResult;
Begin
Ppdoret: = nil;
Result: = S_FALSE;
End

function Tnulwbcontainer.getcontainer (
Out Container:iolecontainer): HResult;
Begin
Container: = nil;
Result: = E_nointerface;
End

function tnulwbcontainer.getdroptarget (const pdroptarget:idroptarget;
Out ppdroptarget:idroptarget): HResult;
Begin
Ppdroptarget: = nil;
Result: = E_fail;
End

function tnulwbcontainer.getexternal (out ppdispatch:idispatch): HResult;
Begin
Ppdispatch: = nil;
Result: = E_fail;
End

function Tnulwbcontainer.gethostinfo (var pinfo:tdochostuiinfo): HResult;
Begin
Result: = S_OK;
End

function Tnulwbcontainer.getmoniker (dwassign, Dwwhichmoniker:integer;
Out mk:imoniker): HResult;
Begin
mk: = nil;
Result: = E_NOTIMPL;
End

function Tnulwbcontainer.getoptionkeypath (var pchkey:polestr;
Const Dw:dword): HResult;
Begin
Result: = E_fail;
End

function TNulWBContainer.HideUI:HResult;
Begin
Result: = S_OK;
End

function Tnulwbcontainer.ondocwindowactivate (
Const factivate:bool): HResult;
Begin
Result: = S_OK;
End

function Tnulwbcontainer.onframewindowactivate (
Const factivate:bool): HResult;
Begin
Result: = S_OK;
End

function Tnulwbcontainer.onshowwindow (fshow:bool): HResult;
Begin
Result: = S_OK;
End

function tnulwbcontainer.queryinterface (const IID:TGUID; outobj): HResult;
Begin
If GetInterface (IID, OBJ) Then
Result: =S_OK
Else
Result: =e_nointerface;
End

function TNulWBContainer.RequestNewObjectLayout:HResult;
Begin
Result: = E_NOTIMPL;
End

function Tnulwbcontainer.resizeborder (const prcborder:prect;
Const Puiwindow:ioleinplaceuiwindow; Const fframewindow:bool): HResult;
Begin
Result: = S_FALSE;
End

function TNulWBContainer.SaveObject:HResult;
Begin
Result: = S_OK;
End

Procedure Tnulwbcontainer.setbrowseroleclientsite (
Const site:ioleclientsite);
Var
Oleobj:ioleobject;
Begin
Assert ((site = self as IOleClientSite) or (site = nil));
If not Supports (Fhostedbrowser.defaultinterface, ioleobject,oleobj) Then
Raiseexception.create (' Browser ' s Default interface does not supportioleobject ');
Oleobj.setclientsite (Site);
End

function Tnulwbcontainer.showcontextmenu (const Dwid:dword;
Const Ppt:ppoint; Const Pcmdtreserved:iinterface;
Const pdispreserved:idispatch): HResult;
Begin
Result: = S_FALSE
End

function TNulWBContainer.ShowObject:HResult;
Begin
Result: = S_OK;
End

function Tnulwbcontainer.showui (const Dwid:dword;
Const Pactiveobject:ioleinplaceactiveobject;
Const Pcommandtarget:iolecommandtarget; Const Pframe:ioleinplaceframe;
Const Pdoc:ioleinplaceuiwindow): HResult;
Begin
Result: = S_OK;
End

function tnulwbcontainer.translateaccelerator (const lpmsg:pmsg;
Const PGUIDCMDGROUP:PGUID; Const Ncmdid:dword): HResult;
Begin
Result: = S_FALSE;
End

function Tnulwbcontainer.translateurl (const Dwtranslate:dword;
Const PCHURLIN:POLESTR; var ppchurlout:polestr): HResult;
Begin
Result: = E_fail;
End

function TNulWBContainer.UpdateUI:HResult;
Begin
Result: = S_OK;
End

function Tnulwbcontainer._addref:integer;
Begin
Result: =-1;
End

function Tnulwbcontainer._release:integer;
Begin
Result: =-1;
End

End.

http://blog.csdn.net/youthon/article/details/8446135

Modify window.external to enable JS to invoke the Delphi method