修改window.external使JavaScript可以调用Delphi内定义的方法
2017-10-17 16:31
846 查看
修改window.external使JavaScript可以调用Delphi内定义的方法
在JavaScript中,有一个比较特殊的对象,即window.external,用它可以调用浏览器提供的外部方法
一个很简单的例子就是将当前页添加到收藏夹
window.external.addFavorite(https://www.baidu.com/,”XX的百度’);
这样写脚本就可以了。
那么如果我想自己定义external,以便在自己的软件内使用IE核心的浏览器作为UI容器,该如何做呢?
本文即是解决此问题。
一、制作TLB
在File | New | Other 菜单下,选择新建一个Type Library,这个向导在ActiveX页内。
然后按下图所示,新建一个接口,在接口下新建一个DoSearchData方法,这个方法即是将来需要添加到external中的。
完成添加后,点击保存为TLB按钮,将生成一个TLB文件,此处我将它命名为GetData.tlb
二、实现IDocHostUIHandler接口
这部分相对比较简单,从MSDN上找到相关的C++代码,把它转换成Delphi的即可。代码如下:
三、实现一个带有IE组件的容器
由于Delphi自带的WebBrowser控件不支持external的直接扩展,因此我们需要另外写一个容器,使它实现IDocHostUIHandler接口,并且通过ActiveX单元的IOleObject.SetClientSite方法,将我们自己的容器填充进去。
这部分的代码直接参考了EmbeddedWB组件的相关实现,具体代码如下:
四、实现TLB内的接口
上面的两个单元都可以当作公共单元来处理,因为以后永远都不再需要修改它们了,下面要做的事情是重点。新建一个VCL Application,然后我们来实现TLB内的接口。
这样即是一个实现的了TLB。可以看到,其中有个DoSearchData()方法里是空的,下面我们为它填上代码。
五、编写业务逻辑代码
新建一个Data Module,然后放上ADOConnection与ADOQuery两个控件,相互关联后,连接到SQL Server 2000的一个默认数据库Northwind上。在Data Module内,写一个方法SearchDataHtml()。
很明显的,上面的代码即是查询一个表,并把它的内容拼装成一个Table。
然后我们在GetData_TLB_Impl中引用Data Module,并补完DoSearchData()方法中的代码:
六、实现一个External容器
接下来的事情就很简单了,我们用自己写的external去替换掉浏览器本身的。
七、将浏览器控件放进自定义的external容器
就一句代码,就能把把WebBrowser内的external替换了
八、引用TLB并编译
打开Dpr的源码,添加一句{$R GetData.tlb},然后编译程序,运行。
九、总结
到此为止,external的替换就结束了
在JavaScript中,有一个比较特殊的对象,即window.external,用它可以调用浏览器提供的外部方法
一个很简单的例子就是将当前页添加到收藏夹
window.external.addFavorite(https://www.baidu.com/,”XX的百度’);
这样写脚本就可以了。
那么如果我想自己定义external,以便在自己的软件内使用IE核心的浏览器作为UI容器,该如何做呢?
本文即是解决此问题。
一、制作TLB
在File | New | Other 菜单下,选择新建一个Type Library,这个向导在ActiveX页内。
然后按下图所示,新建一个接口,在接口下新建一个DoSearchData方法,这个方法即是将来需要添加到external中的。
完成添加后,点击保存为TLB按钮,将生成一个TLB文件,此处我将它命名为GetData.tlb
二、实现IDocHostUIHandler接口
这部分相对比较简单,从MSDN上找到相关的C++代码,把它转换成Delphi的即可。代码如下:
01 unit DocHostUIHandler; 02 03 interface 04 05 uses 06 Windows, ActiveX; 07 const 08 DOCHOSTUIFLAG_DIALOG = $00000001; 09 DOCHOSTUIFLAG_DISABLE_HELP_MENU = $00000002; 10 DOCHOSTUIFLAG_NO3DBORDER = $00000004; 11 DOCHOSTUIFLAG_SCROLL_NO = $00000008; 12 DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = $00000010; 13 DOCHOSTUIFLAG_OPENNEWWIN = $00000020; 14 DOCHOSTUIFLAG_DISABLE_OFFSCREEN = $00000040; 15 DOCHOSTUIFLAG_FLAT_SCROLLBAR = $00000080; 16 DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = $00000100; 17 DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = $00000200; 18 DOCHOSTUIFLAG_OVERRIDEBEHAVIORFACTORY = $00000400; 19 DOCHOSTUIFLAG_CODEPAGELINKEDFONTS = $00000800; 20 DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8 = $00001000; 21 DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8 = $00002000; 22 DOCHOSTUIFLAG_ENABLE_FORMS_AUTOCOMPLETE = $00004000; 23 DOCHOSTUIFLAG_ENABLE_INPLACE_NAVIGATION = $00010000; 24 DOCHOSTUIFLAG_IME_ENABLE_RECONVERSION = $00020000; 25 DOCHOSTUIFLAG_THEME = $00040000; 26 DOCHOSTUIFLAG_NOTHEME = $00080000; 27 DOCHOSTUIFLAG_NOPICS = $00100000; 28 DOCHOSTUIFLAG_NO3DOUTERBORDER = $00200000; 29 DOCHOSTUIFLAG_DISABLE_EDIT_NS_FIXUP = $1; 30 DOCHOSTUIFLAG_LOCAL_MACHINE_ACCESS_CHECK = $1; 31 DOCHOSTUIFLAG_DISABLE_UNTRUSTEDPROTOCOL = $1; 32 DOCHOSTUIDBLCLK_DEFAULT = 0; 33 DOCHOSTUIDBLCLK_SHOWPROPERTIES = 1; 34 DOCHOSTUIDBLCLK_SHOWCODE = 2; 35 DOCHOSTUITYPE_BROWSE = 0; 36 DOCHOSTUITYPE_AUTHOR = 1; 37 38 type 39 TDocHostUIInfo = record 40 cbSize: ULONG; 41 dwFlags: DWORD; 42 dwDoubleClick: DWORD; 43 pchHostCss: PWChar; 44 pchHostNS: PWChar; 45 end; 46 47 PDocHostUIInfo = ^TDocHostUIInfo; 48 IDocHostUIHandler = interface(IUnknown) 49 ['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}'] 50 function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; 51 const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HResult; 52 stdcall; 53 function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall; 54 function ShowUI(const dwID: DWORD; 55 const pActiveObject: IOleInPlaceActiveObject; 56 const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame; 57 const pDoc: IOleInPlaceUIWindow): HResult; stdcall; 58 function HideUI: HResult; stdcall; 59 function UpdateUI: HResult; stdcall; 60 function EnableModeless(const fEnable: BOOL): HResult; stdcall; 61 function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall; 62 function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall; 63 function ResizeBorder(const prcBorder: PRECT; 64 const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult; 65 stdcall; 66 function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; 67 const nCmdID: DWORD): HResult; stdcall; 68 function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD ): HResult; 69 stdcall; 70 function GetDropTarget(const pDropTarget: IDropTarget; 71 out ppDropTarget: IDropTarget): HResult; stdcall; 72 function GetExternal(out ppDispatch: IDispatch): HResult; stdcall; 73 function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR; 74 var ppchURLOut: POLESTR): HResult; stdcall; 75 function FilterDataObject(const pDO: IDataObject; 76 out ppDORet: IDataObject): HResult; stdcall; 77 end; 78 79 implementation 80 81 end.
三、实现一个带有IE组件的容器
由于Delphi自带的WebBrowser控件不支持external的直接扩展,因此我们需要另外写一个容器,使它实现IDocHostUIHandler接口,并且通过ActiveX单元的IOleObject.SetClientSite方法,将我们自己的容器填充进去。
这部分的代码直接参考了EmbeddedWB组件的相关实现,具体代码如下:
unit NulContainer; interface uses Windows, ActiveX, SHDocVw, DocHostUIHandler; type TNulWBContainer = class(TObject, IUnknown, IOleClientSite, IDocHostUIHandler) private fHostedBrowser: TWebBrowser; procedure SetBrowserOleClientSite(const Site: IOleClientSite); protected function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; function SaveObject: HResult; stdcall; function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint; out mk: IMoniker): HResult; stdcall; function GetContainer( out container: IOleContainer): HResult; stdcall; function ShowObject: HResult; stdcall; function OnShowWindow(fShow: BOOL): HResult; stdcall; function RequestNewObjectLayout: HResult; stdcall; 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 fFrameWindow: 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; public constructor Create(const HostedBrowser: TWebBrowser); destructor Destroy; override; property HostedBrowser: 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; out Obj): 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 raise Exception.Create('Browser''s Default interface does not support IOleObject'); 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.
四、实现TLB内的接口
上面的两个单元都可以当作公共单元来处理,因为以后永远都不再需要修改它们了,下面要做的事情是重点。新建一个VCL Application,然后我们来实现TLB内的接口。
01 unit GetData_TLB_Impl; 02 03 interface 04 05 uses 06 Classes, ComObj, GetData_TLB; 07 08 type 09 TMyExternal = class(TAutoIntfObject, IGetData, IDispatch) 10 private 11 protected 12 function DoSeaarchData(const ASQL: WideString): WideString; safecall; 13 public 14 constructor Create; 15 destructor Destroy; override; 16 end; 17 18 implementation 19 20 uses 21 SysUtils, ActiveX, StdActns; 22 23 { TMyExternal } 24 25 constructor TMyExternal.Create; 26 var 27 TypeLib: ITypeLib; 28 ExeName: WideString; 29 begin 30 ExeName := ParamStr(0); 31 OleCheck(LoadTypeLib(PWideChar(ExeName), TypeLib)); 32 inherited Create(TypeLib, IGetData); 33 end; 34 35 destructor TMyExternal.Destroy; 36 begin 37 inherited; 38 end; 39 40 function TMyExternal.DoSeaarchData(const ASQL: WideString): WideString; safecall; 41 begin 42 end; 43 44 end.
这样即是一个实现的了TLB。可以看到,其中有个DoSearchData()方法里是空的,下面我们为它填上代码。
五、编写业务逻辑代码
新建一个Data Module,然后放上ADOConnection与ADOQuery两个控件,相互关联后,连接到SQL Server 2000的一个默认数据库Northwind上。在Data Module内,写一个方法SearchDataHtml()。
01 function TDM.SearchDataHtml(ASQL: string): string; 02 var 03 i: Integer; 04 ret: string; 05 begin 06 ret := '<table border="1" cellspacing="0" cellpadding="0">'; 07 with Qry do 08 begin 09 Close; 10 SQL.Text := ASQL; 11 try 12 Open; 13 except 14 on E: Exception do 15 begin 16 Result := e.Message; 17 Exit; 18 end; 19 end; 20 ret := ret + '<tr>'; 21 for i:=0 to FieldCount - 1 do 22 ret := ret + Format('<td nowrap><b>%s</b></td>',[Fields[i].FieldName]); 23 ret := ret + '</tr>'; 24 First; 25 while not Eof do 26 begin 27 ret := ret + '<tr>'; 28 for i:=0 to FieldCount - 1 do 29 begin 30 if Fields[i].DataType in [ftString, ftSmallint, ftInteger, ftWord, 31 ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, 32 ftAutoInc, ftMemo, ftFmtMemo, ftWideString, 33 ftFixedChar, ftLargeint, ftVariant, ftGuid, ftTimeStamp, ftFMTBcd] then 34 ret := ret + Format('<td nowrap>%s</td>',[Fields[i].AsString]) 35 else 36 ret := ret + '<td nowrap>(Unsupported Data)</td>'; 37 end; 38 ret := ret + '</tr>'; 39 Next; 40 end; 41 end; 42 ret := ret+ '</table>'; 43 Result := ret; 44 end;
很明显的,上面的代码即是查询一个表,并把它的内容拼装成一个Table。
然后我们在GetData_TLB_Impl中引用Data Module,并补完DoSearchData()方法中的代码:
1 function TMyExternal.DoSeaarchData(const ASQL: WideString): WideString; safecall; 2 begin 3 Result := DM.SearchDataHtml(ASQL); 4 end;
六、实现一个External容器
接下来的事情就很简单了,我们用自己写的external去替换掉浏览器本身的。
01 unit ExternalContainer; 02 03 interface 04 05 uses 06 ActiveX, SHDocVw, 07 DocHostUIHandler, NulContainer, GetData_TLB_Impl; 08 09 type 10 TExternalContainer = class(TNulWBContainer, IDocHostUIHandler, IOleClientSite) 11 private 12 fExternalObj: IDispatch; 13 protected 14 function GetExternal(out ppDispatch: IDispatch): HResult; stdcall; 15 public 16 constructor Create(const HostedBrowser: TWebBrowser); 17 end; 18 19 implementation 20 21 { TExternalContainer } 22 23 constructor TExternalContainer.Create(const HostedBrowser: TWebBrowser); 24 begin 25 inherited; 26 fExternalObj := TMyExternal.Create; 27 end; 28 29 function TExternalContainer.GetExternal(out ppDispatch: IDispatch): HResult; 30 begin 31 ppDispatch := fExternalObj; 32 Result := S_OK; 33 end; 34 35 end.
七、将浏览器控件放进自定义的external容器
就一句代码,就能把把WebBrowser内的external替换了
1 procedure TFormMain.FormCreate(Sender: TObject); 2 begin 3 f := TExternalContainer.Create(WB); 4 WB.Navigate(ExtractFilePath(ParamStr(0))+'Data.html'); 5 end;
八、引用TLB并编译
打开Dpr的源码,添加一句{$R GetData.tlb},然后编译程序,运行。
九、总结
到此为止,external的替换就结束了
相关文章推荐
- 修改window.external使JS可调用Delphi方法
- 修改window.external使JS可调用Delphi方法
- 5.定义一个可以接收三个数字的函数,函数体内实现三个数字的排序输出 →(javascript代返回值的函数的申明和调用)
- js通过window.external调用delphi的返回值类型问题解决方案,不解的COM问题
- window.parent与window.opener的区别 javascript调用主窗口方法
- JavaScript中的常见函数字符串可以调用的方法(2)
- iframe里面的文件加载完,JavaScript才可以调用里面的JavaScript方法的解决办法
- 深入理解Javascript动态方法调用与参数修改的问题
- Delphi开发嵌入IE的OCX,调用页面上JavaScript的方法
- window.parent与window.opener的区别 javascript调用主窗口方法
- js 通过window.external 调用 winform中的方法
- 在Silverlight1.1中定义与调用Javascript事件的方法
- js中方法定义的时候没有定义参数,调用的时候可以传参吗?
- java 和 JavaScript都可以在创建一个对象时,就可以通过这个对象调用相应方法
- Javascript动态方法调用与参数修改的问题
- 3.定义一个接受两个数字的方法,返回两个数字的和 →(javascript代返回值的函数的申明和调用)
- javascript小记——setTimeout调用方法总是提示未定义??
- windows下简单的调用Setforegroundwindow并不能将窗口置最前,我找到三种方法可以实现该功能。
- javascript、jQuery函数定义和调用方法
- Javascript动态方法调用与参数修改的问题