
  #case capital

  typedef struct _guid
  {
    a as dword
    b as word
    c as word
    d[8] as byte
  } guid, GUID

  'typedef struct {
  'dword d1
  'word  w1,w2
  'byte  b1,b2,b3,b4,b5,b6,b7,b8
  '} GUID,CLSID,*refiid
  '
  '#define DEFINE_GUID(gu,d1,w1,w2,b1,b2,b3,b4,b5,b6,b7,b8) GUID gu<=(d1,w1,w2,b1,b2,b3,b4,b5,b6,b7,b8)


  'standalone definitions ad hoc

  #define __in
  #define __out
  #define __in_opt      optional
  #define __out_opt     optional
  #define __RPC__in_opt optional

  typedef void      VOID
  typedef int       HRESULT
  typedef sys       HANDLE,HWND,WMSG,WPARAM,LPARAM
  typedef dword     DWORD,ULONG,UINT,*LPDWORD
  typedef qword     ULONGLONG
  typedef bool      BOOL
  typedef wchar     *LPCWSTR,*LPWSTR
  typedef word      USHORT
  typedef void      *LPVOID
  typedef guid      *LPCLSID, *REFCLSID, *REFIID
  typedef void      *LPVOID,*COSERVERINFO,*pvobject
  typedef sys       LPOLESTR, LPCOLESTR
  typedef uint      LCID
  typedef long      DISPID

  typedef void      ITypeInfo 'to be defined


  '
  typedef void SPNOTIFYCALLBACK, ISpNotifyCallback, ISpNotifySink 
  typedef void ISpObjectToken,IStream,ISpStreamFormat,SPVOICESTATUS,SPVPRIORITY,SPEVENTENUM       
  typedef void SPEVENT,SPEVENTSOURCEINFO

  'typedef sys SPEVENT,SPEVENTSOURCEINFO

  uses COM\VariantUtil
  '
  typedef wbstring BSTR
  typedef dword *ULONG_PTR
  typedef VARIANT VARIANTARG

  typedef struct tagDISPPARAMS {
  VARIANTARG *rgvarg
  DISPID     *rgdispidNamedArgs
  UINT       cArgs
  UINT       cNamedArgs
  } DISPPARAMS


   typedef struct tagEXCEPINFO {
   WORD wCode
   WORD wReserved
   BSTR bstrSource
   BSTR bstrDescription
   BSTR bstrHelpFile
   DWORD dwHelpContext
   ULONG_PTR pvReserved
   ULONG_PTR pfnDeferredFillIn
   HRESULT scode
   } EXCEPINFO


  'from Unknwn.h

  extern virtual

  --------------
  class IUnknown
  ==============

    public

    HRESULT QueryInterface(REFIID id, pvObject* ppv)
    ULONG   AddRef()
    ULONG   Release()

  end class

  typedef IUnknown *LPUNKNOWN


  ---------------
  class IDispatch
  ===============

  public

  extends IUnknown

  HRESULT GetTypeInfoCount(
  UINT *pctinfo)

  HRESULT GetTypeInfo(
  UINT      iTInfo,
  LCID      lcid,
  ITypeInfo **ppTInfo)

  HRESULT GetIDsOfNames(
  REFIID   riid,
  LPOLESTR *rgszNames,
  UINT     cNames,
  LCID     lcid,
  DISPID   *rgDispId)

  HRESULT Invoke(
  DISPID     dispIdMember,
  REFIID     riid,
  LCID       lcid,
  WORD       wFlags,
  DISPPARAMS *pDispParams,
  VARIANT    *pVarResult,
  EXCEPINFO  *pExcepInfo,
  UINT       *puArgErr)

  end class

'#recordof idispatch



  extern lib "ole32.dll"

  HRESULT CLSIDFromProgID(
    LPCOLESTR lpszProgID,
    LPCLSID   lpclsid
  )


  HRESULT CLSIDFromString(
    LPCOLESTR lpsz,
    LPCLSID   lpclsid
  )


  HRESULT CoInitialize(
    __in_opt  LPVOID pvReserved
  );


  void CoUninitialize(void);



  HRESULT CoCreateInstance(
    __in   REFCLSID rclsid,
    __in   LPUNKNOWN pUnkOuter,
    __in   DWORD dwClsContext,
    __in   REFIID riid,
    __out  LPVOID *ppv
  )



  HRESULT CoGetClassObject(
    __in      REFCLSID rclsid,
    __in      DWORD dwClsContext,
    __in_opt  COSERVERINFO pServerInfo,
    __in      REFIID riid,
    __out     LPVOID *ppv
  );


  'HRESULT __stdcall DllGetClassObject(
  '  __in   REFCLSID rclsid,
  '  __in   REFIID riid,
  '  __out  LPVOID *ppv
  ');

  'HRESULT __stdcall DllCanUnloadNow(void);



  HRESULT CoRegisterClassObject(
    __in   REFCLSID rclsid,
    __in   LPUNKNOWN pUnk,
    __in   DWORD dwClsContext,
    __in   DWORD flags,
    __out  LPDWORD lpdwRegister
  );



  HRESULT CoRevokeClassObject(
    __in  DWORD dwRegister
  );




  end extern

  type VirtualInterface
  sys *vfun
  end type

  extern
  ! * vmethod
  end extern

  '@vmethod=*(@voice.vfun+80) : err=vmethod(@voice,l"ok",0,0) 'speak
  'CallByOffset voice(80) (l"Hello World",1,0) 'speak
  '
  def CallByOffset
    'assuming offset for 32bit
    #if sizeof sys = 8
       @vmethod=*(@%1.vfun + %2 + %2)
    #else
      @vmethod=*(@%1.vfun + %2)
    #endif 
    err=vmethod(@%1,%3)
  end def

   '@vmethod=voice.vfun[20]: err=vmethod(@voice,l"ok",0,0) 'speak
  'CallByIndex voice[20] (l"Hello World",1,0) 'speak
  '
  def CallByIndex
    scope
    indexbase 0
    @vmethod=%1.vfun[%2] : err=vmethod(@%1,%3)
    end scope
  end def

  % CLSCTX_INPROC_SERVER            = 0x1
  % CLSCTX_INPROC_HANDLER           = 0x2
  % CLSCTX_LOCAL_SERVER             = 0x4
  % CLSCTX_INPROC_SERVER16          = 0x8
  % CLSCTX_REMOTE_SERVER            = 0x10
  '
  int context = 5 '1 2 4 8
  '
  % LOCALE_USER_DEFAULT 0x400 '0x400 user_default english 0x809 uk '0x409 usa


  int Err

  def CreateGuid
    GUID %1
    guidval %1,%2
  end def
  '
  CreateGuid IID_NULL                      "{00000000-0000-0000-0000-000000000000}"
  CreateGuid IID_IClassFactory             "{00000001-0000-0000-C000-000000000046}"
  CreateGuid IID_IUnknown                  "{00000000-0000-0000-C000-000000000046}"
  CreateGuid IID_IDispatch                 "{00020400-0000-0000-C000-000000000046}"
  CreateGuid IID_IConnectionPointContainer "{B196B284-BAB4-101a-B69C-00AA00341D07}"

    'CLSID_WebBrowser                GUID    <08856F961h, 0340Ah, 011D0h, <0A9h, 06Bh, 000h, 0C0h, 04Fh, 0D7h, 005h, 0A2h>>
    'IID_IUnknown                    GUID    <000000000H, 00000H, 00000H, <0C0H, 000H, 000H, 000H, 000H, 000H, 000H, 046H>>
    'IID_IDispatch                   GUID    <000020400H, 00000H, 00000H, <0C0H, 000H, 000H, 000H, 000H, 000H, 000H, 046H>>
    'IID_IOleObject                  GUID    <000000112H, 00000H, 00000H, <0C0H, 000H, 000H, 000H, 000H, 000H, 000H, 046H>>
    'IID_IOleClientSite              GUID    <000000118H, 00000H, 00000H, <0C0H, 000H, 000H, 000H, 000H, 000H, 000H, 046H>>
    'IID_IOleInPlaceSite             GUID    <000000119H, 00000H, 00000H, <0C0H, 000H, 000H, 000H, 000H, 000H, 000H, 046H>>
    'IID_IDocHostUIHandler           GUID    <0bd3f23c0H, 0d43eH, 011cfH, <089H, 03bH, 000H, 0aaH, 000H, 0bdH, 0ceH, 01aH>>
    'IID_IDocHostShowUI              GUID    <0c4d244b0H, 0d43eH, 011cfH, <089H, 03bH, 000H, 0aaH, 000H, 0bdH, 0ceH, 01aH>>
    'DIID_DWebBrowserEvents2         GUID    <034A715A0H, 06587H, 011D0H, <092H, 04AH, 000H, 020H, 0AFH, 0C7H, 0ACH, 04DH>>
    'IID_IWebBrowser                 GUID    <0EAB22AC1H, 030C1H, 011CFH, <0A7H, 0EBH, 000H, 000H, 0C0H, 05BH, 0AEH, 00BH>>
    'IID_IOleInPlaceObject           GUID    <000000113H, 00000H, 00000H, <0C0H, 000H, 000H, 000H, 000H, 000H, 000H, 046H>>
    'IID_IConnectionPointContainer   GUID    <0B196B284H, 0BAB4H, 0101AH, <0B6H, 09CH, 000H, 0AAH, 000H, 034H, 01DH, 007H>>


  ------------------------------------------------
  macro ConnectByDispatch(aname,interface,   name)
  ================================================
  GUID          ObjectGuid
  'HRESULT       hr
  'LPUNKNOWN     pUnkOuter
  '
  wstring name=aname
  if unic(name)=123 '{'
    err=CLSIDFromString(strptr name, ObjectGuid) 'passing a guid string '{...}'
  else
    err=CLSIDFromProgID(strptr name, ObjectGuid) 'passing a progid string 'sapi.voice'
  endif
  if not err
    //hr =  CoCreateInstance( clsid, NULL, CLSCTX_INPROC_SERVER, IID_IDispatch,(void**)&IDisp);
    //if ( hr != S_OK ){
    //ok maybe its an activex exe..
    //hr = CoCreateInstance( clsid, NULL, CLSCTX_LOCAL_SERVER, IID_IDispatch,(void**)&IDisp);
    err=CoCreateInstance ObjectGuid, null, CLSCTX_INPROC_SERVER, IID_IDispatch, interface
    if err
      err=CoCreateInstance ObjectGuid, null, CLSCTX_LOCAL_SERVER, IID_IDispatch, interface
    endif
  endif
  end macro


  -----------------------------
  macro ConnectByName(name,obj)
  =============================
  IDispatch *obj
  ConnectByDispatch(name, obj)
  end macro

  -------------------------
  def CreateInterfaceByName
  =========================
  IDispatch *%2
  ConnectByDispatch(%1, %2)
  end def


  'capitalised symbols for wflag
  % METHOD 1
  % CALL   1
  % GET    2
  % LET    4
  % SET    8



  -----------------------------------------------------------------------------------------------------------------
  function CallByNameV(IDispatch *vi, word flag=1, wchar *name, VARIANT *va=null, int c=0, VARIANT *vr=null) as int
  =================================================================================================================
  sys sl=strptr name
  uint id
  err = vi.GetIDsOfNames IID_NULL, sl, 1, LOCALE_USER_DEFAULT, id
  '
  if not err
    'enum vbCallType{ VbMethod = 1, VbGet = 2, VbLet = 4, VbSet = 8 };
    'reverse order assignment
    'VARIANT vb[8]
    VARIANT *vb=getmemory(c*sizeof(VARIANT))
    if c
      indexbase 1
      int i,j
      j=c
      for i=1 to c
        'args in reverse order
        vb[i]=va[j]
        if flag=8 'SET
          'vb[i].vt=VT_DISPATCH  ??
          'flag=1 'METHOD
        endif
        j--
      next
    endif
    '
    DISPPARAMS pa
    @pa.rgvarg=@vb
    pa.cargs=c
    if flag=4 'LET
      int pp=-3 'DISPID_PROPERTYPUT '0xfffffffd
      @pa.rgdispidNamedArgs=@pp
      pa.cNamedArgs=1
    endif
    //hr = IDisp->Invoke( dispid, IID_NULL, LOCALE_USER_DEFAULT, CallType, &dispparams, &retVal, NULL, NULL);
    err=vi.Invoke( id, IID_NULL, LOCALE_USER_DEFAULT, flag, pa, vr, null, null)
  endif
  '
  freememory @vb
  return err
  end function

  -----------------------------------------------------------------------------------------------------------
  function CallByNameSV(IDispatch *vi, word flag, BSTR name, BSTR *sa=null, int c=0, VARIANT *vr=null) as int
  ===========================================================================================================
  int i
  VARIANT va[8] 'up to 8 params
  indexbase 1
  '
  int e=c
  if flag=8
    if c=0
      flag=2
    endif
  endif
  for i=1 to e
   va[i].vt=VT_BSTR
   ?va[i].bstrVal=?sa[i] 'direct coupling
  next
  '
  err=CallByNameV(vi, flag, name, va, c, vr) 'VARIANT morph
  '
  for i=1 to e
    frees sa[i]
  next
  return err
  end function

  -------------------------------------------------------------------------------------------------------
  function CallByNameS(IDispatch *vi, word flag, BSTR name, BSTR *sa=null, int c=0, BSTR *sr=null) as int
  =======================================================================================================
  int i
  VARIANT va[8], vr 'up to 8 params
  indexbase 1
  '
  if @sr
   vr.vt=VT_BSTR
   ?vr.bstrVal=?sr 'direct coupling
  endif
  for i=1 to c
   va[i].vt=VT_BSTR
   ?va[i].bstrVal=?sa[i] 'direct coupling
  next
  '
  err=CallByNameV(vi, flag, name, va, c, vr) 'VARIANT morph
  '
  for i=1 to c
    frees sa[i]
  next
  if @sr
    if vr.vt<>VT_BSTR
      VariantChangeType(vr,vr,0,VT_BSTR)
    endif
    ?sr=?vr.bstrval 'caller will free this string
  endif
  return err
  end function


  macro CmdByName(vi,nf)
    CallByNameS(vi,1,nf)
  end macro

  'macro CallByName(vi,nf,sa,sr)
  '  #ifdef sa
  '    #ifndef sr
  '      def sr null
  '    #endif
  '    CallByNameS(vi,1,nf,sa,countof(),sr)
  '  #else
  '    CallByNameS(vi,1,nf) 'CmdByName
  '  #endif
  'end macro

  macro CallByName(vi,nf,#rest)
    #ifndef #rest
       CallByNameS(vi,1,nf)
    #else
      CallByNameS(vi,1,nf,BSTR {#rest},countof() )
    #endif
  end macro

  macro GetByName(vi,nf,sr)
    CallByNameS(vi,2,nf,null,0,sr)
  end macro

  macro LetByName(vi,nf,sa)
    CallByNameS(vi,4,nf,sa, 1)
  end macro

  macro SetByName(vi,nf,sa,rv)
    'uses variant byref to return values
    CallByNameSV(vi,1,nf,sa, countof, rv) 'METHOD
  end macro

  macro ObjectByName(vi, fl, nf,sa, c, sr,   rv)
    idispatch *sr
    VARIANT rv
    CallByNameSV(vi, fl, nf, sa, c, rv) 'METHOD
    @sr=@rv.pdispVal
    'nullify variant ready for potential reiteration
    'rv.vt=0
    '(sys) rv.llval=0
  end macro


