TEmbeddedWB/TWebbrowser: window.external is an emp

Question

Usage case (some info first):

I have made some HTML/CSS3/Javascript games that can run on different platforms in WebView/Embedded browser in a platform specific executable. I have designed it myself because I am tired of all the 'frameworks' that be around that told me how simple it is to use their framework. I don't need all the bloat of these frameworks with their impressive classes and stuff, it must be simple as ABC, right? Also because a webview is slower than native code, it must be simple and straight to get the best performance.

So I designed an interface that comes available as variable in javascript, no need to load an extra javascript class (like cordova or phonegap or others). Because I also work with Windows (Windows does not have the possibility to change the name of the object variable to 'publish'), it is accessible by javascript via window.external. This variable will be an object when the html is loaded inside a webview/browser.

Question

This all works pretty well (on different platforms) but the window.external variable seems to be an empty object on Windows, but when you try to call a function like window.external.vibrate(500) it will be executed without error (this function exists in all platform versions of this object).

However, something like typeof window.external.vibrate results in 'undefined'. Traversing the object does nothing, for example:

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

Because of this it is not easy to to test if the external object is a 'real' external object and it is not possible to see what functions are supported (if necessary).

What can I do about this? Do I miss something inhere?

To give you some information, I have followed this 'guide': http://www.delphidabbler.com/articles?article=22.

My code (simplified):

type library:

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.

Object library (class):

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:

I also want to know how to create a function in the type library because it only allows to create procedures or properties (but properties are not supported like on Android).

EDIT:

See also my answer but question is still open because of the PS above.

Answer 1

To get this working:

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

You would need to implement IDispatchEx on your external object, specifically IDispatchEx::GetNextDispID and IDispatchEx::GetMemberName. This is how JavaScript iterates through COM object properties.

You could find some more details about IDispatchEx here.

Answer 2

It's not a real answer because it doesn't explain why traversing the object is not possible (but there is some explanation in the answer of Noseratio but unable to get it done myself so not able to verify it), but okay I can test if some function exists by using the following javascript code:

if( typeof window.external == 'object' && ('vibrate' in window.external))
 { window.external.vibrate(1000); }

When you take a look at the example above, it is weird that the following code doesn't work (because of the 'in' operator):

 // does not work
for( var p in window.external ) {
   alert( p );
}

Because Firefox does also implement a window.external object but with other intent (see also: https://developer.mozilla.org/en-US/docs/Adding_search_engines_from_web_pages), I check for the function 'isAvailable' that will be exported by the javascript external interface. To check if it is a real interface object, I do the following (the variable 'o' is an object):

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

If you know a better solution please let me know.

Answer 3

It is possible to use a much simpler approach to implement external methods in Delphi, using the late-bound functionality provided by ObjComAuto.TObjectDispatch.

This way you don't need to define any interfaces nor a type library. All what you need is a simple class implementing the desired events, and the extended RTTI info provided by $METHODINFO.

You can implement procedures and functions, and receive Delphi types or javascript objects as parameters. Javascript objects can also be used from Delphi (both properties and methods can be accessed).

Example: (just drop a TEmbeddedWB in a form)

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>'

      +'  <script>'
      +'    function testGet(msg) {'
      +'      alert(external.MyGet(msg));'
      +'    }'
      +'  </script>'
      +'</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;

Note:

Javascript arrays are sparse, so you can't access them from Delphi using the usual myArray[3] syntax. Instead you need to use the index as if it were a property, i.e. some kind of myArray.3. This is not directly supported by Delphi, but using ComObj.GetDispatchPropValue: GetDispatchPropValue(myArray, '3'). More info here.

Edit:

See my other answer for info on how to iterate thru window.external methods.

Answer 4

How to create functions in the type library

Automation methods are functions returning HRESULT, converted to procedures by Delphi safecall calling convention, that automatically manage HRESULTs.

In addition to in and out parameters, automation methods also support one retval parameter. Delphi converts methods with it to a safecall function using the parameter type as the result type of the function. The retval parameter must be the last one and, as an out parameter, has to be a pointer (e.g., long* instead of long for integers, BSTR* instead of BSTR for strings, ...).

So, if you declare in the type library editor a parameter with a pointer type and the out and retval modifiers, it will appear in the *_TLB.pas file as a safecall function. This is also the way that property getters are created.

Iterating thru window.external methods

As Noseratio said, the dispatch object must implement IDispatchEx.

I've made a library with two classes which extend TAutoIntfObject and TObjectDispatch so they implement the basic functionality of IDispatchEx.

So if you inherit your TWebBrowserBridge from TAutoIntfObjectEx instead of TAutoIntfObject, now the iterating will work.

To implement GetNextDispID and GetMemberName, both classes need to extract metadata about the methods of the class:

• TAutoIntfObjectEx obtains it from the ITypeInfo provided by the type library.

• TObjectDispatchEx obtains it from the extended RTTI provided by {$METHODINFO ON}.
  This needs at least Delphi 2010. See my other answer for info on how to use TObjectDispatch.

The metadata is used in each iteration of the for in, so, for each class inherited from one of them, it is extracted the first time it's needed and cached for subsequent uses. This means a two-level cache: one for each subclass inherited from one of the extended classes, and other for the dispids and names of each subclass' methods.

I've used a somewhat rough approach with sorted TStringList and binary search for both caches. The first level can be replaced with an unsorted map (like a hashtable, e.g. TObjectDictionary in modern Delphi versions), but the second needs also ordering, so a sorted map (like a Red-black tree) is the right way.

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.