Announcement

**Michael Mattias** · 12 Feb 2011, 11:58 AM

>How do I program the equivalent of the VB command

You don't. Variable names do not exist at runtime.

About all you can do is pass an address and a "variable type" as parameters , eg

Code:

UNION MyUnion 
  R AS RECT
  L  AS LONG 
  S   AS SINGLE 
END UNION 
FUNCTION MyFunction (BYVAL p AS DWORD,  vartype AS LONG) AS STRING 
 LOCAL pU AS MyUnion PTR 

 
     pU = p 
     SELECT CASE AS LONG  vartype
         CASE %RECTANGLE 
              Height =  @pU.R.NBottom  - @pU.R.nTop 
         CASE %SINGLE 
             Height =   @pU.S * .5! 
         CASE %LONG 
             Height =  @pU.L * 1.62!
...

Lots of other ways to accomplish the same thing, but to pass a "symbol" (variable name) to a procedure pretty much assumes you are in an interpreted environment where "variable names" still exist rather than in a compiled environment.

MCM

**Chris Holbrook** · 12 Feb 2011, 03:57 PM

Bob, the context would be helpful. A variant may be what you need, as it is not bound to a specific class. Suggest that you search this forum for variant as a keyword and see if you turn up anything useful.

**Robert Wallace** · 14 Feb 2011, 07:21 AM

Hi Chris,

Hope this helps:

From the Scripting Documentation

Finding the value type of a variableSometimes, your scripts will need to make decisions based on the value type of an object. If you’re working on a script that operates
on a text selection, for example, you might want to have that script stop if the type of the selection is a page item. All of the scripting
languages feature the ability to get the type of a variable.

Visual BasicRem Given a variable of unknown type, "myMysteryVariable"...

myType = TypeName(myMysteryVariable)
Rem myType will be a string corresponding to the variable type (e.g., "Rectangle")

From the PBWin Browser

Code:

Member Get AllPageItems <1632659305> () As InDesignObjects

. . .

What I want to do:

Code:

Object get mypage.AllPageItems to myIndesignObjects
object get myIndesignObjects.firstitem to myIndesignObject
. . .
[COLOR="Red"]myType = TypeName(myIndesignObject) [/COLOR] ' e.g. I want to know if it is a TextFrame or ImageRectangle

**Michael Mattias** · 14 Feb 2011, 09:43 AM

All of the scripting languages feature the ability to get the type of a variable.

All scripting languages are interpreters. The PowerBASIC compiler is not an interpreter. Therefore the PowerBASIC compiler is not a scripting language.

You can more than likely create "something" to "OBJECT GET MyPage.AllPageItems to myIndesignObjects" but even when you do, the data type of "myIndesignObjects" is not "any variable by name" it is something defined.

If you have source code available (in some form) at runtime you can do this... which is pretty much how stepping debuggers with a 'watch variable' feature work.

MCM

**Marco Pontello** · 14 Feb 2011, 10:26 AM

Originally posted by Michael Mattias View Post

All scripting languages are interpreters.

That's not true. But you probably know it and was just simplifying.
So I'm writing this just for the sake of the casual reader that may pass here and read that.

**Michael Mattias** · 14 Feb 2011, 10:34 AM

You know, I thought about that. But I could not think of any scripting languages which are truly compiled.

The closest I came was something like BBx Business Basic or even QBasic, which can provide portable "scripts" in tokenized form.... but even those are not per se "user-scriptable" AND compiled.

MCM

**Brad D Byrne** · 14 Feb 2011, 10:35 AM

hmmmm, I wonder if PREFIX() can be considered scripting within the compiler

**Marco Pontello** · 14 Feb 2011, 10:42 AM

Originally posted by Michael Mattias View Post

You know, I thought about that. But I could not think of any scripting languages which are truly compiled.

Now with VMs, JIT compilers, etc. these are concepts that are almost blurred out to irrelevance, for all practical purposes.

Take JavaScript, for example, executed just now by your browser, and surely not interpreted.
Just because a program/script come and is executed directly from the source, doesn't mean it's interpreted.

**Eric Pearson** · 14 Feb 2011, 12:18 PM

Robert --

Esoteric side-discussions aside...

The basic answer to your questions is No, there is no PB function that corresponds directly to VB's TypeName function.

I have never used it, but is it possible that the ISINTERFACE function would give you the information you need?

-- Eric

**Dominic Mitchell** · 14 Feb 2011, 01:20 PM

How do I program the equivalent of the VB command

Public Function TypeName(ByVal VarName As Object) As String

Object get mypage.AllPageItems to myIndesignObjects
object get myIndesignObjects.firstitem to myIndesignObject
. . .
myType = TypeName(myIndesignObject) ' e.g. I want to know if it is a TextFrame

This has come up before on this forum. The answer is yes you can.
The previous respondents, save Eric, fail to realize the following:
1) This is COM.
2) There is a type library present.
3) The names of objects that are defined in the type library can be retrieved.

PowerBASIC does not have a TypeName command, but it is not something that is difficult to code.
By the way, if PowerBASIC was used to write the COM component, you will most likely have to
modify its type libary.

**Dominic Mitchell** · 14 Feb 2011, 04:06 PM

The following code implements a very basic TypeName function using low-level COM.
To use, add it to your code as an include file(e.g TypeName.inc).

Code:

%NULL           = 0
%MAX_PATH       = 260  
%CP_ACP         = 0       ' default to ANSI code page

DECLARE FUNCTION GetUserDefaultLCID LIB "KERNEL32.DLL" ALIAS "GetUserDefaultLCID" () AS LONG
DECLARE FUNCTION WideCharToMultiByte LIB "KERNEL32.DLL" ALIAS "WideCharToMultiByte" (BYVAL CodePag AS DWORD, BYVAL dwFlags AS DWORD, lpWideCharStr AS ANY, BYVAL cchWideChar AS LONG, lpMultiByteStr AS ANY, BYVAL cchMultiByte AS LONG, _
                 lpDefaultChar AS ASCIIZ, lpUsedDefaultChar AS LONG) AS LONG
DECLARE SUB      SysFreeString LIB "OLEAUT32.DLL" ALIAS "SysFreeString" (bstr AS ANY)

%S_OK           = 0

' wtypes.h (ks.h IID_NULL = GUID_NULL)
$IID_NULL                         = GUID$("{00000000-0000-0000-0000-000000000000}")
' unknown.h
$IID_IUNKNOWN                     = GUID$("{00000000-0000-0000-C000-000000000046}")

' oaidl.h
$IID_IDISPATCH                    = GUID$("{00020400-0000-0000-C000-000000000046}")
$IID_ITYPEINFO                    = GUID$("{00020401-0000-0000-C000-000000000046}")

TYPE BRECORD
  pvRecord  AS DWORD
  pRecInfo  AS DWORD  ' IRecordInfo
END TYPE

TYPE BLOB
  cbSize    AS DWORD
  pBlobData AS BYTE PTR
END TYPE

' dbvar.h

' DBCOLKIND
%DBCOLKIND_GUID_NAME                    = 0
%DBCOLKIND_GUID_NUMBER                  = 1
%DBCOLKIND_NAME                         = 2

UNION DBCOLUMNIDDATA
  lNumber   AS LONG
  lpdbsz    AS DWORD      ' LPWSTR
END UNION

TYPE DBCOLUMNID
  rguid     AS GUID
  dwKind    AS DWORD
  dcd       AS DBCOLUMNIDDATA
END TYPE

' DBVARENUM
%DBTYPE_EMPTY                           = 0       ' VT_EMPTY
%DBTYPE_NULL                            = 1       ' VT_NULL
%DBTYPE_I2                              = 2       ' VT_I2
%DBTYPE_I4                              = 3       ' VT_I4
%DBTYPE_R4                              = 4       ' VT_R4
%DBTYPE_R8                              = 5       ' VT_R8
%DBTYPE_CY                              = 6       ' VT_CY
%DBTYPE_DATE                            = 7       ' VT_DATE
%DBTYPE_BOOL                            = 11      ' VT_BOOL
%DBTYPE_UI2                             = 18      ' VT_UI2
%DBTYPE_UI4                             = 19      ' VT_UI4
%DBTYPE_I8                              = 20      ' VT_I8
%DBTYPE_UI8                             = 21      ' VT_UI8
%DBTYPE_HRESULT                         = 25      ' VT_HRESULT
%DBTYPE_LPSTR                           = 30      ' VT_LPSTR
%DBTYPE_LPWSTR                          = 31      ' VT_LPWSTR
%DBTYPE_FILETIME                        = 64      ' VT_FILETIME
%DBTYPE_BLOB                            = 65      ' VT_BLOB
%DBTYPE_UUID                            = 72      ' VT_CLSID
%DBTYPE_DBEXPR                          = 503
%DBTYPE_COLUMNID                        = 507
''''%DBTYPE_BYTES                           = 508
%DBTYPE_CHARS                           = 509
%DBTYPE_WCHARS                          = 510
%DBTYPE_ANYVARIANT                      = 511

%DBTYPE_EXT                             = &H100

' dbvar.h end

TYPE CLIPDATA
  cbSize    AS DWORD
  ulClipFmt AS LONG
  pClipData AS BYTE PTR
END TYPE

'TYPE CY
'  lo_   AS DWORD
'  hi_   AS LONG
'END TYPE

UNION VARIANTDATA   ' vd
  lVal                          AS LONG         ' VT_I4
  bVal                          AS BYTE         ' VT_UI1
  iVal                          AS INTEGER      ' VT_I2
  fltVal                        AS SINGLE       ' VT_R4
  dblVal                        AS DOUBLE       ' VT_R8
  boolVal                       AS INTEGER      ' VT_BOOL
  scode                         AS LONG         ' VT_ERROR
  cyVal                         AS CUR          ' VT_CY
  date                          AS DOUBLE       ' VT_DATE
  bstrVal                       AS DWORD        ' VT_BSTR
  punkVal                       AS DWORD        ' VT_UNKNOWN
  pdispVal                      AS DWORD        ' VT_DISPATCH
  parray                        AS DWORD        ' VT_ARRAY
  pbVal                         AS BYTE PTR     ' VT_BYREF|VT_UI1
  piVal                         AS INTEGER PTR  ' VT_BYREF|VT_I2
  plVal                         AS LONG PTR     ' VT_BYREF|VT_I4
  pfltVal                       AS SINGLE PTR   ' VT_BYREF|VT_R4
  pdblVal                       AS DOUBLE PTR   ' VT_BYREF|VT_R8
  pboolVal                      AS INTEGER PTR  ' VT_BYREF|VT_BOOL
  pscode                        AS LONG PTR     ' VT_BYREF|VT_ERROR
  pcyVal                        AS CUR PTR      ' VT_BYREF|VT_CY
  pdate                         AS DOUBLE PTR   ' VT_BYREF|VT_DATE
  pbstrVal                      AS DWORD PTR    ' VT_BYREF|VT_BSTR
  ppunkVal                      AS DWORD PTR    ' VT_BYREF|VT_UNKNOWN
  ppdispVal                     AS DWORD PTR    ' VT_BYREF|VT_DISPATCH
  pparray                       AS DWORD PTR    ' VT_BYREF|VT_ARRAY
  pvarVal                       AS DWORD PTR    ' VT_BYREF|VT_VARIANT
  pByRef                        AS DWORD PTR    ' Generic BYREF (void*)
  cVal                          AS BYTE         ' VT_I1
  uiVal                         AS WORD         ' VT_UI2
  ulVal                         AS DWORD        ' VT_UI4
  intVal                        AS LONG         ' VT_INT
  uintVal                       AS DWORD        ' VT_UINT
  pdecVal                       AS DWORD PTR    ' VT_BYREF|VT_DECIMAL
  pcVal                         AS BYTE PTR     ' VT_BYREF|VT_I1
  puiVal                        AS WORD PTR     ' VT_BYREF|VT_UI2
  pulVal                        AS DWORD PTR    ' VT_BYREF|VT_UI4
  pintVal                       AS LONG PTR     ' VT_BYREF|VT_INT
  puintVal                      AS DWORD PTR    ' VT_BYREF|VT_UINT
  br                            AS BRECORD      ' VT_RECORD

  ' types new to DBVARIANTs
  blobVal                       AS BLOB         ' VT_BLOB
  pColumnid                     AS DWORD        ' DBTYPE_COLUMNID
  pszVal                        AS DWORD        ' VT_LPSTR
  pwszVal                       AS DWORD        ' VT_LPWSTR
  ppwszVal                      AS DWORD PTR    ' VT_BYREF|VT_LPWSTR
  pblobVal                      AS BLOB PTR     ' VT_BYREF|VT_BLOB
  ppColumnid                    AS DWORD PTR    ' VT_BYREF|DBTYPE_COLUMNID
  pdbvarVal                     AS DWORD PTR    ' VT_BYREF|DBTYPE_VARIANT
END UNION

TYPE VARIANTAPI
  vt         AS WORD  'VARTYPE
  wReserved1 AS WORD
  wReserved2 AS WORD
  wReserved3 AS WORD
  vd         AS VARIANTDATA
END TYPE

TYPE DISPPARAMSAPI
  rgvarg            AS VARIANTAPI PTR
  rgdispidNamedArgs AS LONG PTR
  cArgs             AS DWORD
  cNamedArgs        AS DWORD
END TYPE

' Describes an exception that occurred during IDispatch::Invoke
TYPE EXCEPINFO
  wCode             AS WORD       ' An error code describing the error
  wReserved         AS WORD       ' Reserved; should be set to 0
  bstrSource        AS STRING PTR ' A source of the exception
  bstrDescription   AS STRING PTR ' A description of the error
  bstrHelpFile      AS STRING PTR ' Fully qualified drive, path, and file name
  dwHelpContext     AS DWORD      ' help context of topic within the help file
  pvReserved        AS DWORD      ' Must be set to NULL
  pfnDeferredFillIn AS DWORD      ' Pointer to function that fills in Help and description info
  scode             AS LONG       ' An SCODE describing the error
END TYPE

'===============================================================================
' IUnknown uuid(00020402-0000-0000-c000-000000000046)
'===============================================================================

' IUnknownVtbl
TYPE IUnknownVtbl
  QueryInterface        AS DWORD  ' QueryInterface(This,riid,ppvObject)
  AddRef                AS DWORD  ' AddRef(This)
  Release               AS DWORD  ' Release(This)
END TYPE

'===============================================================================
' IDispatch uuid(00020400-0000-0000-C000-000000000046)
'===============================================================================

'/* The range -500 through -999 is reserved for Controls */
'/* The range 0X80010000 through 0X8001FFFF is reserved for Controls */
'/* The range -5000 through -5499 is reserved for ActiveX Accessability */
'/* The range -2000 through -2499 is reserved for VB5 */
'/* The range -3900 through -3999 is reserved for Forms */
'/* The range -5500 through -5550 is reserved for Forms */
'/* The remainder of the negative DISPIDs are reserved for future use */

'/* DISPID reserved to indicate an "unknown" name */
'/* only reserved for data members (properties); reused as a method dispid below */
%DISPID_UNKNOWN                 = -1

'/* DISPID reserved for the "value" property */
%DISPID_VALUE                   = 0

'/* The following DISPID is reserved to indicate the param
' * that is the right-hand-side (or "put" value) of a PropertyPut  */
%DISPID_PROPERTYPUT             = -3

'/* DISPID reserved for the standard "NewEnum" method */
%DISPID_NEWENUM                 = -4

'/* DISPID reserved for the standard "Evaluate" method */
%DISPID_EVALUATE                = -5

%DISPID_CONSTRUCTOR             = -6

%DISPID_DESTRUCTOR              = -7

%DISPID_COLLECT                 = -8

' IDispatchVtbl
TYPE IDispatchVtbl
  QueryInterface        AS DWORD  ' QueryInterface(This,riid,ppvObject)
  AddRef                AS DWORD  ' AddRef(This)
  Release               AS DWORD  ' Release(This)
  GetTypeInfoCount      AS DWORD  ' GetTypeInfoCount(This,pctinfo)
  GetTypeInfo           AS DWORD  ' GetTypeInfo(This,iTInfo,lcid,ppTInfo)
  GetIDsOfNames         AS DWORD  ' GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)
  Invoke                AS DWORD  ' Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)
END TYPE

'===============================================================================
' ITypeInfo uuid(00020401-0000-0000-c000-000000000046)
'===============================================================================

%MEMBERID_NIL                           = %DISPID_UNKNOWN
%ID_DEFAULTINST                         = -2

' Flags for IDispatch::Invoke
%DISPATCH_METHOD                        = &H1
%DISPATCH_PROPERTYGET                   = &H2
%DISPATCH_PROPERTYPUT                   = &H4
%DISPATCH_PROPERTYPUTREF                = &H8

' ITypeInfoVtbl
TYPE ITypeInfoVtbl
  QueryInterface        AS DWORD  ' QueryInterface(This,riid,ppvObject)
  AddRef                AS DWORD  ' AddRef(This)
  Release               AS DWORD  ' Release(This)
  GetTypeAttr           AS DWORD  ' GetTypeAttr(This,ppTypeAttr)
  GetTypeComp           AS DWORD  ' GetTypeComp(This,ppTComp)
  GetFuncDesc           AS DWORD  ' GetFuncDesc(This,index,ppFuncDesc)
  GetVarDesc            AS DWORD  ' GetVarDesc(This,index,ppVarDesc)
  GetNames              AS DWORD  ' GetNames(This,memid,rgBstrNames,cMaxNames,pcNames)
  GetRefTypeOfImplType  AS DWORD  ' GetRefTypeOfImplType(This,index,pRefType)
  GetImplTypeFlags      AS DWORD  ' GetImplTypeFlags(This,index,pImplTypeFlags)
  GetIDsOfNames         AS DWORD  ' GetIDsOfNames(This,rgszNames,cNames,pMemId)
  Invoke                AS DWORD  ' Invoke(This,pvInstance,memid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)
  GetDocumentation      AS DWORD  ' GetDocumentation(This,memid,pBstrName,pBstrDocString,pdwHelpContext,pBstrHelpFile)
  GetDllEntry           AS DWORD  ' GetDllEntry(This,memid,invKind,pBstrDllName,pBstrName,pwOrdinal)
  GetRefTypeInfo        AS DWORD  ' GetRefTypeInfo(This,hRefType,ppTInfo)
  AddressOfMember       AS DWORD  ' AddressOfMember(This,memid,invKind,ppv)
  CreateInstance        AS DWORD  ' CreateInstance(This,pUnkOuter,riid,ppvObj)
  GetMops               AS DWORD  ' GetMops(This,memid,pBstrMops)
  GetContainingTypeLib  AS DWORD  ' GetContainingTypeLib(This,ppTLib,pIndex)
  ReleaseTypeAttr       AS DWORD  ' ReleaseTypeAttr(This,pTypeAttr)
  ReleaseFuncDesc       AS DWORD  ' ReleaseFuncDesc(This,pFuncDesc)
  ReleaseVarDesc        AS DWORD  ' ReleaseVarDesc(This,pVarDesc)
END TYPE

'===============================================================================
' IUnknown uuid(00020402-0000-0000-c000-000000000046)
'===============================================================================

'-------------------------------------------------------------------------------
'
' PROCEDURE: IUnknown_QueryInterface
' PURPOSE:   Converts an ANSI string to an OLECHAR string.
' RETURN:    S_OK if the interface is supported, E_NOINTERFACE if it is not.
'
'-------------------------------------------------------------------------------

FUNCTION IUnknown_QueryInterface _
  ( _
  BYVAL pThis AS DWORD, _ ' [IN] current interface pointer
        riid  AS GUID, _  ' [IN] ID of interface requested
        ppv   AS DWORD _  ' [OUT] pointer to interface requested
  ) AS LONG

  LOCAL pVtbl   AS IUnknownVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis                       ' cast as IUnknown ptr
  lpfn  = @@pVtbl.QueryInterface

  ! push  ppv
  ! mov   eax, riid
  ! push  eax
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: IUnknown_AddRef
' PURPOSE:   Increments an object's reference count, returning the new count.
' RETURN:    The new reference count.
'
'-------------------------------------------------------------------------------

FUNCTION IUnknown_AddRef _
  ( _
  BYVAL pThis AS DWORD _  ' [IN] current interface pointer
  ) AS LONG

  LOCAL pVtbl   AS IUnknownVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis                       ' cast as IUnknown ptr
  lpfn  = @@pVtbl.AddRef

  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: IUnknown_Release
' PURPOSE:   Decrements an object's reference count, returning the new count.
'            If the new count is zero, the object is allowed to (delete,
'            destroy) itself, and the caller must then assume that all interface
'            pointers to the object are invalid.
' RETURN:    The new reference count.
'
'-------------------------------------------------------------------------------

FUNCTION IUnknown_Release _
  ( _
  BYVAL pThis AS DWORD _  ' [IN] current interface pointer
  ) AS LONG

  LOCAL pVtbl   AS IUnknownVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis                       ' cast as IUnknown ptr
  lpfn  = @@pVtbl.Release

  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'===============================================================================
' IDispatch uuid(00020400-0000-0000-C000-000000000046)
'===============================================================================

'-------------------------------------------------------------------------------
'
' PROCEDURE: IDispatch_QueryInterface
' PURPOSE:
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION IDispatch_QueryInterface _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] IDispatch interface pointer
        riid      AS GUID, _  ' [IN] ID of interface requested
        ppvObject AS DWORD _  ' [OUT] pointer to interface requested
  ) AS LONG

  FUNCTION = IUnknown_QueryInterface(pThis, riid, ppvObject)

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: IDispatch_AddRef
' PURPOSE:
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION IDispatch_AddRef _
  ( _
  BYVAL pThis AS DWORD _  ' [IN] IDispatch interface pointer
  ) AS LONG

  FUNCTION = IUnknown_AddRef(pThis)

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: IDispatch_Release
' PURPOSE:
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION IDispatch_Release _
  ( _
  BYVAL pThis AS DWORD _  ' [IN] IDispatch interface pointer
  ) AS LONG

  FUNCTION = IUnknown_Release(pThis)

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: IDispatch_GetTypeInfoCount
' PURPOSE:   Retrieves the number of type information interfaces that an object
'            provides (either 0 OR 1).
' NOTES:     The function may return zero, which indicates that the object does
'            not provide any type information. In this case, the object may still
'            be programmable through IDispatch, but does not provide type
'            information for browsers, compilers, or other programming tools that
'            access type information. This may be useful for hiding an object
'            from browsers or for preventing early binding on an object.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION IDispatch_GetTypeInfoCount _
  ( _
  BYVAL pThis   AS DWORD, _ ' [IN] IDispatch interface pointer
        pctinfo AS DWORD _  ' [OUT] receives the number of type information interfaces that the object provides
  ) AS LONG

  LOCAL pVtbl   AS IDispatchVtbl PTR
  LOCAL lpfn    AS DWORD

  pVtbl = pThis
  lpfn  = @@pVtbl.GetTypeInfoCount

  ! push  pctinfo
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: IDispatch_GetTypeInfo
' PURPOSE:   Retrieves a type information object, which can be used to get the
'            type information for an interface.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION IDispatch_GetTypeInfo _
  ( _
  BYVAL pThis   AS DWORD, _ ' [IN] IDispatch interface pointer
  BYVAL iTInfo  AS DWORD, _ ' [IN] the type information to return. Pass 0 to retrieve type information for the IDispatch implementation
  BYVAL lcid    AS DWORD, _ ' [IN] the locale ID for the type information
        ppTInfo AS DWORD _  ' [OUT] receives the number of type information interfaces that the object provides
  ) AS LONG

  LOCAL pVtbl   AS IDispatchVtbl PTR
  LOCAL lpfn    AS DWORD

  pVtbl = pThis
  lpfn  = @@pVtbl.GetTypeInfo

  ! push  ppTInfo
  ! push  lcid
  ! push  iTInfo
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: IDispatch_GetIDsOfNames
' PURPOSE:   Maps a single member and an optional set of argument names to
'            a corresponding set of integer DISPIDs, which may be used on
'            subsequent calls to IDispatch::Invoke.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION IDispatch_GetIDsOfNames _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] IDispatch interface pointer
        riid      AS GUID, _  ' [IN] reserved for future use. Must be NULL
  BYVAL rgszNames AS DWORD, _ ' [IN] passed-in array of names to be mapped
  BYVAL cNames    AS DWORD, _ ' [IN] count of the names to be mapped
  BYVAL lcid      AS DWORD, _ ' [IN] the locale context in which to interpret the names
  BYVAL rgDispId  AS DWORD _  ' [OUT] caller-allocated array, each element of which contains an ID corresponding to one of the names passed in the rgszNames array
  ) AS LONG

  LOCAL pVtbl   AS IDispatchVtbl PTR
  LOCAL lpfn    AS DWORD

  pVtbl = pThis
  lpfn  = @@pVtbl.GetIDsOfNames

  ! push  rgDispId
  ! push  lcid
  ! push  cNames
  ! push  rgszNames
  ! mov   eax, riid
  ! push  eax
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: IDispatch_Invoke
' PURPOSE:   Provides access to properties and methods exposed by an object.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION IDispatch_Invoke _
  ( _
  BYVAL pThis         AS DWORD, _         ' [IN] IDispatch interface pointer
  BYVAL dispIdMember  AS LONG, _          ' [IN] Identifies the member (dispatch ID)
        riid          AS GUID, _          ' [IN] reserved for future use. Must be IID_NULL
  BYVAL lcid          AS DWORD, _         ' [IN] The locale context in which to interpret arguments
  BYVAL wFlags        AS WORD, _          ' [IN] Flags describing the context of the invoke call
        pDispParams   AS DISPPARAMSAPI, _ ' [IN,OUT] Pointer to a structure containing an array of arguments
        pVarResult    AS VARIANTAPI, _    ' [OUT] Pointer to a Variant or NULL if the caller expects no result
        pExcepInfo    AS EXCEPINFO, _     ' [OUT] Pointer to an EXCEPINFO structure or NULL
        puArgErr      AS DWORD _          ' [OUT] indicates the index (within rgvarg) of the argument with incorrect type
  ) AS LONG

  LOCAL pVtbl   AS IDispatchVtbl PTR
  LOCAL lpfn    AS DWORD

  pVtbl = pThis
  lpfn  = @@pVtbl.Invoke

  ! push  puArgErr
  ! mov   eax, pExcepInfo
  ! push  eax
  ! mov   eax, pVarResult
  ! push  eax
  ! mov   eax, pDispParams
  ! push  eax
  ! movzx eax, wFlags
  ! push  eax
  ! push  lcid
  ! mov   eax, riid
  ! push  eax
  ! push  dispIdMember
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'===============================================================================
' ITypeInfo uuid(00020401-0000-0000-c000-000000000046)
'===============================================================================

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_QueryInterface
' PURPOSE:
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_QueryInterface _
  ( _
  BYVAL pThis AS DWORD, _ ' [IN] ITypeInfo interface pointer
        riid  AS GUID, _  ' [IN] ID of interface requested
        ppv   AS DWORD _  ' [OUT] pointer to interface requested
  ) AS LONG

  FUNCTION = IUnknown_QueryInterface(pThis, riid, ppv)

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_AddRef
' PURPOSE:
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_AddRef _
  ( _
  BYVAL pThis AS DWORD _  ' [IN] ITypeInfo interface pointer
  ) AS LONG

  FUNCTION = IUnknown_AddRef(pThis)

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_Release
' PURPOSE:
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_Release _
  ( _
  BYVAL pThis AS DWORD _  ' [IN] ITypeInfo interface pointer
  ) AS LONG

  FUNCTION = IUnknown_Release(pThis)

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetTypeAttr
' PURPOSE:   Allocates, fills, and returns the TYPEATTR structure for this
'            ITypeInfo.
'            This must be freed with ReleaseTypeAttr.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetTypeAttr _
  ( _
  BYVAL pThis       AS DWORD, _ ' [IN] ITypeInfo interface pointer
        ppTypeAttr  AS DWORD _  ' [OUT]
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetTypeAttr

  ! push  ppTypeAttr
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetTypeComp
' PURPOSE:   Retrieves the ITypeComp interface for the type description, which
'            enables a client compiler to bind to the type description's members.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetTypeComp _
  ( _
  BYVAL pThis   AS DWORD, _ ' [IN] ITypeInfo interface pointer
        ppTComp AS DWORD _  ' [OUT]
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetTypeComp

  ! push  ppTComp
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetFuncDesc
' PURPOSE:   Retrieves the FUNCDESC structure containing information about
'            a specified function.
'            This should be freed with ReleaseFuncDesc.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetFuncDesc _
  ( _
  BYVAL pThis       AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL index       AS DWORD, _ ' [IN] Index of the function whose description is to be returned
        ppFuncDesc  AS DWORD _  ' [OUT]
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetFuncDesc

  ! push  ppFuncDesc
  ! push  index
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetVarDesc
' PURPOSE:   Retrieves a VARDESC structure describing the specified variable.
'            To free the VARDESC structure, use ReleaseVarDesc.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetVarDesc _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL index     AS DWORD, _ ' [IN] Index of the variable whose description is to be returned
        ppVarDesc AS DWORD _  ' [OUT]
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetVarDesc

  ! push  ppVarDesc
  ! push  index
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetNames
' PURPOSE:   Retrieves the variable with the specified member ID, or the name
'            of the property or method and its parameters, corresponding to
'            the specified function ID.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetNames _
  ( _
  BYVAL pThis       AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL memid       AS LONG, _  ' [IN] ID of member whose name (or names) is to be returned
  BYVAL rgBstrNames AS DWORD, _ ' [OUT] Pointer to caller-allocated array (pointers to BSTRs)
  BYVAL cMaxNames   AS DWORD, _ ' [IN] Length of the passed-in rgbstrNames array
        pcNames     AS DWORD _  ' [OUT] number representing the number of names in rgbstrNames array
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetNames

  ! push  pcNames
  ! push  cMaxNames
  ! push  rgBstrNames
  ! push  memid
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetRefTypeOfImplType
' PURPOSE:   If this type description describes a component object class,
'            the function retrieves the type description of the specified
'            implemented interface types. For an interface, GetRefTypeOfImplType
'            returns the type information for inherited interfaces, if any exist.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetRefTypeOfImplType _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL index     AS DWORD, _ ' [IN] Index of the implemented type whose handle is returned
        pRefType  AS DWORD _  ' [OUT] points to a handle for the implemented interface (if any)
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetRefTypeOfImplType

  ! push  pRefType
  ! push  index
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetImplTypeFlags
' PURPOSE:   Retrieves the IMPLTYPEFLAGS for one implemented interface or
'            base interface in a type description.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetImplTypeFlags _
  ( _
  BYVAL pThis           AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL index           AS DWORD, _ ' [IN] Index of the implemented interface or base interface for which to get the flags
        pImplTypeFlags  AS DWORD _  ' [OUT]
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetImplTypeFlags

  ! push  pImplTypeFlags
  ! push  index
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetIDsOfNames
' PURPOSE:   Maps between member names and member IDs, and parameter names
'            and parameter IDs.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetIDsOfNames _
  ( _
  BYVAL pThis       AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL rgwszNames  AS DWORD, _ ' [IN] Passed-in pointer to an array of names to be mapped (pointers to OLECHARs)
  BYVAL cNames      AS DWORD, _ ' [IN] Length of the passed-in rgbstrNames array
        pMemId      AS DWORD _  ' [OUT] Caller-allocated array in which name mappings are placed
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetIDsOfNames

  ! push  pMemId
  ! push  cNames
  ! push  rgwszNames
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_Invoke
' PURPOSE:   Invokes a method or accesses a property of an object that
'            implements the interface described by the type description.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_Invoke _
  ( _
  BYVAL pThis       AS DWORD, _         ' [IN] ITypeInfo interface pointer
  BYVAL pvInstance  AS DWORD, _         ' [IN] Pointer to an instance of the interface described by this type description
  BYVAL memid       AS LONG, _          ' [IN] Identifies the interface member
  BYVAL wFlags      AS WORD, _          ' [IN] Flags describing the context of the invoke call
        pDispParams AS DISPPARAMSAPI, _ ' [IN,OUT] Pointer to a structure containing an array of arguments
        pVarResult  AS VARIANTAPI, _    ' [OUT] Pointer to a Variant or NULL if the caller expects no result
        pExcepInfo  AS EXCEPINFO, _     ' [OUT] Pointer to an EXCEPINFO structure or NULL
        puArgErr    AS DWORD _          ' [OUT] indicates the index (within rgvarg) of the argument with incorrect type
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.Invoke

  ! push  puArgErr
  ! mov   eax, pExcepInfo
  ! push  eax
  ! mov   eax, pVarResult
  ! push  eax
  ! mov   eax, pDispParams
  ! push  eax
  ! movzx eax, wFlags
  ! push  eax
  ! push  memid
  ! push  pvInstance
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetDocumentation
' PURPOSE:   Retrieves the documentation string, name of the complete Help
'            file path and name, and the context ID for the Help topic for
'            a specified type description.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetDocumentation _
  ( _
  BYVAL pThis           AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL memid           AS LONG, _  ' [IN] ID of the member whose documentation is to be returned
        pBstrName       AS DWORD, _ ' [OUT] Pointer to a BSTR allocated by the callee into which the name of the specified item is placed or NULL
        pBstrDocString  AS DWORD, _ ' [OUT] Pointer to a BSTR into which the documentation string for the specified item is placed or NULL
        pdwHelpContext  AS DWORD, _ ' [OUT] Pointer to the Help context associated with the specified item or NULL
        pBstrHelpFile   AS DWORD _  ' [OUT] Pointer to a BSTR into which the fully qualified name of the Help file is placed or NULL
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetDocumentation

  ! push  pBstrHelpFile
  ! push  pdwHelpContext
  ! push  pBstrDocString
  ! push  pBstrName
  ! push  memid
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetDllEntry
' PURPOSE:   Retrieves a description or specification of an entry point for
'            a function in a DLL.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetDllEntry _
  ( _
  BYVAL pThis         AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL memid         AS LONG, _  ' [IN] ID of the member function whose DLL entry description is to be returned
  BYVAL invKind       AS DWORD, _ ' [IN] Specifies the kind of member identified by memid
        pBstrDllName  AS DWORD, _ ' [OUT] If not NULL, the function sets pBstrDllName to a BSTR containing the DLL name
        pBstrName     AS DWORD, _ ' [OUT] If not NULL, the function sets pBstrName to a BSTR containing the name of the entry point or to NULL if the entry point is specified by an ordinal
        pwOrdinal     AS DWORD _  ' [OUT] If not NULL, and if the function is defined by ordinal, then pwOrdinal is set to point to the ordinal
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetDllEntry

  ! push  pwOrdinal
  ! push  pBstrName
  ! push  pBstrDllName
  ! push  invKind
  ! push  memid
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetRefTypeInfo
' PURPOSE:   If a type description references other type descriptions,
'            this function retrieves the referenced type descriptions.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetRefTypeInfo _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL hRefType  AS DWORD, _ ' [IN] Handle to the referenced type description to be returned
        ppTInfo   AS DWORD _  ' [OUT] Points to a pointer to the referenced type description
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetRefTypeInfo

  ! push  ppTInfo
  ! push  hRefType
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_AddressOfMember
' PURPOSE:   Retrieves the addresses of static functions or variables,
'            such as those defined in a DLL.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_AddressOfMember _
  ( _
  BYVAL pThis   AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL memid   AS LONG, _  ' [IN] Member ID (DISPID) of the static member whose address is to be retrieved
  BYVAL invKind AS DWORD, _ ' [IN] Specifies whether the member is a property, and if so, what kind
        ppv     AS DWORD _  ' [OUT] Upon return, points to a pointer to the static member
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.AddressOfMember

  ! push  ppv
  ! push  invKind
  ! push  memid
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_CreateInstance
' PURPOSE:   Creates a new instance of a type that describes a component
'            object class (coclass).
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_CreateInstance _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] ITypeInfo interface pointer
        pUnkOuter AS DWORD, _ ' [IN] A pointer to the controlling IUnknown. If NULL, then a stand-alone instance is created
        riid      AS GUID, _  ' [IN] An ID for the interface the caller will use to communicate with the resulting object
        ppvObj    AS DWORD _  ' [OUT] On return, points to a pointer to an instance of the created object
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.CreateInstance

  ! push  ppvObj
  ! mov   eax, riid
  ! push  eax
  ! push  pUnkOuter
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetMops
' PURPOSE:   Retrieves marshaling information.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetMops _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL memid     AS LONG, _  ' [IN] Member ID indicating which marshaling information is sought
        pBstrMops AS DWORD _  ' [OUT] Upon return, points to a pointer to the opcode string used in marshaling the fields of the structure described by the referenced type description, or NULL
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetMops

  ! push  pBstrMops
  ! push  memid
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_GetContainingTypeLib
' PURPOSE:   Retrieves the containing type library and the index of the
'            type description within that type library.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION ITypeInfo_GetContainingTypeLib _
  ( _
  BYVAL pThis   AS DWORD, _ ' [IN] ITypeInfo interface pointer
        ppTLib  AS DWORD, _ ' [OUT] Upon return, points to a pointer to the containing type library
        pIndex  AS DWORD _  ' [OUT] Upon return, points to the index of the type description within the containing type library
  ) AS LONG

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.GetContainingTypeLib

  ! push  pIndex
  ! push  ppTLib
  ! push  pThis
  ! call  lpfn
  ! mov   FUNCTION, eax       ' HRESULT

END FUNCTION

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_ReleaseTypeAttr
' PURPOSE:   Releases a TYPEATTR previously returned by GetTypeAttr.
' RETURN:
'
'-------------------------------------------------------------------------------

SUB ITypeInfo_ReleaseTypeAttr _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL pTypeAttr AS DWORD _  ' [IN] Pointer to the TYPEATTR to be freed
  )

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.ReleaseTypeAttr

  ! push  pTypeAttr
  ! push  pThis
  ! call  lpfn

END SUB

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_ReleaseFuncDesc
' PURPOSE:   Releases a FUNCDESC previously returned by GetFuncDesc.
' RETURN:
'
'-------------------------------------------------------------------------------

SUB ITypeInfo_ReleaseFuncDesc _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL pFuncDesc AS DWORD _  ' [IN] Pointer to the FUNCDESC to be freed
  )

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.ReleaseFuncDesc

  ! push  pFuncDesc
  ! push  pThis
  ! call  lpfn

END SUB

'-------------------------------------------------------------------------------
'
' PROCEDURE: ITypeInfo_ReleaseVarDesc
' PURPOSE:   Releases a VARDESC previously returned by GetVarDesc.
' RETURN:
'
'-------------------------------------------------------------------------------

SUB ITypeInfo_ReleaseVarDesc _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] ITypeInfo interface pointer
  BYVAL pVarDesc  AS DWORD _  ' [IN] Pointer to the VARDESC to be freed
  )

  LOCAL pVtbl   AS ITypeInfoVtbl PTR
  LOCAL lpfn    AS DWORD

  pVTbl = pThis
  lpfn  = @@pVtbl.ReleaseVarDesc

  ! push  pVarDesc
  ! push  pThis
  ! call  lpfn

END SUB

'-------------------------------------------------------------------------------
'
' PROCEDURE: TypeName
' PURPOSE:
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION TypeName(BYVAL oObject AS IUNKNOWN) AS STRING

  LOCAL szText          AS ASCIIZ * %MAX_PATH
  LOCAL riid            AS GUID  
  LOCAL pUnknown        AS DWORD 
  LOCAL pDispatch       AS DWORD
  LOCAL pTypeInfo       AS DWORD
  LOCAL pBstrName       AS DWORD 
  LOCAL hr              AS LONG

  IF ISOBJECT(oObject) THEN
    pUnknown = OBJPTR(oObject)
    riid = $IID_IDISPATCH
    hr = IUnknown_QueryInterface(pUnknown, riid, pDispatch)
    IF hr = %S_OK THEN 
      hr = IDispatch_GetTypeInfo(pDispatch, 0, GetUserDefaultLCID(), pTypeInfo)
      IF hr = %S_OK THEN                                                        
        hr = ITypeInfo_GetDocumentation(pTypeInfo, %MEMBERID_NIL,  pBstrName, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
        IF hr = %S_OK THEN
          WideCharToMultiByte %CP_ACP, 0, BYVAL pBstrName, -1, BYVAL VARPTR(szText), %MAX_PATH, BYVAL %NULL, BYVAL %NULL
          SysFreeString BYVAL pBstrName
        END IF
        IUnknown_Release pTypeInfo
      END IF
      IUnknown_Release pDispatch
    END IF
  END IF
  
  FUNCTION = szText  

END FUNCTION

**Eric Pearson** · 14 Feb 2011, 04:41 PM

Wow! Just a little something you whipped up on your lunch hour, Dominic? Very impressive.

-- Eric

**José Roca** · 14 Feb 2011, 06:07 PM

Hope one day Dominic will try my upcomig Windows API Headers for the upcoming new compilers. It eases this stuff very much.

Code:

#DIM ALL
#INCLUDE ONCE "ole2.inc"

FUNCTION TypeName(BYVAL oObject AS IUnknown) AS WSTRING

   LOCAL hr        AS LONG
   LOCAL pDispatch AS IDispatch
   LOCAL pTypeInfo AS ITypeInfo
   LOCAL bstrName  AS WSTRING 

   IF ISNOTHING(oObject) THEN EXIT FUNCTION
   pDispatch = oObject
   hr = pDispatch.GetTypeInfo(0, GetUserDefaultLCID, BYVAL VARPTR(pTypeInfo))
   IF hr = %S_OK THEN hr = pTypeInfo.GetDocumentation(%MEMBERID_NIL, bstrName, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
   FUNCTION = bstrName  

END FUNCTION

**Michael Mattias** · 14 Feb 2011, 07:25 PM

???

Code:

FUNCTION TypeName(BYVAL oObject AS IUnknown) [COLOR="Red"]AS WSTRING[/COLOR]
   LOCAL hr        AS LONG
   LOCAL pDispatch AS IDispatch
   LOCAL pTypeInfo AS ITypeInfo
   [COLOR="Red"]LOCAL bstrName  AS WSTRING[/COLOR]

As "WSTRING?"

Have you let some cat out of its bag?

MCM

**Dominic Mitchell** · 14 Feb 2011, 07:26 PM

Very nice, but I still prefer low-level COM.

As soon as I saw your post, I realized it would have been better to post it
using PowerBASIC COM. I grabbed your Ole2.inc file on my system, but lo and behold,
no ITypeInfo and whatnot. Oh well, I just don't have the time to convert the relevant
headers.

**Dominic Mitchell** · 14 Feb 2011, 07:31 PM

I see, they are in OAIdl.inc.

**Dominic Mitchell** · 14 Feb 2011, 07:46 PM

José's version modified to work with the current version of his includes.

Code:

#INCLUDE "OAIdl.inc"

FUNCTION TypeName(BYVAL oObject AS IUNKNOWN) AS STRING

   LOCAL hr        AS LONG
   LOCAL pDispatch AS IDISPATCH
   LOCAL pTypeInfo AS ITypeInfo
   LOCAL bstrName  AS STRING

   IF ISNOTHING(oObject) THEN EXIT FUNCTION
   pDispatch = oObject
   hr = pDispatch.GetTypeInfo(0, GetUserDefaultLCID, BYVAL VARPTR(pTypeInfo))
   IF hr = %S_OK THEN hr = pTypeInfo.GetDocumentation(%MEMBERID_NIL, bstrName, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
   FUNCTION = ACODE$(bstrName)

END FUNCTION

**José Roca** · 14 Feb 2011, 09:36 PM

Very nice, but I still prefer low-level COM.

My code is also low-level COM. The difference is that it uses interface definitions instead of wrappers, and PB's native support for direct interface calls.

**Robert Wallace** · 15 Feb 2011, 05:02 AM

Thank you all very much for your help.
Bob

Added later-----------------------------------------------

José's version modified to work with the current version of his includes

Worked perfectly as required

Announcement

What is the PBWin equivalent pf "TypeName" in VB

What is the PBWin equivalent pf "TypeName" in VB

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment