My proposed Idispatch implementation:
---------------------------------------------------------------------
function ConnectByDispatch(wchar *name, IDispatch **interface) as int
=====================================================================
GUID ObjectGuid
HRESULT hr
LPUNKNOWN pUnkOuter
'
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
err=CoCreateInstance ObjectGuid, null, context, IID_IDispatch, @interface
endif
'if err then print "Connection error code: " err
return err
end function
-----------------------------
macro ConnectByName(name,obj)
=============================
IDispatch *obj
ConnectByDispatch(name, obj)
end macro
-------------------------
def CreateInterfaceByName
=========================
IDispatch *%2
ConnectByDispatch(%1, %2)
end def
% METHOD 1
% GET 2
% LET 4
% LET 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 };
if c>1
'reverse order assignment
int i,j
VARIANT vb
j=c+1
for i=1 to c
j--
if i>=j then exit for
'swap
vb=va[j]
va[j]=va[i]
va[i]=vb
next
endif
'
DISPPARAMS pa
@pa.rgvarg=@va
pa.cargs=c
if flag>2 '4 8
int pp=-3 'DISPID_PROPERTYPUT '0xfffffffd
@pa.rgdispidNamedArgs=@pp
pa.cNamedArgs=1
endif
err=vi.Invoke( id, IID_NULL, LOCALE_USER_DEFAULT, flag, pa, vr, null, null)
endif
'
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 CallByName(vi,nf,sa,sr) CallByNameS(vi,1,nf,sa,countof,sr)
macro GetByName(vi,nf,sr) CallByNameS(vi,2,nf,null,0,sr)
macro LetByName(vi,nf,sa) CallByNameS(vi,4,nf,sa, 1)
macro SetByName(vi,nf,sa) CallByNameS(vi,8,nf,sa, 1)
