-
Feb 7th, 2023, 12:15 AM
#1
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.
-
Feb 7th, 2023, 02:35 AM
#2
Re: RecordCopy method (of IRecordInfo interface), how smart is it?
Yes, IRecordInfo::RecordCopy properly copies all the data. For example VariantCopy function does IRecordInfo::GetSize and allocates memory then copies data using IRecordInfo::RecordCopy
-
Feb 7th, 2023, 03:10 AM
#3
Re: RecordCopy method (of IRecordInfo interface), how smart is it?
Originally Posted by The trick
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|