Results 1 to 3 of 3

Thread: RecordCopy method (of IRecordInfo interface), how smart is it?

  1. #1

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

    RecordCopy method (of IRecordInfo interface), how smart is it?

    I'm continuing to mess around with this IRecordInfo stuff, and getting UDTs into Variants (dynamically, without an explicit typelib file for the UDT).

    I've got the basics of it figured out, and I'll be testing more complex stuff in the coming days.

    But the MSDN doesn't have a great deal of information on the RecordCopy method.

    Specifically, when used:
    • Will it duplicate BSTR strings?
    • Will it automatically increment the reference count if objects are items in the dynamic typelib UDT's definition?
    • Will it correctly copy static arrays?
    • Will it correctly copy dynamic (SafeArray) arrays?
    • Will it correctly handle nesting if a UDT is an item within the dynamic typelib's UDT, and all that comes with that?


    I'll be testing in the days to come, but thought I'd see if anyone else has been very far down this road.

    Here's basically where I am. Just throw this code into a Form1 in a project that has a reference to the oleexp.tlb.
    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 Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)
    Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long
    '
    Private Type VariantUdtType
        ' This is the structure inside a Variant when it's holding a UDT.
        vType       As Integer  ' Must be set to vbUserDefinedType.
        res1        As Integer
        res2        As Long
        pRecord     As Long     ' Pointer to actual UDT's data.
        pRecInfo    As Long     ' Structure info of the actual UDT.
    End Type
    '
    
    
    Private Type Udt0
        x As Long
        y As Single
    End Type
    
    Private Type Udt1
        x As Currency
        y As Double
    End Type
    
    
    
    Private Sub Form_Load()
        Dim tVarDesc    As VARDESC
    
        Dim cCreateTLB  As ICreateTypeLib
        Set cCreateTLB = CreateTypeLib2(SYS_WIN32, App.Path & "\temp.tlb")
        Dim cTLB        As ITypeLib
        Set cTLB = cCreateTLB
    
        Dim cCreateType0 As ICreateTypeInfo
        cCreateTLB.CreateTypeInfo "Udt0", TKIND_RECORD, cCreateType0
        Dim tGUID0      As UUID
        CoCreateGuid tGUID0
        cCreateType0.SetGuid tGUID0
    
        tVarDesc.elemdescVar.tdesc.vt = vbLong
        tVarDesc.memid = &H40000000
        cCreateType0.AddVarDesc 0&, tVarDesc
        cCreateType0.SetVarName 0&, "x"
    
        tVarDesc.elemdescVar.tdesc.vt = vbSingle
        tVarDesc.memid = &H40000001
        cCreateType0.AddVarDesc 1&, tVarDesc
        cCreateType0.SetVarName 1&, "y"
    
        Dim cRecInfo0    As IRecordInfo
        Set cRecInfo0 = GetRecordInfoFromTypeInfo(cTLB.GetTypeInfo(0&))
    
    
    
        Dim cCreateType1 As ICreateTypeInfo
        cCreateTLB.CreateTypeInfo "Udt1", TKIND_RECORD, cCreateType1
        Dim tGUID1      As UUID
        CoCreateGuid tGUID1
        cCreateType1.SetGuid tGUID1
    
        tVarDesc.elemdescVar.tdesc.vt = vbCurrency
        tVarDesc.memid = &H40000000
        cCreateType1.AddVarDesc 0&, tVarDesc
        cCreateType1.SetVarName 0&, "x"
    
        tVarDesc.elemdescVar.tdesc.vt = vbDouble
        tVarDesc.memid = &H40000001
        cCreateType1.AddVarDesc 1&, tVarDesc
        cCreateType1.SetVarName 1&, "y"
    
        Dim cRecInfo1    As IRecordInfo
        Set cRecInfo1 = GetRecordInfoFromTypeInfo(cTLB.GetTypeInfo(1&))
    
    
    
    
    
        ' Test UDT0.
        Dim vUDT0        As Variant
        vUDT0 = UDT_Variant(cRecInfo0)
        vUDT0.x = 5
        vUDT0.y = 10
        Debug.Print TypeName(vUDT0), vUDT0.x + vUDT0.y, TypeName(vUDT0.x), TypeName(vUDT0.y)
    
    
        ' Test UDT1.
        Dim vUDT1        As Variant
        vUDT1 = UDT_Variant(cRecInfo1)
        vUDT1.x = 15
        vUDT1.y = 20
        Debug.Print TypeName(vUDT1), vUDT1.x + vUDT1.y, TypeName(vUDT1.x), TypeName(vUDT1.y)
    
    
    
        Dim u0 As Udt0
    
    
        ' Test getting UDT in Variant into a standard UDT.
        Call UDT_FromVariant(cRecInfo0, vUDT0, VarPtr(u0))
        Debug.Print "The UDT", u0.x + u0.y, TypeName(u0.x), TypeName(u0.y)
    
    
    
    
    
        ' Test putting standard UDT into a Variant.
        u0.x = 11
        u0.y = 22
        vUDT0 = UDT_ToVariant(cRecInfo0, VarPtr(u0))
        Debug.Print TypeName(vUDT0), vUDT0.x + vUDT0.y, TypeName(vUDT0.x), TypeName(vUDT0.y)
    
    
    
    
    
    End Sub
    
    Private Function UDT_Variant(ByVal oRecInfo As IRecordInfo) As Variant
        ' This creates a Variant with our UDT ... all initialized to zero/empty.
        Dim vut As VariantUdtType
        vut.vType = vbUserDefinedType
        vut.pRecord = oRecInfo.RecordCreate
        vbaObjSetAddref vut.pRecInfo, ByVal ObjPtr(oRecInfo)
        CopyMemory UDT_Variant, vut, 16&
    End Function
    
    Private Sub UDT_FromVariant(oRecInfo As IRecordInfo, v As Variant, ByVal pUDT As Long)
        ' This copies our UDT in a Variant to a standard UDT.
        ' The Variant UDT won't be changed.
        Dim vut As VariantUdtType
        CopyMemory vut, v, 16&
        If vut.vType <> vbUserDefinedType Or vut.pRecord = 0& Then Exit Sub
        oRecInfo.RecordCopy ByVal vut.pRecord, ByVal pUDT
    End Sub
    
    Private Function UDT_ToVariant(oRecInfo As IRecordInfo, ByVal pUDT As Long) As Variant
        ' This copies our standard UDT into a Variant with our UDT.
        ' The standard UDT won't be changed.
        UDT_ToVariant = UDT_Variant(oRecInfo)
        Dim vut As VariantUdtType
        CopyMemory vut, UDT_ToVariant, 16&
        oRecInfo.RecordCopy ByVal pUDT, ByVal vut.pRecord
    End Function
    
    
    
    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

  3. #3

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

    Re: RecordCopy method (of IRecordInfo interface), how smart is it?

    Quote Originally Posted by The trick View Post
    Yes, IRecordInfo::RecordCopy properly copies all the data. For example VariantCopy function does IRecordInfo::GetSize and allocates memory then copies data using IRecordInfo::RecordCopy
    Thanks.

    I've tested BSTR strings, and they seem to work fine. I haven't had any sleep yet, but I'll test objects (in the UDT) tomorrow, along with dynamic arrays. I'm wondering how static arrays are handled, but that's a bit down the road.
    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.

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