TEmbeddedWB/TWebbrowser: window.external is an empty object but can call functions, why is it 'empty' in the first place?
使用案例(首先输入一些信息):
我制作了一些HTML / CSS3 / Javascript游戏,可以在特定于平台的可执行文件中的WebView /嵌入式浏览器中的不同平台上运行。我自己设计它,是因为我对周围的所有"框架"感到厌倦,这些框架告诉我使用它们的框架有多简单。我不需要这些框架具有令人印象深刻的类和东西的全部膨胀,它必须像ABC一样简单,对吧?另外,由于Webview比本机代码慢,因此它必须简单明了才能获得最佳性能。
因此,我设计了一个接口,该接口可作为javascript中的变量使用,而无需加载额外的javascript类(例如cordova或phonegap或其他)。由于我也使用Windows(Windows无法将对象变量的名称更改为"发布"),因此可以通过window.external通过javascript访问。将html加载到webview /浏览器中时,此变量将是一个对象。
问题
这一切都很好(在不同平台上),但是
但是,类似
1 2 3 | for( var p in window.external ) { alert( p ); } |
因此,要测试外部对象是否为"真实"外部对象并不容易,并且无法查看支持的功能(如有必要)。
对此我该怎么办?我在这里想念什么吗?
为了给您一些信息,我遵循了此"指南":
http://www.delphidabbler.com/articles?article=22。
我的代码(简体):
类型库:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 | unit WebBrowserBridge_TLB; // ************************************************************************ // // WARNING // ------- // The types declared in this file were generated from data read from a // Type Library. If this type library is explicitly or indirectly (via // another type library referring to this type library) re-imported, or the // 'Refresh' command of the Type Library Editor activated while editing the // Type Library, the contents of this file will be regenerated and all // manual modifications will be lost. // ************************************************************************ // // PASTLWTR : $Revision: 1.88.1.0.1.0 $ // File generated on 4-3-2014 6:50:23 from Type Library described below. // ************************************************************************ // // Type Lib: ExternalInterface\\WebBrowserBridge.tlb (1) // IID\\LCID: {517F7078-5E73-4E5A-A8A2-8F0FF14EF21B}\\0 // Helpfile: // DepndLst: // (1) v2.0 stdole, (C:\\Windows\\SysWOW64\\stdole2.tlb) // ************************************************************************ // {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. interface uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL; // *********************************************************************// // GUIDS declared in the TypeLibrary. Following prefixes are used: // Type Libraries : LIBID_xxxx // CoClasses : CLASS_xxxx // DISPInterfaces : DIID_xxxx // Non-DISP interfaces: IID_xxxx // *********************************************************************// const // TypeLibrary Major and minor versions WebBrowserBridgeMajorVersion = 1; WebBrowserBridgeMinorVersion = 0; LIBID_WebBrowserBridge: TGUID = '{517F7078-5E73-XXXX-B8A2-8F0FF14EF21B}'; IID_IWebBrowserBridge: TGUID = '{4F995D09-XXXX-4042-993E-C71A8AED661E}'; type // *********************************************************************// // Forward declaration of types defined in TypeLibrary // *********************************************************************// IWebBrowserBridge = interface; IWebBrowserBridgeDisp = dispinterface; // *********************************************************************// // Interface: IWebBrowserBridge // Flags: (4416) Dual OleAutomation Dispatchable // GUID: {4F995D09-CF9E-XXX-993E-C71A8AED661E} // *********************************************************************// IWebBrowserBridge = interface(IDispatch) ['{4F995D09-CF9E-4042XXXX-C71A8AED661E}'] procedure isAvailable; safecall; procedure vibrate(ms: Integer); safecall; end; // *********************************************************************// // DispIntf: IWebBrowserBridgeDisp // Flags: (4416) Dual OleAutomation Dispatchable // GUID: {4F995D09-CF9E-XXX-993E-C71A8AED661E} // *********************************************************************// IWebBrowserBridgeDisp = dispinterface ['{4F995D09-CF9E-404XXXE-C71A8AED661E}'] procedure isAvailable; dispid 200; procedure vibrate(ms: Integer); dispid 201; end; implementation uses ComObj; end. |
对象库(类):
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | unit WebBrowserBridge; interface uses // Delphi ActiveX, SHDocVw, Windows, Classes, ComObj, Dialogs, // Project IntfDocHostUIHandler, UNulContainer, WebBrowserBridge_TLB; type TWebBrowserBridge = class(TAutoIntfObject, IWebBrowserBridge, IDispatch) public { IMyExternal methods } procedure isAvailable(); safecall; procedure vibrate(ms: Integer); safecall; public constructor Create; destructor Destroy; override; end; { TWebBrowserBridgeContainer: UI handler that extends browser's external object. } TWebBrowserBridgeContainer = class(TNulWBContainer, IDocHostUIHandler, IOleClientSite) private fExternalObj: IDispatch; // external object implementation protected { Re-implemented IDocHostUIHandler method } function GetExternal(out ppDispatch: IDispatch): HResult; stdcall; public constructor Create(const WBDefaultInterface: IDispatch); end; implementation uses SysUtils, StdActns; { TWebBrowserBridgeContainer } constructor TWebBrowserBridgeContainer.Create(const WBDefaultInterface: IDispatch); begin inherited; fExternalObj := TWebBrowserBridge.Create; end; function TWebBrowserBridgeContainer.GetExternal(out ppDispatch: IDispatch): HResult; begin ppDispatch := fExternalObj; Result := S_OK; // indicates we've provided script end; { TWebBrowserBridge } constructor TWebBrowserBridge.Create; var TypeLib: ITypeLib; // type library information ExeName: WideString; // name of our program's exe file begin // Get name of application ExeName := ParamStr(0); // Load type library from application's resources OleCheck(LoadTypeLib(PWideChar(ExeName), TypeLib)); // Call inherited constructor inherited Create(TypeLib, IWebBrowserBridge); end; destructor TWebBrowserBridge.Destroy; begin inherited; end; procedure TWebBrowserBridge.isAvailable(); begin //Result:=1; end; procedure TWebBrowserBridge.vibrate(ms: Integer); begin windows.beep( 100, ms ); //showMessage( IntToStr( ms )); end; |
PS:
我还想知道如何在类型库中创建函数,因为它仅允许创建过程或属性(但不像Android上那样支持属性)。
编辑:
另请参阅我的答案,但由于上面的PS,问题仍然悬而未决。
使用ObjComAuto.TObjectDispatch提供的后期绑定功能,可以使用更简单的方法在Delphi中实现
这样,您无需定义任何接口或类型库。您需要的只是一个实现所需事件的简单类,以及$ METHODINFO提供的扩展RTTI信息。
您可以实现过程和功能,并接收Delphi类型或javascript对象作为参数。也可以从Delphi中使用Javascript对象(可以访问属性和方法)。
示例:(只需将TEmbeddedWB放入表单中)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | uses MSHTML_EWB, ObjComAuto; type {$METHODINFO ON} // activate detailed RTTI TJavascriptReceiver = class procedure MyMouseMove(event: variant); procedure MyClick(event: variant); function MyGet(msg: string): string; end; {$METHODINFO OFF} { TJavascriptReceiver } procedure TJavascriptReceiver.MyMouseMove(event: variant); begin Form1.Caption := IntToStr(event.clientX) + ', ' + IntToStr(event.clientY); end; procedure TJavascriptReceiver.MyClick(event: variant); var w: variant; begin w := (Form1.EmbeddedWB1.Document as IHTMLDocument2).parentWindow; w.testGet('Caption: '); end; function TJavascriptReceiver.MyGet(msg: string): string; begin Result := msg + Form1.Caption; end; { TForm1 } procedure TForm1.FormCreate(Sender: TObject); var strs: TStringStream; begin strs := TStringStream.Create; try strs.WriteString( '<!DOCTYPE html>' +'<html>' +'<head>' +' <style>' +' html, body { margin: 0; padding: 0; height: 100%; }' +' </style>' +' ' +' function testGet(msg) {' +' alert(external.MyGet(msg));' +' }' +' ' +'</head>' +'<body' +' onmousemove="external.MyMouseMove(event)"' +' onclick="external.MyClick(event)"' +'>' +'Click anywhere' +'</body>' +'</html>' ); EmbeddedWB1.LoadFromStream(strs); finally strs.Free; end; end; procedure TForm1.EmbeddedWB1GetExternal(Sender: TCustomEmbeddedWB; var ppDispatch: IDispatch); begin ppDispatch := TObjectDispatch.Create(TJavascriptReceiver.Create); end; |
注意:
Javascript数组稀疏,因此您无法使用常用的
编辑:
有关如何通过
要使其正常工作,请执行以下操作:
1 2 3 | for( var p in window.external ) { alert( p ); } |
您将需要在
您可以在此处找到有关
如何在类型库中创建函数
自动化方法是返回
除了输入和输出参数外,自动化方法还支持一个retval参数。 Delphi使用参数类型作为函数的结果类型,将方法转换为安全调用函数。 retval参数必须是最后一个参数,并且作为out参数,必须是一个指针(例如,对于整数,使用
因此,如果您在类型库编辑器中声明一个带有指针类型以及out和retval修饰符的参数,它将作为安全调用函数出现在* _TLB.pas文件中。这也是创建属性获取器的方式。
通过
正如Noseratio所说,调度对象必须实现IDispatchEx。
我已经制作了一个包含两个扩展
因此,如果您从
要实现
-
TAutoIntfObjectEx 从类型库提供的ITypeInfo 中获取它。 -
TObjectDispatchEx 从{$METHODINFO ON} 提供的扩展RTTI中获取它。
这至少需要Delphi2010。有关如何使用TObjectDispatch 。的信息,请参见我的其他答案。
元数据用于?x28>的每次迭代,因此,对于从其中一个继承的每个类,元数据都将在第一次需要时提取并缓存以备后用。这意味着两级缓存:一个用于从扩展类之一继承的每个子类,另一个用于每个子类的方法的名称和名称。
我对排序后的
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 | unit LibDispatchEx; interface {$IFDEF CONDITIONALEXPRESSIONS} {$IF CompilerVersion >= 21} // Delphi 2010+ {$DEFINE HAS_RTTI} {$IFEND} {$IF RTLVersion >= 15} // Delphi 7+ {$DEFINE HAS_DISPATCHEX} {$IFEND} {$ENDIF} uses Windows, SysUtils, Classes, ActiveX, ComObj{$ifdef HAS_RTTI}, ObjComAuto{$endif}; {$IFNDEF HAS_DISPATCHEX} const DISPID_STARTENUM = DISPID_UNKNOWN; DISPATCH_CONSTRUCT = $4000; type IServiceProvider = interface(IUnknown) ['{6d5140c1-7436-11ce-8034-00aa006009fa}'] function QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall; end; PServiceProvider = ^IServiceProvider; IDispatchEx = interface(IDispatch) ['{A6EF9860-C720-11D0-9337-00A0C90DCAA9}'] function GetDispID(const bstrName: TBSTR; const grfdex: DWORD; out id: TDispID): HResult; stdcall; function InvokeEx(const id: TDispID; const lcid: LCID; const wflags: WORD; const pdp: PDispParams; out varRes: OleVariant; out pei: TExcepInfo; const pspCaller: PServiceProvider): HResult; stdcall; function DeleteMemberByName(const bstr: TBSTR; const grfdex: DWORD): HResult; stdcall; function DeleteMemberByDispID(const id: TDispID): HResult; stdcall; function GetMemberProperties(const id: TDispID; const grfdexFetch: DWORD; out grfdex: DWORD): HResult; stdcall; function GetMemberName(const id: TDispID; out bstrName: TBSTR): HResult; stdcall; function GetNextDispID(const grfdex: DWORD; const id: TDispID; out nid: TDispID): HResult; stdcall; function GetNameSpaceParent(out unk: IUnknown): HResult; stdcall; end; {$ENDIF} type TDispatchExSubclass = class; TAutoIntfObjectEx = class(TAutoIntfObject, IDispatchEx) protected FMetadata: TDispatchExSubclass; procedure GetMetadata; function GetDispID(const bstrName: TBSTR; const grfdex: DWORD; out id: TDispID): HResult; stdcall; function InvokeEx(const id: TDispID; const lcid: LCID; const wflags: WORD; const pdp: PDispParams; out varRes: OleVariant; out pei: TExcepInfo; const pspCaller: PServiceProvider): HResult; stdcall; function DeleteMemberByName(const bstr: TBSTR; const grfdex: DWORD): HResult; stdcall; function DeleteMemberByDispID(const id: TDispID): HResult; stdcall; function GetMemberProperties(const id: TDispID; const grfdexFetch: DWORD; out grfdex: DWORD): HResult; stdcall; function GetMemberName(const id: TDispID; out bstrName: TBSTR): HResult; stdcall; function GetNextDispID(const grfdex: DWORD; const id: TDispID; out nid: TDispID): HResult; stdcall; function GetNameSpaceParent(out unk: IUnknown): HResult; stdcall; end; {$ifdef HAS_RTTI} TObjectDispatchEx = class(TObjectDispatch, IDispatchEx) protected FMetadata: TDispatchExSubclass; procedure GetMetadata; function GetDispID(const bstrName: TBSTR; const grfdex: DWORD; out id: TDispID): HResult; stdcall; function InvokeEx(const id: TDispID; const lcid: LCID; const wflags: WORD; const pdp: PDispParams; out varRes: OleVariant; out pei: TExcepInfo; const pspCaller: PServiceProvider): HResult; stdcall; function DeleteMemberByName(const bstr: TBSTR; const grfdex: DWORD): HResult; stdcall; function DeleteMemberByDispID(const id: TDispID): HResult; stdcall; function GetMemberProperties(const id: TDispID; const grfdexFetch: DWORD; out grfdex: DWORD): HResult; stdcall; function GetMemberName(const id: TDispID; out bstrName: TBSTR): HResult; stdcall; function GetNextDispID(const grfdex: DWORD; const id: TDispID; out nid: TDispID): HResult; stdcall; function GetNameSpaceParent(out unk: IUnknown): HResult; stdcall; end; {$endif} TDispatchExSubclass = class protected DispIDCache: TStringList; public constructor Create; destructor Destroy; override; end; // singleton class TDispatchExMetadataCache = class protected SubclassCache: TStringList; class function FormatInt(i: integer): string; class function UnformatInt(i: string): integer; public constructor Create; destructor Destroy; override; function Add(subclass: TAutoIntfObjectEx): TDispatchExSubclass; overload; {$ifdef HAS_RTTI} function Add(subclass: TObjectDispatchEx): TDispatchExSubclass; overload; {$endif} end; implementation {$ifdef HAS_RTTI} uses Rtti, TypInfo; {$endif} var DispatchEx_MetadataCache: TDispatchExMetadataCache; // declare as"class var" of TDispatchExMetadataCache in modern Delphi { TDispatchExMetadataCache } class function TDispatchExMetadataCache.FormatInt(i: integer): string; begin Result := IntToHex(i, 8); end; class function TDispatchExMetadataCache.UnformatInt(i: string): integer; begin Result := StrToInt('$'+i); end; constructor TDispatchExMetadataCache.Create; begin inherited; SubclassCache := TStringList.Create; // use TObjectDictionary<string,TDispatchExSubclass> in modern Delphi SubclassCache.Sorted := true; // activate binary search end; destructor TDispatchExMetadataCache.Destroy; var i: integer; begin for i := 0 to SubclassCache.Count - 1 do SubclassCache.Objects[i].Free; SubclassCache.Free; inherited; end; function TDispatchExMetadataCache.Add(subclass: TAutoIntfObjectEx): TDispatchExSubclass; var i, f, cnt: integer; pta: PTypeAttr; pfd: PFuncDesc; bstr: TBStr; name: PString; begin i := SubclassCache.IndexOf(subclass.ClassName); if i >= 0 then Result := TDispatchExSubclass(SubclassCache.Objects[i]) else begin Result := TDispatchExSubclass.Create; SubclassCache.AddObject(subclass.ClassName, Result); OleCheck(subclass.DispTypeInfo.GetTypeAttr(pta)); try for f := 0 to pta^.cFuncs - 1 do begin OleCheck(subclass.DispTypeInfo.GetFuncDesc(f, pfd)); try if pfd.wFuncFlags and FUNCFLAG_FRESTRICTED = 0 then begin // exclude system-level methods OleCheck(subclass.DispTypeInfo.GetNames(pfd.memid, @bstr, 1, cnt)); New(name); name^ := bstr; SysFreeString(bstr); Result.DispIDCache.AddObject(FormatInt(pfd.memid), TObject(name)); end; finally subclass.DispTypeInfo.ReleaseFuncDesc(pfd); end; end; finally subclass.DispTypeInfo.ReleaseTypeAttr(pta); end; end; end; {$ifdef HAS_RTTI} function GetNonSystemMethods(aType: TRttiType; aStopType: TRttiType): TArray<TRttiMethod>; function Flatten(const Args: array of TArray<TRttiMethod>): TArray<TRttiMethod>; var i, j, r, len: Integer; begin len := 0; for i := 0 to High(Args) do len := len + Length(Args[i]); SetLength(Result, len); r := 0; for i := 0 to High(Args) do begin for j := 0 to High(Args[i]) do begin Result[r] := Args[i][j]; Inc(r); end; end; end; var nestedMethods: TArray<TArray<TRttiMethod>>; t: TRttiType; depth: Integer; begin t := aType; depth := 0; while (t <> nil) and (t <> aStopType) do begin Inc(depth); t := t.BaseType; end; SetLength(nestedMethods, depth); t := aType; depth := 0; while (t <> nil) and (t <> aStopType) do begin nestedMethods[depth] := t.GetDeclaredMethods; Inc(depth); t := t.BaseType; end; Result := Flatten(nestedMethods); end; function TDispatchExMetadataCache.Add(subclass: TObjectDispatchEx): TDispatchExSubclass; var obj: TObject; i: integer; ctx: TRttiContext; t: TRttiType; method: TRttiMethod; name: PString; begin obj := subclass.Instance; // the real object inside the TObjectDispatch i := SubclassCache.IndexOf(obj.ClassName); if i >= 0 then Result := TDispatchExSubclass(SubclassCache.Objects[i]) else begin Result := TDispatchExSubclass.Create; SubclassCache.AddObject(obj.ClassName, Result); t := ctx.GetType(obj.ClassType); for method in GetNonSystemMethods(t, ctx.GetType(TObject)) do begin // exclude system-level methods New(name); name^ := method.Name; subclass.GetIDsOfNames(GUID_NULL, name, 1, 0, @i); Result.DispIDCache.AddObject(FormatInt(i), TObject(name)); end; end; end; {$endif} { TDispatchExSubclass } constructor TDispatchExSubclass.Create; begin inherited; DispIDCache := TStringList.Create; DispIDCache.Sorted := true; // activate binary search end; destructor TDispatchExSubclass.Destroy; var i: integer; begin for i := 0 to DispIDCache.Count - 1 do Dispose(PString(DispIDCache.Objects[i])); DispIDCache.Free; inherited; end; { TAutoIntfObjectEx } procedure TAutoIntfObjectEx.GetMetadata; begin if FMetadata = nil then FMetadata := DispatchEx_MetadataCache.Add(self); end; function TAutoIntfObjectEx.DeleteMemberByDispID(const id: TDispID): HResult; begin Result := E_NOTIMPL; end; function TAutoIntfObjectEx.DeleteMemberByName(const bstr: TBSTR; const grfdex: DWORD): HResult; begin Result := E_NOTIMPL; end; function TAutoIntfObjectEx.GetDispID(const bstrName: TBSTR; const grfdex: DWORD; out id: TDispID): HResult; begin // TO-DO: implement support for fdexNameEnsure and fdexNameImplicit if desired Result := GetIDsOfNames(GUID_NULL, @bstrName, 1, 0, @id); end; function TAutoIntfObjectEx.GetMemberName(const id: TDispID; out bstrName: TBSTR): HResult; var i: integer; begin GetMetadata; i := FMetadata.DispIDCache.IndexOf(TDispatchExMetadataCache.FormatInt(id)); if i >= 0 then begin bstrName := SysAllocString(PWideChar(WideString(PString(FMetadata.DispIDCache.Objects[i])^))); Result := S_OK; end else Result := DISP_E_UNKNOWNNAME; end; function TAutoIntfObjectEx.GetMemberProperties(const id: TDispID; const grfdexFetch: DWORD; out grfdex: DWORD): HResult; begin Result := E_NOTIMPL; end; function TAutoIntfObjectEx.GetNameSpaceParent(out unk: IUnknown): HResult; begin Result := E_NOTIMPL; end; function TAutoIntfObjectEx.GetNextDispID(const grfdex: DWORD; const id: TDispID; out nid: TDispID): HResult; var i: integer; begin Result := S_FALSE; GetMetadata; if id = DISPID_STARTENUM then begin if FMetadata.DispIDCache.Count > 0 then begin nid := TDispatchExMetadataCache.UnformatInt(FMetadata.DispIDCache[0]); Result := S_OK; end; end else begin i := FMetadata.DispIDCache.IndexOf(TDispatchExMetadataCache.FormatInt(id)); if (i >= 0) and (i < FMetadata.DispIDCache.Count - 1) then begin nid := TDispatchExMetadataCache.UnformatInt(FMetadata.DispIDCache[i+1]); Result := S_OK; end; end; end; function TAutoIntfObjectEx.InvokeEx(const id: TDispID; const lcid: LCID; const wflags: WORD; const pdp: PDispParams; out varRes: OleVariant; out pei: TExcepInfo; const pspCaller: PServiceProvider): HResult; begin if wflags = DISPATCH_CONSTRUCT then // TO-DO: implement constructor semantics if desired Result := DISP_E_MEMBERNOTFOUND else begin { TO-DO: support"this" parameter if desired. From MSDN: When DISPATCH_METHOD is set in wFlags, there may be a"named parameter" for the"this" value. The DISPID will be DISPID_THIS and it must be the first named parameter. } Result := Invoke(id, GUID_NULL, lcid, wflags, pdp^, @varRes, @pei, nil); end; end; {$ifdef HAS_RTTI} { TObjectDispatchEx } procedure TObjectDispatchEx.GetMetadata; begin if FMetadata = nil then FMetadata := DispatchEx_MetadataCache.Add(self); end; function TObjectDispatchEx.DeleteMemberByDispID(const id: TDispID): HResult; begin Result := E_NOTIMPL; end; function TObjectDispatchEx.DeleteMemberByName(const bstr: TBSTR; const grfdex: DWORD): HResult; begin Result := E_NOTIMPL; end; function TObjectDispatchEx.GetDispID(const bstrName: TBSTR; const grfdex: DWORD; out id: TDispID): HResult; begin // TO-DO: implement support for fdexNameEnsure and fdexNameImplicit if desired Result := GetIDsOfNames(GUID_NULL, @bstrName, 1, 0, @id); end; function TObjectDispatchEx.GetMemberName(const id: TDispID; out bstrName: TBSTR): HResult; var i: integer; begin GetMetadata; i := FMetadata.DispIDCache.IndexOf(TDispatchExMetadataCache.FormatInt(id)); if i >= 0 then begin bstrName := SysAllocString(PWideChar(WideString(PString(FMetadata.DispIDCache.Objects[i])^))); Result := S_OK; end else Result := DISP_E_UNKNOWNNAME; end; function TObjectDispatchEx.GetMemberProperties(const id: TDispID; const grfdexFetch: DWORD; out grfdex: DWORD): HResult; begin Result := E_NOTIMPL; end; function TObjectDispatchEx.GetNameSpaceParent(out unk: IUnknown): HResult; begin Result := E_NOTIMPL; end; function TObjectDispatchEx.GetNextDispID(const grfdex: DWORD; const id: TDispID; out nid: TDispID): HResult; var i: integer; begin Result := S_FALSE; GetMetadata; if id = DISPID_STARTENUM then begin if FMetadata.DispIDCache.Count > 0 then begin nid := TDispatchExMetadataCache.UnformatInt(FMetadata.DispIDCache[0]); Result := S_OK; end; end else begin i := FMetadata.DispIDCache.IndexOf(TDispatchExMetadataCache.FormatInt(id)); if (i >= 0) and (i < FMetadata.DispIDCache.Count - 1) then begin nid := TDispatchExMetadataCache.UnformatInt(FMetadata.DispIDCache[i+1]); Result := S_OK; end; end; end; function TObjectDispatchEx.InvokeEx(const id: TDispID; const lcid: LCID; const wflags: WORD; const pdp: PDispParams; out varRes: OleVariant; out pei: TExcepInfo; const pspCaller: PServiceProvider): HResult; begin if wflags = DISPATCH_CONSTRUCT then // TO-DO: implement constructor semantics if desired Result := DISP_E_MEMBERNOTFOUND else begin { TO-DO: support"this" parameter if desired. From MSDN: When DISPATCH_METHOD is set in wFlags, there may be a"named parameter" for the"this" value. The DISPID will be DISPID_THIS and it must be the first named parameter. } Result := Invoke(id, GUID_NULL, lcid, wflags, pdp^, @varRes, @pei, nil); end; end; {$endif} initialization DispatchEx_MetadataCache := TDispatchExMetadataCache.Create; // put in class constructor of TDispatchExMetadataCache in modern Delphi finalization DispatchEx_MetadataCache.Free; // put in class destructor of TDispatchExMetadataCache in modern Delphi end. |
这不是真正的答案,因为它无法解释为什么无法遍历对象(但是Noseratio的答案中有一些解释,但我自己无法完成,因此无法验证它) ,但是可以使用以下javascript代码测试某些功能是否存在:
1 2 | if( typeof window.external == 'object' && ('vibrate' in window.external)) { window.external.vibrate(1000); } |
看看上面的示例,奇怪的是以下代码不起作用(由于\\'in \\'运算符):
1 2 3 4 | // does not work for( var p in window.external ) { alert( p ); } |
因为Firefox确实也实现了window.external对象,但出于其他目的(另请参见:https://developer.mozilla.org/zh-CN/docs/Adding_search_engines_from_web_pages),因此我检查了函数" isAvailable "将通过javascript外部接口导出。要检查它是否是一个真实的接口对象,请执行以下操作(变量\\'o \\'是一个对象):
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | o.gIsExternal = function() // Runs inside an executable webview/webbrowser object? { // Do test only once if( typeof o.gdata.isExternal != 'boolean') { o.gdata.isExternal = false; // When it fails to call isAvailable() it is not there try { window.external.isAvailable(); o.gdata.isExternal = true; } catch(e) {} } return o.gdata.isExternal; }; |
如果您知道更好的解决方案,请告诉我。