COM 64

[JRS]

I was able to get the VB6 OCX version of the Online Dictionary example running.

Check it out on the AllBASIC.info forum.

[JRS]

It also seems that there is no interest to work with COM, other that automating Office with disphelper.

Disphelper looks a lot like the CallByName COM interface.

It could be a quick way for for Charles to add COM / OLE automation support to O2.

[JRS]

Charles,

It doesn't look like Chris Boss is going to make his EZGUI available to Oxygen Basic. Would it be possible to cobble together a CallByName COM/OLE automation interface? I could then reuse my efforts with VB6 OCX forms in O2.

Here is José Roca's CallByName in PowerBASIC.

CallByName.INC

Code: QBasic/QuickBASIC

1. %DISPATCH_METHOD         = 1
2. %DISPATCH_PROPERTYGET    = 2
3. %DISPATCH_PROPERTYPUT    = 4
4. %DISPATCH_PROPERTYPUTREF = 8
5.  
6. ' ********************************************************************************************
7. ' EXCEPINFO structure
8. ' ********************************************************************************************
9. TYPE EXCEPINFO
10.    wCode AS WORD               ' An error code describing the error.
11.    wReserved AS WORD           ' Reserved
12.    bstrSource AS DWORD         ' Source of the exception.
13.    bstrDescription AS DWORD    ' Textual description of the error.
14.    bstrHelpFile AS DWORD       ' Help file path.
15.    dwHelpContext AS DWORD      ' Help context ID.
16.    pvReserved AS DWORD         ' Reserved.
17.    pfnDeferredFillIn AS DWORD  ' Pointer to function that fills in Help and description info.
18.    scode AS DWORD              ' An error code describing the error.
19. END TYPE
20. ' ********************************************************************************************
21.  
22. ' ********************************************************************************************
23. ' Helper function to calculate the VTable address.
24. ' ********************************************************************************************
25. FUNCTION TB_VTableAddress (BYVAL pthis AS DWORD, BYVAL dwOffset AS DWORD) AS DWORD
26.    LOCAL ppthis AS DWORD PTR
27.    LOCAL pvtbl AS DWORD PTR
28.    LOCAL ppmethod AS DWORD PTR
29.    ppthis = pthis
30.    pvtbl = @ppthis
31.    ppmethod = pvtbl + dwOffset
32.    FUNCTION = @ppmethod
33. END FUNCTION
34. ' ********************************************************************************************
35.  
36. ' ********************************************************************************************
37. ' Maps a single member to a corresponding DispID, which can be used on subsequent calls to
38. ' IDispatch_Invoke.
39. ' Parameters:
40. ' riid
41. '   Reserved for future use. Must be IID_NULL.
42. ' strName
43. '   Name to be mapped.
44. ' rgDispId
45. '   Retrieved DispID value.
46. ' Return Value:
47. '   The return value obtained from the returned HRESULT is one of the following:
48. '   %S_OK                Success
49. '   %E_OUTOFMEMORY       Out of memory
50. '   %DISP_E_UNKNOWNNAME  One or more of the names were not known. The returned array of DISPIDs
51. '                        contains DISPID_UNKNOWN for each entry that corresponds to an unknown name.
52. '   %DISP_E_UNKNOWNLCID  The locale identifier (LCID) was not recognized.
53. ' ********************************************************************************************
54. DECLARE FUNCTION Proto_IDispatch_GetIDOfName (BYVAL pthis AS DWORD, BYREF riid AS GUID, BYref rgszNames AS STRING, BYVAL cNames AS DWORD, BYVAL lcid AS DWORD, BYref rgdispid AS LONG) AS DWORD
55. FUNCTION IDispatch_GetIDOfName (BYVAL pthis AS DWORD, BYref strName AS STRING, BYref rgdispid AS LONG) AS DWORD
56.    LOCAL HRESULT AS DWORD
57.    LOCAL pmethod AS DWORD
58.    LOCAL riid AS guid
59.    IF pthis = 0 THEN EXIT FUNCTION
60.    pmethod = TB_VTableAddress (pthis, 20)
61.    CALL DWORD pmethod USING Proto_IDispatch_GetIDOfName (pthis, riid, strName, 1, 0, rgdispid) TO HRESULT
62.    FUNCTION = HRESULT
63. END FUNCTION
64. ' ********************************************************************************************
65.  
66. ' ********************************************************************************************
67. ' Provides access to properties and methods exposed by an object. The dispatch function DispInvoke
68. ' provides a standard implementation of IDispatch_Invoke.
69. ' Parameters:
70. ' dispIdMember
71. '   Identifies the member. Use GetIDsOfNames or the object's documentation to obtain the dispatch identifier.
72. ' riid
73. '    Reserved for future use. Must be IID_NULL.
74. ' lcid
75. '   The locale context in which to interpret arguments. The lcid is used by the GetIDsOfNames
76. '   function, and is also passed to IDispatch_Invoke to allow the object to interpret its
77. '   arguments specific to a locale.
78. '   Applications that do not support multiple national languages can ignore this parameter.
79. ' wFlags
80. '   Flags describing the context of the Invoke call, include:
81. '     %DISPATCH_METHOD
82. '       The member is invoked as a method. If a property has the same name, both this and the
83. '       %DISPATCH_PROPERTYGET flag may be set.
84. '     %DISPATCH_PROPERTYGET
85. '       The member is retrieved as a property or data member.
86. '     %DISPATCH_PROPERTYPUT
87. '       The member is changed as a property or data member.
88. '     %DISPATCH_PROPERTYPUTREF
89. '       The member is changed by a reference assignment, rather than a value assignment. This
90. '       flag is valid only when the property accepts a reference to an object.
91. ' pDispParams
92. '   Pointer to a structure containing an array of arguments, an array of argument DISPIDs for
93. '   named arguments, and counts for the number of elements in the arrays.
94. ' pVarResult
95. '   Pointer to the location where the result is to be stored, or NULL if the caller expects no
96. '   result. This argument is ignored if DISPATCH_PROPERTYPUT or DISPATCH_PROPERTYPUTREF is specified.
97. ' pExcepInfo
98. '   Pointer to a structure that contains exception information. This structure should be filled
99. '   in if DISP_E_EXCEPTION is returned. Can be NULL.
100. ' puArgErr
101. '   The index within rgvarg of the first argument that has an error. Arguments are stored in
102. '   pDispParams->rgvarg in reverse order, so the first argument is the one with the highest index
103. '   in the array. This parameter is returned only when the resulting return value is
104. '   %DISP_E_TYPEMISMATCH or %DISP_E_PARAMNOTFOUND. This argument can be set to null.
105. ' Return Value:
106. '   The return value obtained from the returned HRESULT is one of the following:
107. '   %S_OK                     Success
108. '   %DISP_E_BADPARAMCOUNT     The number of elements provided to DISPPARAMS is different from the
109. '                             number of arguments accepted by the method or property.
110. '   %DISP_E_BADVARTYPE        One of the arguments in rgvarg is not a valid variant type.
111. '   %DISP_E_EXCEPTION         The application needs to raise an exception. In this case, the
112. '                             structure passed in pExcepInfo should be filled in.
113. '   %DISP_E_MEMBERNOTFOUND    The requested member does not exist, or the call to Invoke tried to
114. '                             set the value of a read-only property.
115. '   %DISP_E_NONAMEDARGS       This implementation of IDispatch does not support named arguments.
116. '   %DISP_E_OVERFLOW          One of the arguments in rgvarg could not be coerced to the specified type.
117. '   %DISP_E_PARAMNOTFOUND     One of the parameter DISPIDs does not correspond to a parameter on
118. '                             the method. In this case, puArgErr should be set to the first
119. '                             argument that contains the error.
120. '   %DISP_E_TYPEMISMATCH      One or more of the arguments could not be coerced. The index within
121. '                             rgvarg of the first parameter with the incorrect type is returned
122. '                             in the puArgErr parameter.
123. '   %DISP_E_UNKNOWNINTERFACE  The interface identifier passed in riid is not IID_NULL.
124. '   %DISP_E_UNKNOWNLCID       The member being invoked interprets string arguments according to
125. '                             the LCID, and the LCID is not recognized. If the LCID is not needed
126. '                             to interpret arguments, this error should not be returned.
127. '   %DISP_E_PARAMNOTOPTIONAL  A required parameter was omitted.
128. ' ********************************************************************************************
129. FUNCTION IDispatch_Invoke (BYVAL pthis AS DWORD, BYVAL dispidMember AS LONG, BYREF riid AS GUID, _
130. BYVAL lcid AS DWORD, BYVAL wFlags AS WORD, BYREF pdispparams AS DISPPARAMS, BYREF pvarResult AS VARIANT, _
131. BYREF pexcepinfo AS EXCEPINFO, BYREF puArgErr AS DWORD) AS DWORD
132.    LOCAL HRESULT AS DWORD
133.    LOCAL pmethod AS DWORD
134.    IF pthis = 0 THEN EXIT FUNCTION
135.    pmethod = TB_VTableAddress (pthis, 24)
136.    CALL DWORD pmethod USING IDispatch_Invoke (pthis, dispidMember, riid, lcid, wFlags, pdispparams, pvarResult, pexcepinfo, puArgErr) TO HRESULT
137.    FUNCTION = HRESULT
138. END FUNCTION
139. ' ********************************************************************************************
140.  
141. ' ********************************************************************************************
142. ' CallByName
143. ' ********************************************************************************************
144. FUNCTION TB_CallByName ( _
145.     BYVAL pthis AS DWORD, _                                    ' *IDispatch
146.     BYVAL vNameOrId AS VARIANT, _                              ' Name or identifier
147.     BYVAL callType AS LONG, _                                  ' Call type
148.     byref vParams() AS VARIANT, _                              ' Array of variants
149.     byref vResult AS variant, _                                ' Variant result
150.     byref pex AS EXCEPINFO _                                   ' EXCEPINFO
151.     ) EXPORT AS LONG                                           ' Error code
152.  
153.     DIM dw_puArgErr AS DWORD, DISPID_PROPERTYPUT AS LONG, IID_NULL AS GUID
154.     DIM vArgs(0) AS VARIANT, udt_DispParams AS DISPPARAMS
155.     DIM strName AS STRING, DispID AS LONG, nParams AS LONG, i AS LONG, idx AS LONG
156.  
157.     ' Check for null pointer
158.     IF pthis = 0 THEN FUNCTION = -1 : EXIT FUNCTION
159.  
160.     ' Get the DispID
161.     IF variantvt(vNameOrId) = %VT_BSTR THEN
162.        strName = ucode$(variant$(vNameOrId))
163.        IDispatch_GetIDOfName pthis, strName, DispID
164.     ELSE
165.        DispID = variant#(vNameOrId)
166.     END IF
167.  
168.     ' Copy the array in reversed order
169.     IF VARPTR(vParams()) THEN
170.        nParams = UBOUND(vParams) - LBOUND (vParams) + 1
171.        IF nParams > 0 THEN
172.           REDIM vArgs(nParams - 1)
173.           idx = nParams - 1
174.           FOR i = LBOUND(vParams) TO UBOUND(vParams)
175.              IF variantvt(vParams(i)) = %VT_EMPTY THEN
176.                 vArgs(idx) = ERROR %DISP_E_PARAMNOTFOUND
177.              ELSE
178.                 vArgs(idx) = vParams(i)
179.              END IF
180.              DECR idx
181.              IF idx < 0 THEN EXIT FOR
182.           NEXT
183.        END IF
184.    END IF
185.  
186.    IF CallType = 4 OR CallType = 8 THEN  ' %DISPATCH_PROPERTYPUT and %DISPATCH_PROPERTYPUTREF
187.       DISPID_PROPERTYPUT = -3
188.       udt_DispParams.CountNamed = 1
189.       udt_DispParams.NamedDispId = VARPTR(DISPID_PROPERTYPUT)
190.    END IF
191.  
192.    udt_DispParams.CountArgs = nParams
193.    IF nParams > 0 THEN udt_DispParams.VariantArgs = VARPTR(vArgs(0))
194.  
195.    FUNCTION = IDispatch_Invoke(pthis, DispID, IID_NULL, 0, CallType, udt_DispParams, vResult, pex, dw_puArgErr)
196.  
197. END FUNCTION
198. ' ********************************************************************************************
199.  

Example Use

Code: QBasic/QuickBASIC

1. #COMPILE EXE
2. #DIM ALL
3. #DEBUG ERROR ON
4. #INCLUDE "WIN32API.INC"
5. #INCLUDE "CallByName.INC"
6.  
7. %adOpenKeyset     = &H00000001
8. %adLockOptimistic = &H00000003
9. %adCmdText        = &H00000001
10.  
11. ' ********************************************************************************************
12. ' Main
13. ' ********************************************************************************************
14. FUNCTION pbmain
15.  
16.    LOCAL oCon AS dispatch
17.    LOCAL oRec AS dispatch
18.    LOCAL hr AS dword
19.    LOCAL pex AS EXCEPINFO
20.    LOCAL vResult AS VARIANT
21.    LOCAL bstrlen AS LONG
22.    DIM vParams(0) AS variant
23.    
24.    ' Creates a connection instance
25.    set oCon = new dispatch in "ADODB.Connection"
26.    IF isfalse isobject(oCon) THEN GOTO Terminate
27.    
28.    REDIM vParams(3)  ' Four parameters (0:3) - Empty variants are considered as optional parameters
29.    vParams(0) = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=f:\ffado\biblio.mdb"  ' <-- change as needed
30.    hr = TB_CallByName(objptr(oCon), "Open", %DISPATCH_METHOD, vParams(), BYVAL %NULL, BYVAL %NULL)
31.  
32.    ' Creates a recordset instance
33.    set oRec = new dispatch in "ADODB.Recordset"
34.    IF isfalse isobject(oRec) THEN GOTO Terminate
35.    
36.    ' Opens the recordset
37.    REDIM vParams(4)  ' Five parameters (0:4)
38.    vParams(0) = "SELECT TOP 20 * FROM Authors ORDER BY Author"
39.    set vParams(1) = oCon  ' This is a dispatch variable, so we have to assign it using SET
40.    vParams(2) = %adOpenKeyset
41.    vParams(3) = %adLockOptimistic
42.    vParams(4) = %adCmdText
43.    hr = TB_CallByName(objptr(oRec), "Open", %DISPATCH_METHOD, vParams(), BYVAL %NULL, BYVAL %NULL)
44.  
45.    DO
46.       hr = TB_CallByName(objptr(oRec), "Eof", %DISPATCH_PROPERTYGET, BYVAL %NULL, vResult, BYVAL %NULL)
47.       IF variant#(vResult) THEN EXIT DO
48.       REDIM vParams(0)  ' One parameter
49.       vParams(0) = "Author"
50.       hr = TB_CallByName(objptr(oRec), "Collect", %DISPATCH_PROPERTYGET, vParams(), vResult, BYVAL %NULL)
51.       PRINT variant$(vResult)
52.       ' Fetch the next row
53.       hr = TB_CallByName(objptr(oRec), "MoveNext", %DISPATCH_METHOD, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
54.    LOOP
55.    
56.    
57. Terminate:
58.  
59.    ' Close the reordset
60.    hr = TB_CallByName(objptr(oRec), "Close", %DISPATCH_METHOD, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
61.    ' Close the connection
62.    hr = TB_CallByName(objptr(oCon), "Close", %DISPATCH_METHOD, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
63.  
64.    ' Cleanup
65.    set oRec = nothing
66.    set oCon = nothing
67.  
68.    waitkey$
69.  
70. END FUNCTION
71. ' ********************************************************************************************
72.  

Here is the Script BASIC CallByName function for the COM extension module.

Code: C

1. besFUNCTION(CallByName)
2.  
3.   int i;
4.   int slen;
5.   char *s;
6.   int com_args = 0;
7.   char* myCopy = NULL;
8.   LPWSTR wMethodName = NULL;
9.   vbCallType CallType = VbMethod;
10.   std::list<BSTR> bstrs;
11.   VARIANTARG* pvarg = NULL;
12.  
13.   VARIABLE arg_obj;
14.   VARIABLE arg_procName;
15.   VARIABLE arg_CallType;
16.  
17.   besRETURNVALUE = besNEWMORTALLONG;
18.   LONGVALUE(besRETURNVALUE) = 0;
19.  
20.   g_pSt = pSt;
21.  
22.   if(com_dbg) color_printf(colors::myellow,"CallByName %ld args\n",besARGNR);
23.  
24.   if(besARGNR < 2) RETURN0("CallByName requires at least 2 args..")
25.  
26.   arg_obj = besARGUMENT(1);
27.   besDEREFERENCE(arg_obj);
28.  
29.   if( TYPE(arg_obj) != VTYPE_LONG) RETURN0("CallByName first argument must be a long")
30.  
31.   arg_procName = besARGUMENT(2);
32.   besDEREFERENCE(arg_procName);
33.  
34.   if( TYPE(arg_procName) != VTYPE_STRING) RETURN0("CallByName second argument must be a string")
35.  
36.   if( besARGNR >= 3 ){
37.     arg_CallType = besARGUMENT(3);
38.     besDEREFERENCE(arg_CallType);
39.         CallType = (vbCallType)LONGVALUE(arg_CallType);
40.   }
41.  
42.   myCopy = GetCString(arg_procName);
43.   if(myCopy==0) RETURN0("malloc failed low mem")
44.  
45.   wMethodName = __C2W(myCopy);
46.   if(wMethodName==0) RETURN0("unicode conversion failed")
47.  
48.   if( LONGVALUE(arg_obj) == 0) RETURN0("CallByName(NULL) called")
49.   IDispatch* IDisp = (IDispatch*)LONGVALUE(arg_obj);
50.   DISPID  dispid; // long integer containing the dispatch ID
51.   HRESULT hr;
52.  
53.   // Get the Dispatch ID for the method name,
54.   // try block is in case client passed in an invalid pointer
55.   try{
56.           hr = IDisp->GetIDsOfNames(IID_NULL, &wMethodName, 1, LOCALE_USER_DEFAULT, &dispid);
57.           if( FAILED(hr) ) RETURN0("GetIDsOfNames failed")
58.   }
59.   catch(...){
60.           RETURN0("Invalid IDisp pointer?")
61.   }
62.          
63.   VARIANT    retVal;
64.   DISPPARAMS dispparams;
65.   memset(&dispparams, 0, sizeof(dispparams));
66.  
67.   com_args = besARGNR - 3;
68.   if(com_args < 0) com_args = 0;
69.    
70.   if(com_dbg) color_printf(colors::myellow,"CallByName(obj=%x, method='%s', calltype=%d , comArgs=%d)\n", LONGVALUE(arg_obj), myCopy, CallType, com_args);
71.  
72.   // Allocate memory for all VARIANTARG parameters.
73.   if(com_args > 0){
74.          pvarg = new VARIANTARG[com_args];
75.          if(pvarg == NULL) RETURN0("failed to alloc VARIANTARGs")
76.   }
77.  
78.   dispparams.rgvarg = pvarg;
79.   if(com_args > 0) memset(pvarg, 0, sizeof(VARIANTARG) * com_args);
80.          
81.   dispparams.cArgs = com_args;  // num of args function takes
82.   dispparams.cNamedArgs = 0;
83.  
84.   /* map in argument values and types    ->[ IN REVERSE ORDER ]<-    */
85.   for(int i=0; i < com_args; i++){
86.           VARIABLE arg_x;              
87.           arg_x = besARGUMENT(3 + com_args - i);
88.           besDEREFERENCE(arg_x);
89.  
90.                 switch( TYPE(arg_x) ){ //script basic type to COM variant type
91.  
92.                           case VTYPE_DOUBLE:
93.                           case VTYPE_ARRAY:
94.                           case VTYPE_REF:
95.                                 RETURN0("Arguments of script basic types [double, ref, array] not supported")
96.                                 break;
97.  
98.                           case VTYPE_LONG:
99.                                 pvarg[i].vt = VT_I4;
100.                                 pvarg[i].lVal = LONGVALUE(arg_x);
101.                                 break;
102.                          
103.                           case VTYPE_STRING:
104.                                 char* myStr = GetCString(arg_x);
105.                                
106.                                 //peek at data and see if an explicit VT_ type was specified.. scriptbasic only supports a few types
107.                                 if( !HandleSpecial(&pvarg[i], myStr) ){
108.                                         //nope its just a standard string type
109.                                         LPWSTR wStr = __C2W(myStr);
110.                                         BSTR bstr = SysAllocString(wStr);
111.                                         bstrs.push_back(bstr); //track these to free after call to prevent leak
112.                                         pvarg[i].vt = VT_BSTR;
113.                                         pvarg[i].bstrVal = bstr;
114.                                         free(myStr);
115.                                         free(wStr);
116.                                 }
117.  
118.                                 break;                   
119.                                
120.           }
121.  
122.   }
123.    
124.   //invoke should not need a try catch block because IDisp is already known to be ok and COM should only return a hr result?
125.  
126.   //property put gets special handling..
127.   if(CallType == VbLet){
128.             DISPID mydispid = DISPID_PROPERTYPUT;
129.         dispparams.rgdispidNamedArgs = &mydispid;
130.                 dispparams.cNamedArgs = 1;
131.                 hr=IDisp->Invoke( dispid, IID_NULL, LOCALE_USER_DEFAULT, CallType, &dispparams, NULL, NULL, NULL); //no return value arg
132.                 if( FAILED(hr) ) RETURN0("Invoke failed")
133.                 goto cleanup;
134.   }
135.  
136.   hr=IDisp->Invoke( dispid, IID_NULL, LOCALE_USER_DEFAULT, CallType, &dispparams, &retVal, NULL, NULL);
137.   if( FAILED(hr) ) RETURN0("Invoke failed")
138.  
139.   char* cstr = 0;
140.   //map in return value to scriptbasic return val
141.   switch(retVal.vt)
142.   {
143.         case VT_EMPTY: break;
144.  
145.         case VT_BSTR:
146.  
147.             cstr = __B2C(retVal.bstrVal);
148.                 slen = strlen(cstr);
149.                 if(com_dbg) color_printf(colors::myellow,"return value from COM function was string: %s\n", cstr);
150.                 besALLOC_RETURN_STRING(slen);
151.                 memcpy(STRINGVALUE(besRETURNVALUE),cstr,slen);
152.                 free(cstr);
153.                 break;
154.  
155.         case VT_I4:  /* this might be being really lazy but at least with VB6 it works ok.. */
156.         case VT_I2:
157.         case VT_I1:
158.     case VT_BOOL:
159.         case VT_UI1:
160.         case VT_UI2:
161.         case VT_UI4:
162.         case VT_I8:
163.         case VT_UI8:
164.         case VT_INT:
165.         case VT_UINT:
166.         case VT_DISPATCH:
167.  
168.                 if(com_dbg) color_printf(colors::myellow,"return value from COM function was numeric: %d\n", retVal.lVal);
169.         LONGVALUE(besRETURNVALUE) = retVal.lVal;
170.                 break;
171.  
172.         default:
173.                 color_printf(colors::mred,"currently unsupported VT return type: %x\n", retVal.vt);
174.                 break;
175.   }
176.  
177.  
178. cleanup:
179.  
180.   for (std::list<BSTR>::iterator it=bstrs.begin(); it != bstrs.end(); ++it) SysFreeString(*it);
181.   if(pvarg)       delete pvarg;
182.   if(wMethodName) free(wMethodName); //return0 maybe should goto cleanup cause these would leak
183.   if(myCopy)      free(myCopy);
184.   return 0;
185.  
186. besEND
187.  

[JRS]

This might help with getting variants incorporated in Oxygen Basic. If we can get the common use types that convert with other languages, this would solve a huge missing piece in O2. Charles has low level COM working in the Script BASIC DLLC extension module. It would be great if that effort could be reused in the CallByName interface.

VARIANT and VARIANTARG

Mingw32 oaidl.h

Code: C

1. #ifndef _OAIDL_H
2. #define _OAIDL_H
3. #ifdef __cplusplus
4. extern "C" {
5. #endif
6. #ifdef NONAMELESSUNION
7. #define __VARIANT_NAME_1 n1
8. #define __VARIANT_NAME_2 n2
9. #define __VARIANT_NAME_3 n3
10. #define __VARIANT_NAME_4 n4
11. #else
12. #define __tagVARIANT
13. #define __VARIANT_NAME_1
14. #define __VARIANT_NAME_2
15. #define __VARIANT_NAME_3
16. #define __VARIANT_NAME_4
17. #endif
18. #define DISPID_UNKNOWN (-1)
19. #define DISPID_VALUE (0)
20. #define DISPID_PROPERTYPUT (-3)
21. #define DISPID_NEWENUM (-4)
22. #define DISPID_EVALUATE (-5)
23. #define DISPID_CONSTRUCTOR (-6)
24. #define DISPID_DESTRUCTOR (-7)
25. #define DISPID_COLLECT (-8)
26. #define FADF_AUTO (1)
27. #define FADF_STATIC (2)
28. #define FADF_EMBEDDED (4)
29. #define FADF_FIXEDSIZE (16)
30. #define FADF_BSTR (256)
31. #define FADF_UNKNOWN (512)
32. #define FADF_DISPATCH (1024)
33. #define FADF_VARIANT (2048)
34. #define FADF_RESERVED (0xf0e8)
35. #define PARAMFLAG_NONE (0)
36. #define PARAMFLAG_FIN (1)
37. #define PARAMFLAG_FOUT (2)
38. #define PARAMFLAG_FLCID (4)
39. #define PARAMFLAG_FRETVAL (8)
40. #define PARAMFLAG_FOPT (16)
41. #define PARAMFLAG_FHASDEFAULT (32)
42. #define IDLFLAG_NONE PARAMFLAG_NONE
43. #define IDLFLAG_FIN PARAMFLAG_FIN
44. #define IDLFLAG_FOUT PARAMFLAG_FOUT
45. #define IDLFLAG_FLCID PARAMFLAG_FLCID
46. #define IDLFLAG_FRETVAL PARAMFLAG_FRETVAL
47. #define IMPLTYPEFLAG_FDEFAULT 1
48. #define IMPLTYPEFLAG_FSOURCE 2
49. #define IMPLTYPEFLAG_FRESTRICTED 4
50. #define IMPLTYPEFLAG_FDEFAULTVTABLE 8
51.  
52. typedef interface ITypeLib *LPTYPELIB;
53. typedef interface ICreateTypeInfo *LPCREATETYPEINFO;
54. typedef interface ICreateTypeInfo2 *LPCREATETYPEINFO2;
55. typedef interface ICreateTypeLib *LPCREATETYPELIB;
56. typedef interface ICreateTypeLib2 *LPCREATETYPELIB2;
57. typedef interface ITypeComp *LPTYPECOMP;
58. typedef interface ITypeInfo *LPTYPEINFO;
59. typedef interface IErrorInfo *LPERRORINFO;
60. typedef interface IDispatch *LPDISPATCH;
61. typedef interface IEnumVARIANT *LPENUMVARIANT;
62. typedef interface ICreateErrorInfo *LPCREATEERRORINFO;
63. typedef interface ISupportErrorInfo *LPSUPPORTERRORINFO;
64. typedef interface IRecordInfo *LPRECORDINFO;
65.  
66. extern const IID IID_ITypeLib;
67. extern const IID IID_ICreateTypeInfo;
68. extern const IID IID_ICreateTypeInfo2;
69. extern const IID IID_ICreateTypeLib;
70. extern const IID IID_ICreateTypeLib2;
71. extern const IID IID_ITypeInfo;
72. extern const IID IID_IErrorInfo;
73. extern const IID IID_IDispatch;
74. extern const IID IID_IEnumVARIANT;
75. extern const IID IID_ICreateErrorInfo;
76. extern const IID IID_ISupportErrorInfo;
77. extern const IID IID_IRecordInfo;
78.  
79. typedef enum tagSYSKIND {
80.         SYS_WIN16,SYS_WIN32,SYS_MAC
81. } SYSKIND;
82. typedef enum tagLIBFLAGS {
83.         LIBFLAG_FRESTRICTED=1,LIBFLAG_FCONTROL=2,LIBFLAG_FHIDDEN=4,
84.         LIBFLAG_FHASDISKIMAGE=8
85. } LIBFLAGS;
86. typedef struct tagTLIBATTR {
87.         GUID guid;
88.         LCID lcid;
89.         SYSKIND syskind;
90.         WORD wMajorVerNum;
91.         WORD wMinorVerNum;
92.         WORD wLibFlags;
93. } TLIBATTR,*LPTLIBATTR;
94. typedef CY CURRENCY;
95. typedef struct tagSAFEARRAYBOUND {
96.         ULONG cElements;
97.         LONG lLbound;
98. }SAFEARRAYBOUND,*LPSAFEARRAYBOUND;
99. typedef struct _wireSAFEARR_BSTR
100. {
101.         ULONG Size;
102.         wireBSTR *aBstr;
103. }SAFEARR_BSTR;
104. typedef struct _wireSAFEARR_UNKNOWN {
105.         ULONG Size;
106.         IUnknown **apUnknown;
107. }SAFEARR_UNKNOWN;
108. typedef struct _wireSAFEARR_DISPATCH {
109.         ULONG Size;
110.         LPDISPATCH *apDispatch;
111. }SAFEARR_DISPATCH;
112. typedef struct _wireSAFEARR_VARIANT {
113.         ULONG Size;
114.         struct _wireVARIANT *aVariant;
115. }SAFEARR_VARIANT;
116. typedef enum tagSF_TYPE {
117.         SF_ERROR=VT_ERROR,
118.         SF_I1=VT_I1,
119.         SF_I2=VT_I2,
120.         SF_I4=VT_I4,
121.         SF_I8=VT_I8,
122.         SF_BSTR=VT_BSTR,
123.         SF_UNKNOWN=VT_UNKNOWN,
124.         SF_DISPATCH=VT_DISPATCH,
125.         SF_VARIANT=VT_VARIANT
126. }SF_TYPE;
127. typedef struct _wireBRECORD  {
128.         ULONG fFlags;
129.         ULONG clSize;
130.         LPRECORDINFO* pRecInfo;
131.         byte* pRecord;
132. } *wireBRECORD;
133. typedef struct _wireSAFEARR_BRECORD {
134.     ULONG Size;
135.     wireBRECORD* aRecord;
136.     } SAFEARR_BRECORD;
137. typedef struct _wireSAFEARR_HAVEIID {
138.         ULONG Size;
139.         IUnknown** apUnknown;
140.         IID iid;
141.         } SAFEARR_HAVEIID;
142. typedef struct _wireSAFEARRAY_UNION {
143.         ULONG sfType;
144.         union {
145.                 SAFEARR_BSTR BstrStr;
146.                 SAFEARR_UNKNOWN UnknownStr;
147.                 SAFEARR_DISPATCH DispatchStr;
148.                 SAFEARR_VARIANT VariantStr;
149.                 SAFEARR_BRECORD RecordStr;
150.                 SAFEARR_HAVEIID HaveIidStr;
151.                 BYTE_SIZEDARR ByteStr;
152.                 WORD_SIZEDARR WordStr;
153.                 DWORD_SIZEDARR LongStr;
154.                 HYPER_SIZEDARR HyperStr;
155.         }u;
156. }SAFEARRAYUNION;
157. typedef struct _wireSAFEARRAY {
158.         USHORT cDims;
159.         USHORT fFeatures;
160.         ULONG cbElements;
161.         ULONG cLocks;
162.         SAFEARRAYUNION uArrayStructs;
163.         SAFEARRAYBOUND rgsabound[1];
164. }*wireSAFEARRAY;
165. typedef wireSAFEARRAY *wirePSAFEARRAY;
166. typedef struct tagSAFEARRAY {
167.         USHORT cDims;
168.         USHORT fFeatures;
169.         ULONG cbElements;
170.         ULONG cLocks;
171.         PVOID pvData;
172.         SAFEARRAYBOUND rgsabound[1];
173. }SAFEARRAY,*LPSAFEARRAY;
174. typedef struct tagVARIANT {
175.   _ANONYMOUS_UNION union {
176.         struct __tagVARIANT {
177.         VARTYPE vt;
178.         WORD wReserved1;
179.         WORD wReserved2;
180.         WORD wReserved3;
181.         _ANONYMOUS_UNION union {
182.                 long lVal;
183.                 unsigned char bVal;
184.                 short iVal;
185.                 float fltVal;
186.                 double dblVal;
187.                 VARIANT_BOOL  boolVal;
188.                 SCODE scode;
189.                 CY cyVal;
190.                 DATE date;
191.                 BSTR bstrVal;
192.                 IUnknown *punkVal;
193.                 LPDISPATCH pdispVal;
194.                 SAFEARRAY *parray;
195.                 unsigned char *pbVal;
196.                 short *piVal;
197.                 long *plVal;
198.                 float *pfltVal;
199.                 double *pdblVal;
200.                 VARIANT_BOOL *pboolVal;
201.                 _VARIANT_BOOL  *pbool;
202.                 SCODE *pscode;
203.                 CY *pcyVal;
204.                 DATE *pdate;
205.                 BSTR *pbstrVal;
206.                 IUnknown **ppunkVal;
207.                 LPDISPATCH *ppdispVal;
208.                 SAFEARRAY **pparray;
209.                 struct tagVARIANT *pvarVal;
210.                 void *byref;
211.                 CHAR cVal;
212.                 USHORT uiVal;
213.                 ULONG ulVal;
214.                 INT intVal;
215.                 UINT uintVal;
216.                 DECIMAL *pdecVal;
217.                 CHAR  *pcVal;
218.                 USHORT  *puiVal;
219.                 ULONG  *pulVal;
220.                 INT  *pintVal;
221.                 UINT  *puintVal;
222.                 _ANONYMOUS_STRUCT struct {
223.                         PVOID pvRecord;
224.                         struct IRecordInfo *pRecInfo;
225.                 } __VARIANT_NAME_4;
226.         } __VARIANT_NAME_3;
227.     } __VARIANT_NAME_2;
228.     DECIMAL decVal;
229.   } __VARIANT_NAME_1;
230. } VARIANT,*LPVARIANT;
231. typedef VARIANT VARIANTARG;
232. typedef VARIANT *LPVARIANTARG;
233. typedef struct _wireVARIANT {
234.         DWORD clSize;
235.         DWORD rpcReserved;
236.         USHORT vt;
237.         USHORT wReserved1;
238.         USHORT wReserved2;
239.         USHORT wReserved3;
240.         _ANONYMOUS_UNION union {
241.                 LONG lVal;
242.                 BYTE bVal;
243.                 SHORT iVal;
244.                 FLOAT fltVal;
245.                 DOUBLE dblVal;
246.                 VARIANT_BOOL boolVal;
247.                 SCODE scode;
248.                 CY cyVal;
249.                 DATE date;
250.                 wireBSTR bstrVal;
251.                 IUnknown *punkVal;
252.                 LPDISPATCH pdispVal;
253.                 wirePSAFEARRAY parray;
254.                 wireBRECORD brecVal;
255.                 BYTE *pbVal;
256.                 SHORT *piVal;
257.                 LONG *plVal;
258.                 FLOAT *pfltVal;
259.                 DOUBLE *pdblVal;
260.                 VARIANT_BOOL *pboolVal;
261.                 SCODE *pscode;
262.                 CY *pcyVal;
263.                 DATE *pdate;
264.                 wireBSTR *pbstrVal;
265.                 IUnknown **ppunkVal;
266.                 LPDISPATCH *ppdispVal;
267.                 wirePSAFEARRAY *pparray;
268.                 struct _wireVARIANT *pvarVal;
269.                 CHAR cVal;
270.                 USHORT uiVal;
271.                 ULONG ulVal;
272.                 INT intVal;
273.                 UINT uintVal;
274.                 DECIMAL decVal;
275.                 DECIMAL *pdecVal;
276.                 CHAR *pcVal;
277.                 USHORT *puiVal;
278.                 ULONG *pulVal;
279.                 INT *pintVal;
280.                 UINT *puintVal;
281.         } DUMMYUNIONNAME;
282. } *wireVARIANT;  
283. typedef LONG DISPID;
284. typedef DISPID MEMBERID;
285. typedef DWORD HREFTYPE;
286. typedef enum tagTYPEKIND {
287.         TKIND_ENUM,TKIND_RECORD,TKIND_MODULE,TKIND_INTERFACE,TKIND_DISPATCH,
288.         TKIND_COCLASS,TKIND_ALIAS,TKIND_UNION,TKIND_MAX
289. }TYPEKIND;
290. typedef struct tagTYPEDESC {
291.         _ANONYMOUS_UNION union {
292.                 struct tagTYPEDESC *lptdesc;
293.                 struct tagARRAYDESC *lpadesc;
294.                 HREFTYPE hreftype;
295.         } DUMMYUNIONNAME;
296.         VARTYPE vt;
297. }TYPEDESC;
298. typedef struct tagARRAYDESC {
299.         TYPEDESC tdescElem;
300.         USHORT cDims;
301.         SAFEARRAYBOUND rgbounds[1];
302. }ARRAYDESC;
303. typedef struct tagPARAMDESCEX {
304.         ULONG cBytes;
305.         VARIANTARG varDefaultValue;
306. }PARAMDESCEX,*LPPARAMDESCEX;
307. typedef struct tagPARAMDESC {
308.         LPPARAMDESCEX pparamdescex;
309.         USHORT wParamFlags;
310. }PARAMDESC,*LPPARAMDESC;
311. typedef struct tagIDLDESC {
312.         ULONG dwReserved;
313.         USHORT wIDLFlags;
314. }IDLDESC,*LPIDLDESC;
315. typedef struct tagELEMDESC {
316.         TYPEDESC tdesc;
317.         _ANONYMOUS_UNION union {
318.                 IDLDESC idldesc;
319.                 PARAMDESC paramdesc;
320.         } DUMMYUNIONNAME;
321. } ELEMDESC,*LPELEMDESC;
322. typedef struct tagTYPEATTR {
323.         GUID guid;
324.         LCID lcid;
325.         DWORD dwReserved;
326.         MEMBERID memidConstructor;
327.         MEMBERID memidDestructor;
328.         LPOLESTR lpstrSchema;
329.         ULONG cbSizeInstance;
330.         TYPEKIND typekind;
331.         WORD cFuncs;
332.         WORD cVars;
333.         WORD cImplTypes;
334.         WORD cbSizeVft;
335.         WORD cbAlignment;
336.         WORD wTypeFlags;
337.         WORD wMajorVerNum;
338.         WORD wMinorVerNum;
339.         TYPEDESC tdescAlias;
340.         IDLDESC idldescType;
341. }TYPEATTR,*LPTYPEATTR;
342. typedef struct tagDISPPARAMS {
343.         VARIANTARG *rgvarg;
344.         DISPID *rgdispidNamedArgs;
345.         UINT cArgs;
346.         UINT cNamedArgs;
347. }DISPPARAMS;
348. typedef struct tagEXCEPINFO {
349.         WORD wCode;
350.         WORD wReserved;
351.         BSTR bstrSource;
352.         BSTR bstrDescription;
353.         BSTR bstrHelpFile;
354.         DWORD dwHelpContext;
355.         PVOID pvReserved;
356.         HRESULT(__stdcall * pfnDeferredFillIn)(struct tagEXCEPINFO*);
357.         SCODE scode;
358. } EXCEPINFO,*LPEXCEPINFO;
359. typedef enum tagCALLCONV {
360.         CC_FASTCALL,CC_CDECL,CC_MSCPASCAL,CC_PASCAL=CC_MSCPASCAL,
361.         CC_MACPASCAL,CC_STDCALL,CC_FPFASTCALL,CC_SYSCALL,CC_MPWCDECL,
362.         CC_MPWPASCAL,CC_MAX=CC_MPWPASCAL
363. }CALLCONV;
364. typedef enum tagFUNCKIND {
365.         FUNC_VIRTUAL,FUNC_PUREVIRTUAL,FUNC_NONVIRTUAL,
366.         FUNC_STATIC,FUNC_DISPATCH
367. }FUNCKIND;
368. typedef enum tagINVOKEKIND {
369.         INVOKE_FUNC=1,INVOKE_PROPERTYGET,INVOKE_PROPERTYPUT=4,
370.         INVOKE_PROPERTYPUTREF=8
371. }INVOKEKIND;
372. typedef struct tagFUNCDESC {
373.         MEMBERID memid;
374.         SCODE *lprgscode;
375.         ELEMDESC *lprgelemdescParam;
376.         FUNCKIND funckind;
377.         INVOKEKIND invkind;
378.         CALLCONV callconv;
379.         SHORT cParams;
380.         SHORT cParamsOpt;
381.         SHORT oVft;
382.         SHORT cScodes;
383.         ELEMDESC elemdescFunc;
384.         WORD wFuncFlags;
385. }FUNCDESC,*LPFUNCDESC;
386. typedef enum tagVARKIND {
387.         VAR_PERINSTANCE,VAR_STATIC,VAR_CONST,VAR_DISPATCH
388. } VARKIND;
389. typedef struct tagVARDESC {
390.         MEMBERID memid;
391.         LPOLESTR lpstrSchema;
392.         _ANONYMOUS_UNION union {
393.                 ULONG oInst;
394.                 VARIANT *lpvarValue;
395.         } DUMMYUNIONNAME;
396.         ELEMDESC elemdescVar;
397.         WORD wVarFlags;
398.         VARKIND varkind;
399. } VARDESC,*LPVARDESC;
400. typedef enum tagTYPEFLAGS {
401.         TYPEFLAG_FAPPOBJECT=1,TYPEFLAG_FCANCREATE=2,TYPEFLAG_FLICENSED=4,
402.         TYPEFLAG_FPREDECLID=8,TYPEFLAG_FHIDDEN=16,TYPEFLAG_FCONTROL=32,
403.         TYPEFLAG_FDUAL=64,TYPEFLAG_FNONEXTENSIBLE=128,
404.         TYPEFLAG_FOLEAUTOMATION=256,TYPEFLAG_FRESTRICTED=512,
405.         TYPEFLAG_FAGGREGATABLE=1024,TYPEFLAG_FREPLACEABLE=2048,
406.         TYPEFLAG_FDISPATCHABLE=4096,TYPEFLAG_FREVERSEBIND=8192
407. } TYPEFLAGS;
408. typedef enum tagFUNCFLAGS {
409.         FUNCFLAG_FRESTRICTED=1,FUNCFLAG_FSOURCE=2,FUNCFLAG_FBINDABLE=4,
410.         FUNCFLAG_FREQUESTEDIT=8,FUNCFLAG_FDISPLAYBIND=16,FUNCFLAG_FDEFAULTBIND=32,
411.         FUNCFLAG_FHIDDEN=64,FUNCFLAG_FUSESGETLASTERROR=128,FUNCFLAG_FDEFAULTCOLLELEM=256,
412.         FUNCFLAG_FUIDEFAULT=512,FUNCFLAG_FNONBROWSABLE=1024,FUNCFLAG_FREPLACEABLE=2048,
413.         FUNCFLAG_FIMMEDIATEBIND=4096
414. } FUNCFLAGS;
415. typedef enum tagVARFLAGS {
416.         VARFLAG_FREADONLY=1,VARFLAG_FSOURCE=2,VARFLAG_FBINDABLE=4,VARFLAG_FREQUESTEDIT=8,
417.         VARFLAG_FDISPLAYBIND=16,VARFLAG_FDEFAULTBIND=32,VARFLAG_FHIDDEN=64,VARFLAG_FRESTRICTED=128,
418.         VARFLAG_FDEFAULTCOLLELEM=256,VARFLAG_FUIDEFAULT=512,VARFLAG_FNONBROWSABLE=1024,
419.         VARFLAG_FREPLACEABLE=2048,VARFLAG_FIMMEDIATEBIND=4096
420. } VARFLAGS;
421. typedef struct tagCLEANLOCALSTORAGE {
422.         IUnknown *pInterface;
423.         PVOID pStorage;
424.         DWORD flags;
425. } CLEANLOCALSTORAGE;
426. typedef struct tagCUSTDATAITEM {
427.         GUID guid;
428.         VARIANTARG varValue;
429. } CUSTDATAITEM,*LPCUSTDATAITEM;
430. typedef struct tagCUSTDATA {
431.         DWORD cCustData;
432.         LPCUSTDATAITEM prgCustData;
433. } CUSTDATA,*LPCUSTDATA;
434.  
435. typedef enum tagDESCKIND {
436.         DESCKIND_NONE=0,DESCKIND_FUNCDESC=DESCKIND_NONE+1,
437.         DESCKIND_VARDESC=DESCKIND_FUNCDESC+1,DESCKIND_TYPECOMP=DESCKIND_VARDESC+1,
438.         DESCKIND_IMPLICITAPPOBJ=DESCKIND_TYPECOMP+1,
439.         DESCKIND_MAX=DESCKIND_IMPLICITAPPOBJ+1
440. } DESCKIND;
441.  
442. typedef union tagBINDPTR {
443.         LPFUNCDESC lpfuncdesc;
444.         LPVARDESC lpvardesc;
445.         LPTYPECOMP lptcomp;
446. } BINDPTR,*LPBINDPTR;
447.  
448. #undef INTERFACE
449. #define INTERFACE IDispatch
450. DECLARE_INTERFACE_(IDispatch,IUnknown)
451. {
452.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
453.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
454.         STDMETHOD_(ULONG,Release)(THIS) PURE;
455.         STDMETHOD(GetTypeInfoCount)(THIS_ UINT*) PURE;
456.         STDMETHOD(GetTypeInfo)(THIS_ UINT,LCID,LPTYPEINFO*) PURE;
457.         STDMETHOD(GetIDsOfNames)(THIS_ REFIID,LPOLESTR*,UINT,LCID,DISPID*) PURE;
458.         STDMETHOD(Invoke)(THIS_ DISPID,REFIID,LCID,WORD,DISPPARAMS*,VARIANT*,EXCEPINFO*,UINT*) PURE;
459. };
460.  
461. #undef INTERFACE
462. #define INTERFACE IEnumVARIANT
463. DECLARE_INTERFACE_(IEnumVARIANT,IUnknown)
464. {
465.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
466.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
467.         STDMETHOD_(ULONG,Release)(THIS) PURE;
468.         STDMETHOD(Next)(THIS_ ULONG,VARIANT*,ULONG*) PURE;
469.         STDMETHOD(Skip)(THIS_ ULONG) PURE;
470.         STDMETHOD(Reset)(THIS) PURE;
471.         STDMETHOD(Clone)(THIS_ IEnumVARIANT**) PURE;
472. };
473.  
474. #undef INTERFACE
475. #define INTERFACE ITypeComp
476. DECLARE_INTERFACE_(ITypeComp,IUnknown)
477. {
478.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
479.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
480.         STDMETHOD_(ULONG,Release)(THIS) PURE;
481.         STDMETHOD(Bind)(THIS_ LPOLESTR,ULONG,WORD,LPTYPEINFO*,DESCKIND*,LPBINDPTR) PURE;
482.         STDMETHOD(BindType)(THIS_ LPOLESTR,ULONG,LPTYPEINFO*,LPTYPECOMP*) PURE;
483. };
484.  
485. #undef INTERFACE
486. #define INTERFACE ITypeInfo
487. DECLARE_INTERFACE_(ITypeInfo,IUnknown)
488. {
489.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
490.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
491.         STDMETHOD_(ULONG,Release)(THIS) PURE;
492.         STDMETHOD(GetTypeAttr)(THIS_ LPTYPEATTR*) PURE;
493.         STDMETHOD(GetTypeComp)(THIS_ LPTYPECOMP*) PURE;
494.         STDMETHOD(GetFuncDesc)(THIS_ UINT,LPFUNCDESC*) PURE;
495.         STDMETHOD(GetVarDesc)(THIS_ UINT,LPVARDESC*) PURE;
496.         STDMETHOD(GetNames)(THIS_ MEMBERID,BSTR*,UINT,UINT*) PURE;
497.         STDMETHOD(GetRefTypeOfImplType)(THIS_ UINT,HREFTYPE*) PURE;
498.         STDMETHOD(GetImplTypeFlags)(THIS_ UINT,INT*) PURE;
499.         STDMETHOD(GetIDsOfNames)(THIS_ LPOLESTR*,UINT,MEMBERID*) PURE;
500.         STDMETHOD(Invoke)(THIS_ PVOID,MEMBERID,WORD,DISPPARAMS*,VARIANT*,EXCEPINFO*,UINT*) PURE;
501.         STDMETHOD(GetDocumentation)(THIS_ MEMBERID,BSTR*,BSTR*,DWORD*,BSTR*) PURE;
502.         STDMETHOD(GetDllEntry)(THIS_ MEMBERID,INVOKEKIND,BSTR*,BSTR*,WORD*) PURE;
503.         STDMETHOD(GetRefTypeInfo)(THIS_ HREFTYPE,LPTYPEINFO*) PURE;
504.         STDMETHOD(AddressOfMember)(THIS_ MEMBERID,INVOKEKIND,PVOID*) PURE;
505.         STDMETHOD(CreateInstance)(THIS_ LPUNKNOWN,REFIID,PVOID*) PURE;
506.         STDMETHOD(GetMops)(THIS_ MEMBERID,BSTR*) PURE;
507.         STDMETHOD(GetContainingTypeLib)(THIS_ LPTYPELIB*,UINT*) PURE;
508.         STDMETHOD_(void,ReleaseTypeAttr)(THIS_ LPTYPEATTR) PURE;
509.         STDMETHOD_(void,ReleaseFuncDesc)(THIS_ LPFUNCDESC) PURE;
510.         STDMETHOD_(void,ReleaseVarDesc)(THIS_ LPVARDESC) PURE;
511. };
512.  
513. #undef INTERFACE
514. #define INTERFACE ITypeLib
515. DECLARE_INTERFACE_(ITypeLib,IUnknown)
516. {
517.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
518.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
519.         STDMETHOD_(ULONG,Release)(THIS) PURE;
520.         STDMETHOD_(UINT,GetTypeInfoCount)(THIS) PURE;
521.         STDMETHOD(GetTypeInfo)(THIS_ UINT,ITypeInfo**) PURE;
522.         STDMETHOD(GetTypeInfoType)(THIS_ UINT,TYPEKIND*) PURE;
523.         STDMETHOD(GetTypeInfoOfGuid)(THIS_ REFGUID,ITypeInfo**) PURE;
524.         STDMETHOD(GetLibAttr)(THIS_ TLIBATTR**) PURE;
525.         STDMETHOD(GetTypeComp)(THIS_ ITypeComp*) PURE;
526.         STDMETHOD(GetDocumentation)(THIS_ INT,BSTR*,BSTR*,DWORD*,BSTR*) PURE;
527.         STDMETHOD(IsName)(THIS_ LPOLESTR,ULONG,BOOL*) PURE;
528.         STDMETHOD(FindName)(THIS_ LPOLESTR,ULONG,ITypeInfo**,MEMBERID*,USHORT*) PURE;
529.         STDMETHOD_(void,ReleaseTLibAttr)(THIS_ TLIBATTR*) PURE;
530. };
531.  
532. EXTERN_C const IID IID_IErrorInfo;
533. #undef INTERFACE
534. #define INTERFACE IErrorInfo
535. DECLARE_INTERFACE_(IErrorInfo, IUnknown)
536. {
537.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
538.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
539.         STDMETHOD_(ULONG,Release)(THIS) PURE;
540.         STDMETHOD(GetGUID)(THIS_ GUID*) PURE;
541.         STDMETHOD(GetSource)(THIS_ BSTR*) PURE;
542.         STDMETHOD(GetDescription)(THIS_ BSTR*) PURE;
543.         STDMETHOD(GetHelpFile)(THIS_ BSTR*) PURE;
544.         STDMETHOD(GetHelpContext)(THIS_ DWORD*) PURE;
545. };
546.  
547. EXTERN_C const IID IID_ICreateErrorInfo;
548. #undef INTERFACE
549. #define INTERFACE ICreateErrorInfo
550. DECLARE_INTERFACE_(ICreateErrorInfo, IUnknown)
551. {
552.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*)PURE;
553.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
554.         STDMETHOD_(ULONG,Release)(THIS) PURE;
555.         STDMETHOD(SetGUID)(THIS_ REFGUID) PURE;
556.         STDMETHOD(SetSource)(THIS_ LPOLESTR) PURE;
557.         STDMETHOD(SetDescription)(THIS_ LPOLESTR) PURE;
558.         STDMETHOD(SetHelpFile)(THIS_ LPOLESTR) PURE;
559.         STDMETHOD(SetHelpContext)(THIS_ DWORD) PURE;
560. };
561.  
562. EXTERN_C const IID IID_ISupportErrorInfo;
563. #undef INTERFACE
564. #define INTERFACE ISupportErrorInfo
565. DECLARE_INTERFACE_(ISupportErrorInfo, IUnknown)
566. {
567.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
568.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
569.         STDMETHOD_(ULONG,Release)(THIS) PURE;
570.         STDMETHOD(InterfaceSupportsErrorInfo)(THIS_ REFIID) PURE;
571. };
572.  
573. EXTERN_C const IID IID_IRecordInfo;
574. #undef INTERFACE
575. #define INTERFACE IRecordInfo
576. DECLARE_INTERFACE_(IRecordInfo, IUnknown)
577. {
578.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
579.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
580.         STDMETHOD_(ULONG,Release)(THIS) PURE;
581.         STDMETHOD(RecordInit)(THIS_ PVOID) PURE;
582.         STDMETHOD(RecordClear)(THIS_ PVOID) PURE;
583.         STDMETHOD(RecordCopy)(THIS_ PVOID, PVOID) PURE;
584.         STDMETHOD(GetGuid)(THIS_ GUID*) PURE;
585.         STDMETHOD(GetName)(THIS_ BSTR*) PURE;
586.         STDMETHOD(GetSize)(THIS_ ULONG*) PURE;
587.         STDMETHOD(GetTypeInfo)(THIS_ ITypeInfo**) PURE;
588.         STDMETHOD(GetField)(THIS_ PVOID,LPCOLESTR,VARIANT*) PURE;
589.         STDMETHOD(GetFieldNoCopy)(THIS_ PVOID,LPCOLESTR,VARIANT*,PVOID*) PURE;
590.         STDMETHOD(PutField )(THIS_ ULONG,PVOID,LPCOLESTR, VARIANT*) PURE;
591.         STDMETHOD(PutFieldNoCopy)(THIS_ ULONG,PVOID,LPCOLESTR,VARIANT*) PURE;
592.         STDMETHOD(GetFieldNames)(THIS_ ULONG*,BSTR*) PURE;
593.         STDMETHOD_(BOOL,IsMatchingType)(THIS_ THIS) PURE;
594.         STDMETHOD_(PVOID,RecordCreate)(THIS) PURE;
595.         STDMETHOD(RecordCreateCopy)(THIS_ PVOID,PVOID*) PURE;
596.         STDMETHOD(RecordDestroy )(THIS_ PVOID) PURE;
597. };
598.  
599. #ifdef __cplusplus
600. }
601. #endif
602. #endif
603.  

[JRS]

Creating COM Objects with Visual Basic. NET

[JRS]

I thought I would give DLLC COM support a try and see if I could get my VB6 OCX form to show.

Note: the GUID used is the VB6 OCX object I created.

Code: Script BASIC

1. ' Test VB6 OCX Form
2.  
3. DECLARE SUB dllfile ALIAS "dllfile" LIB "DLLC"
4. DECLARE SUB dllguid ALIAS "dllguid" LIB "DLLC"
5. DECLARE SUB dllcall ALIAS "dllcall" LIB "DLLC"
6. DECLARE SUB dllcobj ALIAS "dllcobj" LIB "DLLC"
7. DECLARE SUB dllproc ALIAS "dllproc" LIB "DLLC"
8. DECLARE SUB dllmeth ALIAS "dllmeth" LIB "DLLC"
9.  
10. ole32 = dllfile("ole32.dll")
11.  
12. formobjguid = dllguid("E3F6D544-E159-4B15-99C6-ED7F5A1393BF")
13.  
14. CoInitialize     = dllproc(ole32,"CoInitialize (i)")
15. CoUninitialize   = dllproc(ole32,"CoUninitialize (i)")
16. CoCreateInstance = dllproc(ole32,"CoCreateInstance i=(t*ObjGuid ,i pUnkOuter,i context, t*IspGuid, i*Iface)" )
17.  
18. Context      = 7
19. pUnkOuter    = 0
20. old          = 0
21. Release      = dllmeth( 2,"Release i=()")
22.  
23. hr = 0
24. dllcall(CoInitialize, 0)
25. hr=dllcall(CoCreateInstance, formobjguid, pUnkouter, Context, 0, old)
26.  
27. PRINT "Create Return: ", hr,"\n"
28. PRINT "OLD Form Obj: ", old
29.  
30. dllcobj(old, Release)
31. dllcall(CoUninitialize)
32.  

C:\ScriptBASIC\sbvb\old>scriba o2vb.sb
Create Return: -2147221164
OLD Form Obj: 0
C:\ScriptBASIC\sbvb\old>


Any hints or ideas why I can't create an instance for the OCX with the above code?

[Charles Pegge]

Hi John,

I have been looking for contemporary references to OCX. This one is from 2002

http://www.thevbzone.com/l_ocx.htm

I think it is long dead.

[JRS]

I need the CallByName COM/OLE automation interface in O2. VB6 will create the OCX forms I need.

I'm going to try to prototype a CallByName interface with DLLC. My hope is others will chip in and give guidance.

Can O2 use the oaidl.h header file directly or do I need to define parts of it via DLLC?

Dual-Interface Support for OLE Automation Servers

ActiveX Controls that implement a Dual Interface do not use early binding when
placed on a Visual Basic form. Even if the Dual Interface is marked as the
default interface in the ActiveX Control's .odl file, Visual Basic still uses
the standard IDispatch interface for all automation calls.

STATUS
======

This behavior is by design.

MORE INFORMATION
================

Dual Interface provides an alternative to using the standard IDispatch interface
when making Automation calls. This technique is also referred to as Early
Binding because type checking is performed at compile time. Dual Interfaces are
rapidly becoming popular because they provide increased performance over the
standard IDispatch interface.

It is possible to add Dual Interface support to automation servers as well as
ActiveX Controls. The ACDUAL sample provided with Visual C++ 4.1 demonstrates
the addition of a Dual Interface to the AutoClick automation server. Tech Note
65, referenced in the References section below, outlines the changes you must
make to an automation server to support a Dual Interface. Although ACDUAL and
Tech Note 65 refer to automation servers, the information they provide is also
applicable to ActiveX Controls.

Visual Basic does support early binding for automation servers that support a
Dual Interface, but currently does not support Dual Interface ActiveX Controls.
If you attempt to use the Dual Interface on an ActiveX Control in Visual Basic,
the standard IDispatch interface is used instead. Future versions of Visual
Basic may take advantage of Dual Interface ActiveX Controls, but Visual Basic
4.0 does not.

Would this allow me to use the COM interface calls that exist in DLLC? (direct , non-iDispatch)

[Charles Pegge]

John,

I don't want to go anywhere near this rabbit-hole. Gaining even the slightest competence in this area would be a dangerous distraction. o2 needs everything I've got.

[JRS]

Okay.

Too bad José Roca hates O2. 

[José Roca]

I don't hate O2. It is a chemical element that I need to live.

I can't do serius work with O2 without good documentation. I don't know how many times I have to repeat it.

If a CallByName function is so important to you (I don't have any need for it), why you don't write it youself? You already have sample code. Since I think that O2 can call functions thorugh pointers, you won't need the wrapper functions that calls them using CALL DWORD. This will simplify the code somewhat. The only problem is to build the array of variants. Maybe Charles has a macro for it.

[JRS]

Would you know how to enable an ActiveX control to support dual interfaces? The docs I've read talk about a checkbox for it but I can't find it.

If I can get the OCX defined with a dual interface, the DLLC COM functions should be enough to get it working. The SAPI example Charles did uses the direct approach.

OLE Automation enables an object to expose a set of methods in two ways: via the IDispatch interface, and through direct OLE VTable binding. IDispatch is used by most tools available today, and offers support for late binding to properties and methods.

VTable binding offers much higher performance because this method is called directly instead of through IDispatch::Invoke. IDispatch offers late bound support, where direct VTable binding offers a significant performance gain; both techniques are valuable and important in different scenarios. By labeling an interface as [dual] in the type library, an OLE Automation interface can be used either via IDispatch, or it can be bound to directly. Containers can thus choose the most appropriate technique. Support for dual interfaces is strongly recommended for both controls and containers.

[JRS]

Dual interfaces are very common. The default in an ATL wizard generated COM component is dual interface. Visual Basic 6.0 also creates COM components with dual interfaces.

Can I assume that VB6 creates a dual interface when creating an OCX DLL?

If that is the case, I'm confused why the DLLC code I posted (post #65) failed to create an instance for the Online Dictionary form OCX that works fine with the CallByName method of access.

To use early binding on an object, you need to know what its v-table looks like. In Visual Basic, you can do this by adding a reference to a type library that describes the object, its interface (v-table), and all the functions that can be called on the object. Once that is done, you can declare an object as being a certain type, then set and use that object using the v-table.

Early Bound Access to COM
In order for the compiler to have the type information at compile time, the runtime callable wrapper must first be generated by using the type library import utility, "tlbimp." This utility converts a type library to an assembly. The objects and interfaces from the type library are placed into a namespace corresponding to the name specified in the "library" clause (the name of the type library) with "Lib" appended by default. Thus, the default namespace for my type library is PETSLib. The command line parameter /out allows you to override this default. This utility can be used on any DLL, OCX or EXE that has a type library. Following is the execution of tlbimp on Pets.dll:


D:\projects>tlbimp Pets.dll
TlbImp - TypeLib to COM+ Assembly Converter Version 2000.14.1812.10
Copyright (C) Microsoft Corp. 2000.
All rights reserved.

Typelib imported successfully to PETSLib.dll

[JRS]

An advantage DLLC brings to the table is that it can create O2 virtual exportable functions. This will satisfy the callback needs to O2 from the VB6 created OCX/ActivbeX DLL forms.Calling back to Script BASIC subs/functions is also doable. The only thing I see missing is VARIANT support in the limited form we need to pass standard variables around. DLLC does allow creating/accessing C structures dynamically which may be a way to pass VARIANT arrays to COM.

[José Roca]

Write a class like I did. You won't need to do much work if you only want it in a limited form.

This one is very extensive:
https://github.com/JoseRoca/WinFBX/blob/master/docs/COM/CVAR%20Class.md