logo
搜索
我的图书馆

发文章

发文工具

其他工具

留言交流
搜索
分享

嵌入TWebBrowser使js调用delphi的函数

 梦游四海之图书 2018-04-23
       在JavaScript中，有一个比较特殊的对象，即window.external，用它可以调用浏览器提供的外部方法.
一个很简单的例子就是将当前页添加到收藏夹:
window.external.addFavorite("http://suton.","suton的博客");
这样写脚本就可以了。

那么如果我想自己定义external，以便在自己的软件内使用IE核心的浏览器作为UI容器，该如何做呢？本文即是解决此问题。


一、制作TLB
在File | New | Other 菜单下，选择新建一个Type Library，这个向导在ActiveX页内。
然后按下图所示，新建一个接口，在接口下新建一个DoSearchData方法，这个方法即是将来需要添加到external中的。

完成添加后，点击保存为TLB按钮，将生成一个TLB文件，此处我将它命名为GetData.tlb


在JavaScript中，有一个比较特殊的对象，即window.external，用它可以调用浏览器提供的外部方法
一个很简单的例子就是将当前页添加到收藏夹
window.external.addFavorite("http://hi.baidu.com/rarnu","橙子的百度博客');
这样写脚本就可以了。

那么如果我想自己定义external，以便在自己的软件内使用IE核心的浏览器作为UI容器，该如何做呢？
本文即是解决此问题。

一、制作TLB
在File | New | Other 菜单下，选择新建一个Type Library，这个向导在ActiveX页内。
然后按下图所示，新建一个接口，在接口下新建一个DoSearchData方法，这个方法即是将来需要添加到external中的。

完成添加后，点击保存为TLB按钮，将生成一个TLB文件，此处我将它命名为GetData.tlb

二、实现IDocHostUIHandler接口
这部分相对比较简单，从MSDN上找到相关的C++代码，把它转换成Delphi的即可。代码如下：

Js代码  收藏代码
  1. unit DocHostUIHandler;  
  2.    
  3. interface  
  4.   
  5. uses  
  6. Windows, ActiveX;  
  7. const  
  8.  DOCHOSTUIFLAG_DIALOG                      = $00000001;  
  9.  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: ispatch): HResult; stdcall;  
  52.      function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; dcall;  
  53.      function ShowUI(const dwID: DWORD;  
  54.        const pActiveObject: IOleInPlaceActiveObject;  
  55.        const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;  
  56.        const pDoc: IOleInPlaceUIWindow): HResult; stdcall;  
  57.      function HideUI: HResult; stdcall;  
  58.      function UpdateUI: HResult; stdcall;  
  59.      function EnableModeless(const fEnable: BOOL): HResult; stdcall;  
  60.      function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall;  
  61.      function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall;  
  62.      function ResizeBorder(const prcBorder: PRECT;  
  63.        const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;  
  64.        stdcall;  
  65.      function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;  
  66.        const nCmdID: DWORD): HResult; stdcall;  
  67.      function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD ): HResult;  
  68.        stdcall;  
  69.      function GetDropTarget(const pDropTarget: IDropTarget;  
  70.        out ppDropTarget: IDropTarget): HResult; stdcall;  
  71.      function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;  
  72.      function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;  
  73.        var ppchURLOut: POLESTR): HResult; stdcall;  
  74.      function FilterDataObject(const pDO: IDataObject;  
  75.        out ppDORet: IDataObject): HResult; stdcall;  
  76.   end;  
  77.    
  78. implementation  
  79.    
  80. end.  

三、实现一个带有IE组件的容器
由于Delphi自带的WebBrowser控件不支持external的直接扩展，因此我们需要另外写一个容器，使它实现IDocHostUIHandler接口，并且通过ActiveX单元的IOleObject.SetClientSite方法，将我们自己的容器填充进去。
这部分的代码直接参考了EmbeddedWB组件的相关实现，具体代码如下：

Js代码  收藏代码
  1. unit NulContainer;  
  2.   
  3. interface  
  4.   
  5. uses  
  6. Windows, ActiveX, SHDocVw, DocHostUIHandler;  
  7.   
  8. type  
  9. TNulWBContainer = class(TObject,  
  10.     IUnknown, IOleClientSite, IDocHostUIHandler)  
  11. private  
  12.     fHostedBrowser: TWebBrowser;  
  13.     procedure SetBrowserOleClientSite(const Site: IOleClientSite);  
  14. protected  
  15.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;  
  16.     function _AddRef: Integer; stdcall;  
  17.     function _Release: Integer; stdcall;  
  18.     function SaveObject: HResult; stdcall;  
  19.     function GetMoniker(dwAssign: Longint;  
  20.       dwWhichMoniker: Longint;  
  21.       out mk: IMoniker): HResult; stdcall;  
  22.     function GetContainer(  
  23.       out container: IOleContainer): HResult; stdcall;  
  24.     function ShowObject: HResult; stdcall;  
  25.     function OnShowWindow(fShow: BOOL): HResult; stdcall;  
  26.     function RequestNewObjectLayout: HResult; stdcall;  
  27.     function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;  
  28.       const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HResult;  
  29.       stdcall;  
  30.     function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall;  
  31.     function ShowUI(const dwID: DWORD;  
  32.       const pActiveObject: IOleInPlaceActiveObject;  
  33.       const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;  
  34.       const pDoc: IOleInPlaceUIWindow): HResult; stdcall;  
  35.     function HideUI: HResult; stdcall;  
  36.     function UpdateUI: HResult; stdcall;  
  37.     function EnableModeless(const fEnable: BOOL): HResult; stdcall;  
  38.     function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall;  
  39.     function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall;  
  40.     function ResizeBorder(const prcBorder: PRECT;  
  41.       const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;  
  42.       stdcall;  
  43.     function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;  
  44.       const nCmdID: DWORD): HResult; stdcall;  
  45.     function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD ): HResult;  
  46.       stdcall;  
  47.     function GetDropTarget(const pDropTarget: IDropTarget;  
  48.       out ppDropTarget: IDropTarget): HResult; stdcall;  
  49.     function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;  
  50.     function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;  
  51.       var ppchURLOut: POLESTR): HResult; stdcall;  
  52.     function FilterDataObject(const pDO: IDataObject;  
  53.       out ppDORet: IDataObject): HResult; stdcall;  
  54. public  
  55.     constructor Create(const HostedBrowser: TWebBrowser);  
  56.     destructor Destroy; override;  
  57.     property HostedBrowser: TWebBrowser read fHostedBrowser;  
  58. end;  
  59.   
  60. implementation  
  61.   
  62. uses  
  63. SysUtils;  
  64.   
  65. { TNulWBContainer }  
  66.   
  67. constructor TNulWBContainer.Create(const HostedBrowser: TWebBrowser);  
  68. begin  
  69. Assert(Assigned(HostedBrowser));  
  70. inherited Create;  
  71. fHostedBrowser := HostedBrowser;  
  72. SetBrowserOleClientSite(Self as IOleClientSite);  
  73. end;  
  74.   
  75. destructor TNulWBContainer.Destroy;  
  76. begin  
  77. SetBrowserOleClientSite(nil);  
  78. inherited;  
  79. end;  
  80.   
  81. function TNulWBContainer.EnableModeless(const fEnable: BOOL): HResult;  
  82. begin  
  83. Result := S_OK;  
  84. end;  
  85.   
  86. function TNulWBContainer.FilterDataObject(const pDO: IDataObject;  
  87. out ppDORet: IDataObject): HResult;  
  88. begin  
  89. ppDORet := nil;  
  90. Result := S_FALSE;  
  91. end;  
  92.   
  93. function TNulWBContainer.GetContainer(  
  94. out container: IOleContainer): HResult;  
  95. begin  
  96. container := nil;  
  97. Result := E_NOINTERFACE;  
  98. end;  
  99.   
  100. function TNulWBContainer.GetDropTarget(const pDropTarget: IDropTarget;  
  101. out ppDropTarget: IDropTarget): HResult;  
  102. begin  
  103. ppDropTarget := nil;  
  104. Result := E_FAIL;  
  105. end;  
  106.   
  107. function TNulWBContainer.GetExternal(out ppDispatch: IDispatch): HResult;  
  108. begin  
  109. ppDispatch := nil;  
  110. Result := E_FAIL;  
  111. end;  
  112.   
  113. function TNulWBContainer.GetHostInfo(var pInfo: TDocHostUIInfo): HResult;  
  114. begin  
  115. Result := S_OK;  
  116. end;  
  117.   
  118. function TNulWBContainer.GetMoniker(dwAssign, dwWhichMoniker: Integer;  
  119. out mk: IMoniker): HResult;  
  120. begin  
  121. mk := nil;  
  122. Result := E_NOTIMPL;  
  123. end;  
  124.   
  125. function TNulWBContainer.GetOptionKeyPath(var pchKey: POLESTR;  
  126. const dw: DWORD): HResult;  
  127. begin  
  128. Result := E_FAIL;  
  129. end;  
  130.   
  131. function TNulWBContainer.HideUI: HResult;  
  132. begin  
  133. Result := S_OK;  
  134. end;  
  135.   
  136. function TNulWBContainer.OnDocWindowActivate(  
  137. const fActivate: BOOL): HResult;  
  138. begin  
  139. Result := S_OK;  
  140. end;  
  141.   
  142. function TNulWBContainer.OnFrameWindowActivate(  
  143. const fActivate: BOOL): HResult;  
  144. begin  
  145. Result := S_OK;  
  146. end;  
  147.   
  148. function TNulWBContainer.OnShowWindow(fShow: BOOL): HResult;  
  149. begin  
  150. Result := S_OK;  
  151. end;  
  152.   
  153. function TNulWBContainer.QueryInterface(const IID: TGUID; out Obj): HResult;  
  154. begin  
  155. if GetInterface(IID, Obj) then  
  156.     Result := S_OK  
  157. else  
  158.     Result := E_NOINTERFACE;  
  159. end;  
  160.   
  161. function TNulWBContainer.RequestNewObjectLayout: HResult;  
  162. begin  
  163. Result := E_NOTIMPL;  
  164. end;  
  165.   
  166. function TNulWBContainer.ResizeBorder(const prcBorder: PRECT;  
  167. const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;  
  168. begin  
  169. Result := S_FALSE;  
  170. end;  
  171.   
  172. function TNulWBContainer.SaveObject: HResult;  
  173. begin  
  174. Result := S_OK;  
  175. end;  
  176.   
  177. procedure TNulWBContainer.SetBrowserOleClientSite(  
  178. const Site: IOleClientSite);  
  179. var  
  180. OleObj: IOleObject;  
  181. begin  
  182. Assert((Site = Self as IOleClientSite) or (Site = nil));  
  183. if not Supports(fHostedBrowser.DefaultInterface, IOleObject, OleObj) then  
  184.     raise Exception.Create('Browser''s Default interface does not support IOleObject');  
  185. OleObj.SetClientSite(Site);  
  186. end;  
  187.   
  188. function TNulWBContainer.ShowContextMenu(const dwID: DWORD;  
  189. const ppt: PPOINT; const pcmdtReserved: IInterface;  
  190. const pdispReserved: IDispatch): HResult;  
  191. begin  
  192. Result := S_FALSE  
  193. end;  
  194.   
  195. function TNulWBContainer.ShowObject: HResult;  
  196. begin  
  197. Result := S_OK;  
  198. end;  
  199.   
  200. function TNulWBContainer.ShowUI(const dwID: DWORD;  
  201. const pActiveObject: IOleInPlaceActiveObject;  
  202. const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;  
  203. const pDoc: IOleInPlaceUIWindow): HResult;  
  204. begin  
  205. Result := S_OK;  
  206. end;  
  207.   
  208. function TNulWBContainer.TranslateAccelerator(const lpMsg: PMSG;  
  209. const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult;  
  210. begin  
  211. Result := S_FALSE;  
  212. end;  
  213.   
  214. function TNulWBContainer.TranslateUrl(const dwTranslate: DWORD;  
  215. const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult;  
  216. begin  
  217. Result := E_FAIL;  
  218. end;  
  219.   
  220. function TNulWBContainer.UpdateUI: HResult;  
  221. begin  
  222. Result := S_OK;  
  223. end;  
  224.   
  225. function TNulWBContainer._AddRef: Integer;  
  226. begin  
  227. Result := -1;  
  228. end;  
  229.   
  230. function TNulWBContainer._Release: Integer;  
  231. begin  
  232. Result := -1;  
  233. end;  
  234.   
  235. end.  

四、实现TLB内的接口
上面的两个单元都可以当作公共单元来处理，因为以后永远都不再需要修改它们了，下面要做的事情是重点。新建一个VCL Application，然后我们来实现TLB内的接口。

Js代码  收藏代码
  1. unit GetData_TLB_Impl;  
  2.   
  3. interface  
  4.   
  5. uses  
  6. Classes, ComObj, GetData_TLB;  
  7.   
  8. type  
  9. 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()。

Js代码  收藏代码
  1. function TDM.SearchDataHtml(ASQL: string): string;  
  2. var  
  3. i: Integer;  
  4. ret: string;  
  5. begin  
  6. ret := '<table border="1" cellspacing="0" cellpadding="0">';  
  7. with Qry do  
  8. begin  
  9.     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()方法中的代码：

Js代码  收藏代码
  1. function TMyExternal.DoSeaarchData(const ASQL: WideString): WideString; safecall;  
  2. begin  
  3. Result := DM.SearchDataHtml(ASQL);  
  4. end;  


六、实现一个External容器
接下来的事情就很简单了，我们用自己写的external去替换掉浏览器本身的。

Js代码  收藏代码
  1. unit ExternalContainer;  
  2.   
  3. interface  
  4.   
  5. uses  
  6. ActiveX, SHDocVw,  
  7. DocHostUIHandler, NulContainer, GetData_TLB_Impl;  
  8.   
  9. 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 Create(HostedBrowser);  
  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替换了

Js代码  收藏代码
  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的替换就结束了 

    本站是提供个人知识管理的网络存储空间，所有内容均由用户发布，不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息，谨防诈骗。如发现有害或侵权内容，请点击一键举报。
    转藏 分享 献花（0）

    来自： 梦游四海之图书 > 《Webbrowser》

    举报/认领

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多