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

[Elroy]

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

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):

    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:

    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:

Public Type TestUdt
    i As Long
    ia(6) As Long
End Type

For the second question, how would we create the following:

Public Type TestUdt
    i As Long
    ia() As Long
End Type

For the third question, how would we create the following:

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):

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.

[Elroy]

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.

[fafalone]

ELEMDESC.TYPEDESC has a union with a ARRAYDESC struct.

[The trick]

For instance, for the first question, how would we create the following:

Public Type TestUdt
    i As Long
    ia(6) As Long
End Type

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"

For the second question, how would we create the following:

Public Type TestUdt
    i As Long
    ia() As Long
End Type

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"

For the third question, how would we create the following:

Public Type TestUdt
    i As Long
    f As StdFont
End Type

    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"

And for the last question, how would we do the following (specifically, the second UDT):

Public Type TestUdt1
    i As Long
    j As Long
End Type

Public Type TestUdt2
    k As Long
    u As TestUdt1
End Type

    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.

[Elroy]

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):

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.

[georgekar]

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).

[The trick]

georgekar does your interpreter use MSVBVM60?

[georgekar]

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

[The trick]

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

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

[georgekar]

Thank you.

[georgekar]

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).

[The trick]

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.

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

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).

[georgekar]

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).

[The trick]

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.

[georgekar]

@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).

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

[The trick]

Becuase there is difference between VARIANT and VARIANTARG. VB6 hides this so we have 1 Variant type either for usual variables and arguments. You could use such trick:

    ' // Put referenced value to o
    vbaVarLateMemCallLdRf o, p, ByVal StrPtr("q"), 0
    
    ' // Put to the referenced value actual data
    AssingByRef o

End Sub

Private Sub AssingByRef( _
            ByRef o As Variant)
    o = 9
End Sub