修改window.external使JavaScript可以调用Delphi内定义的方法
来源:互联网 发布:杨虎城 蒋介石 知乎 编辑:程序博客网 时间:2024/05/22 05:18
修改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的即可。代码如下:
01 unit DocHostUIHandler;02 03 interface04 05 uses06 Windows, ActiveX;07 const08 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 type39 TDocHostUIInfo = record40 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 implementation80 81 end.
三、实现一个带有IE组件的容器
由于Delphi自带的WebBrowser控件不支持external的直接扩展,因此我们需要另外写一个容器,使它实现IDocHostUIHandler接口,并且通过ActiveX单元的IOleObject.SetClientSite方法,将我们自己的容器填充进去。
这部分的代码直接参考了EmbeddedWB组件的相关实现,具体代码如下:
unit NulContainer;interfaceusesWindows, ActiveX, SHDocVw, DocHostUIHandler;typeTNulWBContainer = 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;implementationusesSysUtils;{ TNulWBContainer }constructor TNulWBContainer.Create(const HostedBrowser: TWebBrowser);beginAssert(Assigned(HostedBrowser));inherited Create;fHostedBrowser := HostedBrowser;SetBrowserOleClientSite(Self as IOleClientSite);end;destructor TNulWBContainer.Destroy;beginSetBrowserOleClientSite(nil);inherited;end;function TNulWBContainer.EnableModeless(const fEnable: BOOL): HResult;beginResult := S_OK;end;function TNulWBContainer.FilterDataObject(const pDO: IDataObject;out ppDORet: IDataObject): HResult;beginppDORet := nil;Result := S_FALSE;end;function TNulWBContainer.GetContainer(out container: IOleContainer): HResult;begincontainer := nil;Result := E_NOINTERFACE;end;function TNulWBContainer.GetDropTarget(const pDropTarget: IDropTarget;out ppDropTarget: IDropTarget): HResult;beginppDropTarget := nil;Result := E_FAIL;end;function TNulWBContainer.GetExternal(out ppDispatch: IDispatch): HResult;beginppDispatch := nil;Result := E_FAIL;end;function TNulWBContainer.GetHostInfo(var pInfo: TDocHostUIInfo): HResult;beginResult := S_OK;end;function TNulWBContainer.GetMoniker(dwAssign, dwWhichMoniker: Integer;out mk: IMoniker): HResult;beginmk := nil;Result := E_NOTIMPL;end;function TNulWBContainer.GetOptionKeyPath(var pchKey: POLESTR;const dw: DWORD): HResult;beginResult := E_FAIL;end;function TNulWBContainer.HideUI: HResult;beginResult := S_OK;end;function TNulWBContainer.OnDocWindowActivate(const fActivate: BOOL): HResult;beginResult := S_OK;end;function TNulWBContainer.OnFrameWindowActivate(const fActivate: BOOL): HResult;beginResult := S_OK;end;function TNulWBContainer.OnShowWindow(fShow: BOOL): HResult;beginResult := S_OK;end;function TNulWBContainer.QueryInterface(const IID: TGUID; out Obj): HResult;beginif GetInterface(IID, Obj) then Result := S_OKelse Result := E_NOINTERFACE;end;function TNulWBContainer.RequestNewObjectLayout: HResult;beginResult := E_NOTIMPL;end;function TNulWBContainer.ResizeBorder(const prcBorder: PRECT;const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;beginResult := S_FALSE;end;function TNulWBContainer.SaveObject: HResult;beginResult := S_OK;end;procedure TNulWBContainer.SetBrowserOleClientSite(const Site: IOleClientSite);varOleObj: IOleObject;beginAssert((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;beginResult := S_FALSEend;function TNulWBContainer.ShowObject: HResult;beginResult := S_OK;end;function TNulWBContainer.ShowUI(const dwID: DWORD;const pActiveObject: IOleInPlaceActiveObject;const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;const pDoc: IOleInPlaceUIWindow): HResult;beginResult := S_OK;end;function TNulWBContainer.TranslateAccelerator(const lpMsg: PMSG;const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult;beginResult := S_FALSE;end;function TNulWBContainer.TranslateUrl(const dwTranslate: DWORD;const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult;beginResult := E_FAIL;end;function TNulWBContainer.UpdateUI: HResult;beginResult := S_OK;end;function TNulWBContainer._AddRef: Integer;beginResult := -1;end;function TNulWBContainer._Release: Integer;beginResult := -1;end;end.
四、实现TLB内的接口
上面的两个单元都可以当作公共单元来处理,因为以后永远都不再需要修改它们了,下面要做的事情是重点。新建一个VCL Application,然后我们来实现TLB内的接口。
01 unit GetData_TLB_Impl;02 03 interface04 05 uses06 Classes, ComObj, GetData_TLB;07 08 type09 TMyExternal = class(TAutoIntfObject, IGetData, IDispatch)10 private11 protected12 function DoSeaarchData(const ASQL: WideString): WideString; safecall;13 public14 constructor Create;15 destructor Destroy; override;16 end;17 18 implementation19 20 uses21 SysUtils, ActiveX, StdActns;22 23 { TMyExternal }24 25 constructor TMyExternal.Create;26 var27 TypeLib: ITypeLib;28 ExeName: WideString;29 begin30 ExeName := ParamStr(0);31 OleCheck(LoadTypeLib(PWideChar(ExeName), TypeLib));32 inherited Create(TypeLib, IGetData);33 end;34 35 destructor TMyExternal.Destroy;36 begin37 inherited;38 end;39 40 function TMyExternal.DoSeaarchData(const ASQL: WideString): WideString; safecall;41 begin42 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 var03 i: Integer;04 ret: string;05 begin06 ret := '<table border="1" cellspacing="0" cellpadding="0">';07 with Qry do08 begin09 Close;10 SQL.Text := ASQL;11 try12 Open;13 except14 on E: Exception do15 begin16 Result := e.Message;17 Exit;18 end;19 end;20 ret := ret + '<tr>';21 for i:=0 to FieldCount - 1 do22 ret := ret + Format('<td nowrap><b>%s</b></td>',[Fields[i].FieldName]);23 ret := ret + '</tr>';24 First;25 while not Eof do26 begin27 ret := ret + '<tr>';28 for i:=0 to FieldCount - 1 do29 begin30 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] then34 ret := ret + Format('<td nowrap>%s</td>',[Fields[i].AsString])35 else36 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 begin3 Result := DM.SearchDataHtml(ASQL);4 end;
六、实现一个External容器
接下来的事情就很简单了,我们用自己写的external去替换掉浏览器本身的。
01 unit ExternalContainer;02 03 interface04 05 uses06 ActiveX, SHDocVw,07 DocHostUIHandler, NulContainer, GetData_TLB_Impl;08 09 type10 TExternalContainer = class(TNulWBContainer, IDocHostUIHandler, IOleClientSite)11 private12 fExternalObj: IDispatch;13 protected14 function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;15 public16 constructor Create(const HostedBrowser: TWebBrowser);17 end;18 19 implementation20 21 { TExternalContainer }22 23 constructor TExternalContainer.Create(const HostedBrowser: TWebBrowser);24 begin25 inherited;26 fExternalObj := TMyExternal.Create;27 end;28 29 function TExternalContainer.GetExternal(out ppDispatch: IDispatch): HResult;30 begin31 ppDispatch := fExternalObj;32 Result := S_OK;33 end;34 35 end.
七、将浏览器控件放进自定义的external容器
就一句代码,就能把把WebBrowser内的external替换了
1 procedure TFormMain.FormCreate(Sender: TObject);2 begin3 f := TExternalContainer.Create(WB);4 WB.Navigate(ExtractFilePath(ParamStr(0))+'Data.html');5 end;
八、引用TLB并编译
打开Dpr的源码,添加一句{$R GetData.tlb},然后编译程序,运行。
九、总结
到此为止,external的替换就结束了
- 修改window.external使JavaScript可以调用Delphi内定义的方法
- 修改window.external使JS可调用Delphi方法
- window.external的使用(javaScript)
- 通过IE提供的window.external来再javascript中调用winform中的函数
- javascript调用iframe内的方法
- java方法内是可以定义类的
- VS 2005 webbrowser 通过 window.external 调用程序里的方法
- javascript:window.external.addFavorite() 代码的意思 添加收藏夹
- window.external的使用
- window.external的使用
- window.external的使用
- window.external的使用
- window.external的使用
- window.external的使用
- window.external的使用
- window.external的使用
- 在javascript中利用window.external调用C++代码,调用VC函数
- js中方法定义的时候没有定义参数,调用的时候可以传参吗?
- Best Time to Buy and Sell Stock with Cooldown问题及解法
- 使用Gson解析复杂的json数据
- 2017 iOS 启动页(Launch Screen Images)、图标(App Icon)尺寸大小
- 关于nodejs项目移植问题说明
- git使用push或者pull命令每次都需要输入用户名和密码?
- 修改window.external使JavaScript可以调用Delphi内定义的方法
- 小猪的C语言快速入门系列(八)
- Kafka安装配置
- 【1122】简单鞍点
- Sass、LESS 和 Stylus区别总结
- c++面向对象总结
- SAPI5同时(重叠)朗读TTS
- 如何用Notepad++运行Python脚本
- JAVA学习笔记09——Hibernate框架第三章