Addons/general/pcall/test typeinfo

From J Wiki
Jump to navigation Jump to search
   require 'dll convert general/pcall'

   b=: #~ [: $&1 0 #
   h=: ([: ;:^:_1"1 [: <"1 hfd)@(([: , _4 (_2&(3!:4))@|.\ ])^:(2=3!:0))
   us=: 0&(3!:4)
   mi=: [: {.@memr ,&(0 1,JINT)
   mc=: ,&0@] memr@, ,&JCHAR@[
   mI=: 4 : '{.memr y,x,1,JINT'
   mS=: 4 : '{.us memr y,x,2,JCHAR'
   si=: I.@E.~   NB. TYPEATTR si 'Cfun'

   GUID=: 'WWWWXXYYZZZZZZZZ'
   VAR1=: 'VtR1R2R3Valu'
   TYPEATTR=: GUID,'LcidReseCtorDtorScheSinsTpknCfCvCtSvBaTfMjMnAliaIdld'

   'CLSCTX_INPROC_SERVER CLSCTX_LOCAL_SERVER'=: 16b0001 16b0004
   CTX=: CLSCTX_INPROC_SERVER+CLSCTX_LOCAL_SERVER

   IUnknown=: ;:'QueryInterface AddRef Release'
   IDispatch=: IUnknown,;:'GetTypeInfoCount GetTypeInfo GetIDsOfNames Invoke'
   IJ=: IDispatch,;:'Do Show Log IsBusy Break Quit Get Set GetM SetM ErrorText ErrorTextM Clear Transpose ErrorTextB GetB SetB DoR'
   ITypeInfo=: IUnknown,;:'GetTypeAttr GetTypeComp GetFuncDesc GetVarDesc GetNames GetRefTypeOfImplType GetImplTypeFlags GetIDsOfNames Invoke GetDocumentation GetDllEntry GetRefTypeInfo AddressOfMember CreateInstance GetMops GetContainingTypeLib ReleaseTypeAttr ReleaseFuncDesc ReleaseVarDesc'

   h clsid=. 2{::'ole32 CLSIDFromProgID i *w *c'cd 'JDLLServer';1#GUID
EA05EB21 B31ACF11 A2AC8FF7 0874C460
   h iid=. 2{::'ole32 CLSIDFromString i *w *c'cd '{21EB05EC-1AB3-11CF-A2AC-8FF70874C460}';1#GUID
EC05EB21 B31ACF11 A2AC8FF7 0874C460

   h ip=. {._1{::'ole32 CoCreateInstance i *c i i *c *i'cd clsid;0;CTX;iid;,_2
10B4018
   h vt=. mi ip                        NB. vtable of J interface pointer
1012D380

   h pDoR=. mi vt+4*IJ i.<'DoR'        NB. funcion pointer from vtable
100512D0
   res=. i.4%~#VAR1                    NB. alloc VARIANT for BSTR
   'cp4 > i i i *w *i *i' pcall pDoR;ip;'9!:14$0';res;,_2
0
   ] len=. mi _4+{:res                 NB. BSTR length
46
   b val=. len mc {:res                NB. BSTR string value
j601/2006-11-17/17:05


   'oleaut32 VariantClear > i *i' cd <res  NB. free BSTR, 'cause we own it
0

   h pGetTypeInfo=. mi vt+4*IJ i.<'GetTypeInfo'
100510B0
   h ti=. {._1{::'cp4 i i i i i *i' pcall pGetTypeInfo;ip;0;0;,_2
8BE04
   h tivt=. mi ti
77126770

   pta=. ,_2
   h pGetTypeAttr=. mi tivt+4*ITypeInfo i.<'GetTypeAttr'
77126B7D
   'cp2 > i i i *i' pcall pGetTypeAttr;ti;pta
0
   ] cf=. (TYPEATTR si 'Cf') mS pta    NB. count of functions in J interface
25
   #IJ
25

   pfd=. ,_2
   h pGetFuncDesc=. mi tivt+4*ITypeInfo i.<'GetFuncDesc'
7712AAC7
   'cp3 > i i i i *i' pcall pGetFuncDesc;ti;(IJ i.<'IsBusy');pfd
0
   h mid=. 0 mI pfd
60020003

   res=. ,_2
   h pGetDocumentation=. mi tivt+4*ITypeInfo i.<'GetDocumentation'
77126F0A
   h 'cp6 > i i i  i *i  i i i' pcall pGetDocumentation;ti;mid;res;0;0;0
0
   ] len=. mi _4+res
12
   b val=. len mc res                  NB. name of function
IsBusy

   'oleaut32 SysFreeString > i i' cd res
32

   h pRelease=. mi tivt+4*ITypeInfo i.<'Release'
771268EB
   'cp1 > i i i' pcall pRelease;ti
1

   h pRelease=. mi vt+4*IJ i.<'Release'    NB. Release from IUnknown interface
10051060
   'cp1 > i i i' pcall pRelease;ip      NB. destroys J object, RefCount=0
0