关于javascript:TEmbeddedWB / TWebbrowser:window.external是一个空对象,但可以调用函数,为什么它首先是”空”?

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 /浏览器中时,此变量将是一个对象。

问题

这一切都很好(在不同平台上),但是window.external变量在Windows上似乎是一个空对象,但是当您尝试调用window.external.vibrate(500)之类的函数时,它将无错误执行(该函数存在)在此对象的所有平台版本中)。

但是,类似typeof window.external.vibrate的结果将导致'undefined'。遍历对象不执行任何操作,例如:

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中实现external方法。

这样,您无需定义任何接口或类型库。您需要的只是一个实现所需事件的简单类,以及$ 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数组稀疏,因此您无法使用常用的myArray[3]语法从Delphi访问它们。相反,您需要像使用索引一样将其当作属性使用,即某种myArray.3。 Delphi不直接支持此功能,而是使用ComObj.GetDispatchPropValue:GetDispatchPropValue(myArray, '3')。更多信息在这里。

编辑:

有关如何通过window.external方法进行迭代的信息,请参见我的其他答案。


要使其正常工作,请执行以下操作:

1
2
3
for( var p in window.external ) {
   alert( p );
}

您将需要在external对象上实现IDispatchEx,特别是IDispatchEx::GetNextDispIDIDispatchEx::GetMemberName。这就是JavaScript遍历COM对象属性的方式。

您可以在此处找到有关IDispatchEx的更多详细信息。


如何在类型库中创建函数

自动化方法是返回HRESULT的函数,这些函数已通过Delphi safecall调用约定转换为过程,从而自动管理HRESULT。

除了输入和输出参数外,自动化方法还支持一个retval参数。 Delphi使用参数类型作为函数的结果类型,将方法转换为安全调用函数。 retval参数必须是最后一个参数,并且作为out参数,必须是一个指针(例如,对于整数,使用long*代替long,对于字符串使用BSTR*代替BSTR,...)。

因此,如果您在类型库编辑器中声明一个带有指针类型以及out和retval修饰符的参数,它将作为安全调用函数出现在* _TLB.pas文件中。这也是创建属性获取器的方式。

通过window.external方法进行迭代

正如Noseratio所说,调度对象必须实现IDispatchEx。

我已经制作了一个包含两个扩展TAutoIntfObjectTObjectDispatch的类的库,因此它们实现了IDispatchEx的基本功能。

因此,如果您从TAutoIntfObjectEx继承了TWebBrowserBridge而不是TAutoIntfObject,则现在可以进行迭代。

要实现GetNextDispIDGetMemberName,两个类都需要提取有关该类方法的元数据:

  • TAutoIntfObjectEx从类型库提供的ITypeInfo中获取它。

  • TObjectDispatchEx{$METHODINFO ON}提供的扩展RTTI中获取它。
    这至少需要Delphi2010。有关如何使用TObjectDispatch

    的信息,请参见我的其他答案。

元数据用于的每次迭代,因此,对于从其中一个继承的每个类,元数据都将在第一次需要时提取并缓存以备后用。这意味着两级缓存:一个用于从扩展类之一继承的每个子类,另一个用于每个子类的方法的名称和名称。

我对排序后的TStringList使用了某种粗略的方法,并且对两个缓存都进行了二进制搜索。第一级可以用未排序的映射替换(例如哈希表,例如现代Delphi版本中的TObjectDictionary),但是第二级也需要排序,因此排序的映射(例如红黑树)是正确的方法。铅>

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;
};

如果您知道更好的解决方案,请告诉我。