Results 1 to 16 of 16

Thread: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Resolved [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    Ok, the following code was posted by The Trick (here), and I have been extensively playing with it.

    Code:
    Option Explicit
    
    Private Declare Sub memcpy Lib "kernel32" _
                        Alias "RtlMoveMemory" ( _
                        ByRef Destination As Any, _
                        ByRef Source As Any, _
                        ByVal Length As Long)
    Private Declare Function vbaObjSetAddref Lib "MSVBVM60.DLL" _
                             Alias "__vbaObjSetAddref" ( _
                             ByRef dstObject As Any, _
                             ByRef srcObjPtr As Any) As Long
                            
    Private Sub Form_Load()
        Dim cCreateTLB  As ICreateTypeLib
        Dim cCreateType As ICreateTypeInfo
        Dim cTLB        As ITypeLib
        Dim cInfo       As IRecordInfo
        Dim tVarDesc    As VARDESC
        Dim tGUID       As UUID
        Dim vUDT        As Variant
        Dim cCol        As New Collection
        
        Set cCreateTLB = CreateTypeLib2(SYS_WIN32, "temp")              ' // Create a library
        
        cCreateTLB.CreateTypeInfo "POINT", TKIND_RECORD, cCreateType    ' // Create POINT type
    
        tVarDesc.elemdescVar.tdesc.vt = VT_I4                           ' // Long type
        
        tVarDesc.memid = &H40000000
        cCreateType.AddVarDesc 0, tVarDesc                              ' // x field
        cCreateType.SetVarName 0, "x"
        tVarDesc.memid = &H40000001
        cCreateType.AddVarDesc 1, tVarDesc                              ' // y field
        cCreateType.SetVarName 1, "y"
        
        CoCreateGuid tGUID
        
        cCreateType.SetGuid tGUID                                       ' // Set UUID
        cCreateTLB.SaveAllChanges
        
        Set cTLB = cCreateTLB
        Set cInfo = GetRecordInfoFromTypeInfo(cTLB.GetTypeInfo(0))      ' // Get IRecordInfo
    
        vUDT = MakePoint(cInfo)
        
        vUDT.x = 5
        vUDT.y = 10
        
        cCol.Add vUDT
        
    End Sub
    
    Private Function MakePoint( _
                     ByVal cRI As IRecordInfo) As Variant
        Dim lData(3)    As Long
        
        lData(0) = VT_RECORD
        lData(2) = cRI.RecordCreate
        vbaObjSetAddref lData(3), ByVal ObjPtr(cRI)
        memcpy ByVal VarPtr(MakePoint), lData(0), 16
        
    End Function

    So far, I've discovered that it works just fine with BSTR strings as well as late-bound objects. And, for both, memory management as well as reference counting seem to all be handled correctly (under the hood).

    For instance, the following works just fine (including creating Variant variables):

    Code:
        tVarDesc.elemdescVar.tdesc.vt = vbLong                      
        tVarDesc.memid = &H40000000
        cCreateType.AddVarDesc 0, tVarDesc                             
        cCreateType.SetVarName 0, "x"
        
        
        tVarDesc.elemdescVar.tdesc.vt = vbString                    
        tVarDesc.memid = &H40000001
        cCreateType.AddVarDesc 1, tVarDesc                            
        cCreateType.SetVarName 1, "s"
    Or, we can do the following, and it works just fine:

    Code:
        tVarDesc.elemdescVar.tdesc.vt = vbLong                      
        tVarDesc.memid = &H40000000
        cCreateType.AddVarDesc 0, tVarDesc                             
        cCreateType.SetVarName 0, "x"
        
        
        tVarDesc.elemdescVar.tdesc.vt = vbObject                    
        tVarDesc.memid = &H40000001
        cCreateType.AddVarDesc 1, tVarDesc                            
        cCreateType.SetVarName 1, "o"
    ... and then we can use that vbObject item and Set any object into it we want, with the reference counter doing what it should.

    -------------------------

    So, I've now got four questions:
    1. How would we create a static array item?
    2. How would we create a dynamic array item?
    3. How would we create an early-bound item?
    4. How would we create a nested UDT item?



    For instance, for the first question, how would we create the following:
    Code:
    Public Type TestUdt
        i As Long
        ia(6) As Long
    End Type
    For the second question, how would we create the following:
    Code:
    Public Type TestUdt
        i As Long
        ia() As Long
    End Type
    For the third question, how would we create the following:
    Code:
    Public Type TestUdt
        i As Long
        f As StdFont
    End Type
    And for the last question, how would we do the following (specifically, the second UDT):
    Code:
    Public Type TestUdt1
        i As Long
        j As Long
    End Type
    
    Public Type TestUdt2
        k As Long
        u As TestUdt1
    End Type
    These questions are probably for The Trick (if he's so inclined to answer). However, anyone who thinks they know an answer is certainly encouraged to reply.

    And just as an FYI, I'm working on code that makes all of this easy to use. I'll post it in the CodeBank when it's done, but I'd like to make it as generalized as possible before posting it. One of the nice features of all of this is that it can be used "dynamically", or it can be used as a "utility" to create TLB files for UDTs that would then be used in other projects.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  2. #2

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: UDTs to Variants without a TypeLib File - Advanced

    And just as an FYI, I tried playing around with vbArray (aka, VT_ARRAY), but it wouldn't work. I tried it with something like vbLong in the tVarDesc.elemdescVar.tdesc.vt assignment, but the code kept throwing up on the cCreateType.AddVarDesc 0, tVarDesc line.
    Last edited by Elroy; Feb 8th, 2023 at 12:21 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  3. #3
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: UDTs to Variants without a TypeLib File - Advanced

    ELEMDESC.TYPEDESC has a union with a ARRAYDESC struct.

  4. #4
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: UDTs to Variants without a TypeLib File - Advanced

    Quote Originally Posted by Elroy View Post
    For instance, for the first question, how would we create the following:
    Code:
    Public Type TestUdt
        i As Long
        ia(6) As Long
    End Type
    Code:
    Private Type TARRAYDESC
        tdescElem   As TYPEDESC
        cDims       As Integer
        tSA         As SAFEARRAYBOUND
    End Type
    
    ...
    
    
    Dim tArrInfo    As TARRAYDESC
    
    ...
    
        tArrInfo.cDims = 1
        tArrInfo.tdescElem.vt = VT_I4
        tArrInfo.tSA.cElements = 7
        
        tVarDesc.elemdescVar.tdesc.vt = VT_CARRAY
        tVarDesc.elemdescVar.tdesc.pTypeDesc = VarPtr(tArrInfo)
        
        cCreateType.AddVarDesc 1, tVarDesc                              ' // ia field
        cCreateType.SetVarName 1, "ia"
    Quote Originally Posted by Elroy View Post
    For the second question, how would we create the following:
    Code:
    Public Type TestUdt
        i As Long
        ia() As Long
    End Type
    Code:
    Dim tArrInfo    As TYPEDESC
    
    ...
    
        tArrInfo.vt = VT_I4
        
        tVarDesc.elemdescVar.tdesc.vt = VT_SAFEARRAY
        tVarDesc.elemdescVar.tdesc.pTypeDesc = VarPtr(tArrInfo)
        
        cCreateType.AddVarDesc 1, tVarDesc                              ' // ia field
        cCreateType.SetVarName 1, "ia"
    Quote Originally Posted by Elroy View Post
    For the third question, how would we create the following:
    Code:
    Public Type TestUdt
        i As Long
        f As StdFont
    End Type
    Code:
        Dim cStdOle2    As ITypeLib
        Dim cFontDesc   As ITypeInfo
        Dim tObjInfo    As TYPEDESC
        Dim hFontRef    As Long
    
    ...
    
        Set cStdOle2 = LoadTypeLibEx("stdole2.tlb", REGKIND_NONE)
        cStdOle2.FindName "Font", 0, cFontDesc, 0, 1
        
        cCreateType.AddRefTypeInfo cFontDesc, hFontRef
        
        tObjInfo.vt = VT_USERDEFINED
        tObjInfo.pTypeDesc = hFontRef
        
        tVarDesc.elemdescVar.tdesc.vt = VT_PTR
        tVarDesc.elemdescVar.tdesc.pTypeDesc = VarPtr(tObjInfo)
        
        cCreateType.AddVarDesc 1, tVarDesc                              ' // f field
        cCreateType.SetVarName 1, "f"
    Quote Originally Posted by Elroy View Post
    And for the last question, how would we do the following (specifically, the second UDT):
    Code:
    Public Type TestUdt1
        i As Long
        j As Long
    End Type
    
    Public Type TestUdt2
        k As Long
        u As TestUdt1
    End Type
    Code:
        Dim hSubType    As Long
        Dim cInfo2      As ICreateTypeInfo
        
        Set cCreateTLB = CreateTypeLib2(SYS_WIN32, "temp")              ' // Create a library
    
        cCreateTLB.CreateTypeInfo "TestUdt2", TKIND_RECORD, cInfo2       ' // Create TestUdt2 type
    
        tVarDesc.elemdescVar.tdesc.vt = VT_I4                           ' // Long type
        
        tVarDesc.memid = &H40000000
        cInfo2.AddVarDesc 0, tVarDesc                                   ' // i field
        cInfo2.SetVarName 0, "i"
        tVarDesc.memid = &H40000001
        cInfo2.AddVarDesc 1, tVarDesc                                   ' // j field
        cInfo2.SetVarName 1, "j"
    
        cCreateTLB.CreateTypeInfo "TestUdt1", TKIND_RECORD, cCreateType ' // Create TestUdt1 type
    
        tVarDesc.memid = &H40000002
        cCreateType.AddVarDesc 0, tVarDesc                              ' // k field
        cCreateType.SetVarName 0, "k"
        
        cCreateType.AddRefTypeInfo cInfo2, hSubType
    
        tVarDesc.elemdescVar.tdesc.vt = VT_USERDEFINED
        tVarDesc.elemdescVar.tdesc.pTypeDesc = hSubType
        
        tVarDesc.memid = &H40000003
        cCreateType.AddVarDesc 1, tVarDesc                              ' // u field
        cCreateType.SetVarName 1, "u"
        
        CoCreateGuid tGUID
        cCreateType.SetGuid tGUID                                       ' // Set UUID
        CoCreateGuid tGUID
        cInfo2.SetGuid tGUID
    The last example won't work until fafalone fix the bug.

  5. #5

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: UDTs to Variants without a TypeLib File - Advanced

    Ok, I got the nested UDTs going (using Fafalone's updated oleexp.tlb, updated earlier today).

    It took a bit of jiggling to get Trick's code going, so I thought I'd post some working code here that does it.

    This is code to just throw into a Form1 (with Fafalone's oleexp.tlb version 5.4 or later referenced):
    Code:
    
    Option Explicit
    
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
    Private Declare Function vbaObjSetAddref Lib "MSVBVM60.DLL" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long
    
    Private Sub Form_Load()
        Dim cCreateTLB  As ICreateTypeLib
        Dim cInfo1      As ICreateTypeInfo
        Dim cInfo2      As ICreateTypeInfo
        Dim cTLB        As ITypeLib
        Dim cRecInfo1   As IRecordInfo
        Dim cRecInfo2   As IRecordInfo
        Dim tVarDesc    As VARDESC
        Dim tGUID       As UUID
        Dim vUDT1       As Variant
        Dim vUDT2       As Variant
    
    
        Dim hSubType    As Long
    
        Set cCreateTLB = CreateTypeLib2(SYS_WIN32, App.Path & "\TestUdt.tlb")              ' // Create a library
        Set cTLB = cCreateTLB
    
        cCreateTLB.CreateTypeInfo "Udt1", TKIND_RECORD, cInfo1       ' // Create Udt1 type
    
        tVarDesc.elemdescVar.tdesc.vt = VT_I4                           ' // Long type
    
        tVarDesc.memid = &H40000000
        cInfo1.AddVarDesc 0, tVarDesc                                   ' // i field
        cInfo1.SetVarName 0, "i"
        tVarDesc.memid = &H40000001
        cInfo1.AddVarDesc 1, tVarDesc                                   ' // j field
        cInfo1.SetVarName 1, "j"
    
        CoCreateGuid tGUID
        cInfo1.SetGuid tGUID                                       ' // Set UUID
    
    
    
        cCreateTLB.CreateTypeInfo "Udt2", TKIND_RECORD, cInfo2      ' // Create Udt2 type
    
        tVarDesc.memid = &H40000000
        cInfo2.AddVarDesc 0, tVarDesc                              ' // k field
        cInfo2.SetVarName 0, "k"
    
        Set cRecInfo1 = GetRecordInfoFromTypeInfo(cTLB.GetTypeInfo(0))      ' // Get IRecordInfo
    
    
        Dim cTypeInfo1 As ITypeInfo
        Set cTypeInfo1 = cTLB.GetTypeInfo(0)
    
        cInfo2.AddRefTypeInfo cTypeInfo1, hSubType
    
        tVarDesc.elemdescVar.tdesc.vt = VT_USERDEFINED
        tVarDesc.elemdescVar.tdesc.pTypeDesc = hSubType
    
        tVarDesc.memid = &H40000001
        cInfo2.AddVarDesc 1, tVarDesc                              ' // u field
        cInfo2.SetVarName 1, "u"
    
        CoCreateGuid tGUID
        cInfo2.SetGuid tGUID
    
    
        Set cRecInfo2 = GetRecordInfoFromTypeInfo(cTLB.GetTypeInfo(1))      ' // Get IRecordInfo
    
    
    
        cCreateTLB.SaveAllChanges
    
    
        vUDT1 = MakeVariant(cRecInfo1)
    
        vUDT1.i = 333
        vUDT1.j = 444
    
        Debug.Print vUDT1.i + vUDT1.j
    
        vUDT2 = MakeVariant(cRecInfo2)  ' This one has the nesting.
    
        vUDT2.k = 111
        vUDT2.u.i = 222
        vUDT2.u.j = 555
    
        Debug.Print vUDT2.k + vUDT2.u.i + vUDT2.u.j
    
    
    
    End Sub
    
    Private Function MakeVariant(ByVal cRI As IRecordInfo) As Variant
        Dim lData(3)    As Long
    
        lData(0) = vbUserDefinedType
        lData(2) = cRI.RecordCreate
        vbaObjSetAddref lData(3), ByVal ObjPtr(cRI)
        CopyMemory ByVal VarPtr(MakeVariant), lData(0), 16&
    
    End Function
    
    
    
    This gives me about everything I need for dynamic typelibs of UDTs. In the next few days, I'll be posting a codebank entry that has it all cleaned up.
    (Or I hope it's in a few days. I'm leaving on a two-week camping trip early next week. I'm hoping to get it all done before that, but no promises.)

    I'll just say it here though ... huge thanks go out to The Trick. I'd never have gotten this done without his guidance. A big thanks goes out to Fafalone as well for his oleexp.tlb work, and his willingness to stomp bugs in it. I must also mention Schmidt because some snippets of his code gave me inspiration on how to do some pieces of all this, specifically, copying data from a Variant containing a UDT to a standard UDT (and vice-versa).

    I think this thread is resolved.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  6. #6
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    i would like to include UDT to M2000 interpreter. I check that I can load udt from a class function, populate with values through that function, and I can send the returned udt to another class function and get a string which saw that the values passed from the first function to second from udt, but I can't for now use fields to put/get values from udt to other variables (those of interpreter which are variants). I have to make something like funcPut(variantHaveUdt, stringwithnameoffield, value2put) as Boolean (return false if the name of field is wrong- not exist- or the type of value aren't the proper one for that field).

  7. #7

  8. #8
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    Interpreter is written in Vb6.
    https://github.com/M2000Interpreter/Environment

  9. #9
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    Quote Originally Posted by georgekar View Post
    Code:
    Option Explicit
    
    Private Declare Function vbaVarLateMemSt Lib "msvbvm60" _
                             Alias "__vbaVarLateMemSt" ( _
                             ByRef vDst As Variant, _
                             ByRef sName As Any, _
                             ByVal vValue As Variant) As Long
    Private Declare Function vbaVarLateMemCallLdRf CDecl Lib "msvbvm60" _
                             Alias "__vbaVarLateMemCallLdRf" ( _
                             ByRef vDst As Variant, _
                             ByRef vSrc As Variant, _
                             ByRef sName As Any, _
                             ByVal cArgs As Long) As Long
    
    Private Sub Form_Load()
        Dim p As Variant
        Dim j As Variant
        
        ' // Put your UDT to p
        
        ....
        
        ' // Put 12 to i field of UDT in Variant p
        vbaVarLateMemSt p, ByVal StrPtr("i"), 12
        
        ' // Get i field of UDT in Variant p to j variable
        vbaVarLateMemCallLdRf j, p, ByVal StrPtr("i"), 0
        
        MsgBox j
        
    End Sub

  10. #10
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    Thank you.

  11. #11
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    What about cArgs in vbaVarLateMemCallLdRf
    If i want to get an array element from a static array I have to place arguments for that call.

    Also how I can get not the value but the reference of the value (like a Varptr on selected field). I need that for "+=" type of operators, and although for first level fields on UDT can be used by holding the actual UDT in a variant, but the inner UDT has to be accessed without a copy of that, and getting the varptr of the field to be "updated" through an operator "+=" (and the same for just reading the inner value without produce a copy of inner UDT).


  12. #12
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    Quote Originally Posted by georgekar View Post
    What about cArgs in [COLOR=#333333]vbaVarLateMemCallLdRf
    If i want to get an array element from a static array I have to place arguments for that call.
    Code:
    Private Declare Function vbaVarLateMemCallLdRf2 CDecl Lib "msvbvm60" _
                             Alias "__vbaVarLateMemCallLdRf" ( _
                             ByRef vDst As Variant, _
                             ByRef vSrc As Variant, _
                             ByRef sName As Any, _
                             ByVal cArgs As Long, _
                             ByVal vArg1) As Long
    
    ...
    
        Dim p As Variant
        Dim z As Variant
    
        p.j(7) = "test"
    
        vbaVarLateMemCallLdRf2 z, p, ByVal StrPtr("j"), 1, 7
        
        MsgBox z
    Quote Originally Posted by georgekar View Post
    Also how I can get not the value but the reference of the value (like a Varptr on selected field). I need that for "+=" type of operators, and although for first level fields on UDT can be used by holding the actual UDT in a variant, but the inner UDT has to be accessed without a copy of that, and getting the varptr of the field to be "updated" through an operator "+=" (and the same for just reading the inner value without produce a copy of inner UDT).
    vbaVarLateMemCallLdRf returns already a reference to value wrapped to Variant (VT_BYREF).

  13. #13
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    I have also another idea:
    Elroy thought and this is ok that we make an UDT for the whole run of the current program. But for my interpreter, which run on a vb6 program (the IDE and Runtime is the same), the UDT may defined more than one time and some times with different fields, the same in a vb6 program in the vb6 ide. Is there anything to "dismiss" the typelib or something, and start a new variant definition again (with the same name).

  14. #14
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,672

    Re: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    Quote Originally Posted by georgekar View Post
    I have also another idea:
    Elroy thought and this is ok that we make an UDT for the whole run of the current program. But for my interpreter, which run on a vb6 program (the IDE and Runtime is the same), the UDT may defined more than one time and some times with different fields, the same in a vb6 program in the vb6 ide. Is there anything to "dismiss" the typelib or something, and start a new variant definition again (with the same name).
    Just create a new typelib.

  15. #15
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: [RESOLVED] UDTs to Variants without a TypeLib File - Advanced

    @trick
    I check it if using vbaVarLateMemCallLdRf to read a field I can write back, and that not worked (the rep variant get the new value but without writing back to udt field). So this means that rep isn't a reference (I check the integer value at Varptr(rep) and show 36).

    Code:
    Public Sub PlaceValue2UDT(p, Name$, v)
        'vbaVarLateMemSt p, ByVal StrPtr(LCase(name$)), v
    
    
        vbaVarLateMemCallLdRf rep, p, ByVal StrPtr(LCase(Name$)), 0
        If MemByte(VarPtr(rep)) = 9 Then
        Set rep = v
        Else
        rep = v
        End If
    End Sub

  16. #16

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width