Announcement

Collapse
No announcement yet.

What is the PBWin equivalent pf "TypeName" in VB

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • What is the PBWin equivalent pf "TypeName" in VB

    How do I program the equivalent of the VB command
    Code:
    Public Function TypeName(ByVal VarName As Object) As String
    e.g.
    myType = TypeName(myMysteryVariable)
    where myType will be string corresponding to the variable type (e.g. "Rectangle")
    Bob

    Later------------------------------------------------
    How do I correct a typo in the heading?
    Last edited by Robert Wallace; 12 Feb 2011, 11:40 AM. Reason: Typos!

  • #2
    >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
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      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.

      Comment


      • #4
        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
        Last edited by Robert Wallace; 14 Feb 2011, 07:23 AM.

        Comment


        • #5
          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
          Michael Mattias
          Tal Systems (retired)
          Port Washington WI USA
          [email protected]
          http://www.talsystems.com

          Comment


          • #6
            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.
            -- The universe tends toward maximum irony. Don't push it.

            File Extension Seeker - Metasearch engine for file extensions / file types
            Online TrID file identifier | TrIDLib - Identify thousands of file formats

            Comment


            • #7
              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
              Michael Mattias
              Tal Systems (retired)
              Port Washington WI USA
              [email protected]
              http://www.talsystems.com

              Comment


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

                Comment


                • #9
                  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.
                  -- The universe tends toward maximum irony. Don't push it.

                  File Extension Seeker - Metasearch engine for file extensions / file types
                  Online TrID file identifier | TrIDLib - Identify thousands of file formats

                  Comment


                  • #10
                    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
                    "Not my circus, not my monkeys."

                    Comment


                    • #11
                      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
                      Phoenix Visual Designer
                      http://www.phnxthunder.com

                      Comment


                      • #12
                        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
                        Dominic Mitchell
                        Phoenix Visual Designer
                        http://www.phnxthunder.com

                        Comment


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

                          -- Eric
                          "Not my circus, not my monkeys."

                          Comment


                          • #14
                            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
                            Forum: http://www.jose.it-berater.org/smfforum/index.php

                            Comment


                            • #15
                              ???
                              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
                              Michael Mattias
                              Tal Systems (retired)
                              Port Washington WI USA
                              [email protected]
                              http://www.talsystems.com

                              Comment


                              • #16
                                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
                                Phoenix Visual Designer
                                http://www.phnxthunder.com

                                Comment


                                • #17
                                  I see, they are in OAIdl.inc.
                                  Dominic Mitchell
                                  Phoenix Visual Designer
                                  http://www.phnxthunder.com

                                  Comment


                                  • #18
                                    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
                                    Dominic Mitchell
                                    Phoenix Visual Designer
                                    http://www.phnxthunder.com

                                    Comment


                                    • #19
                                      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.
                                      Forum: http://www.jose.it-berater.org/smfforum/index.php

                                      Comment


                                      • #20
                                        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
                                        Last edited by Robert Wallace; 15 Feb 2011, 02:00 PM.

                                        Comment

                                        Working...
                                        X