I needed to be able to enumerate through the members of a large UDT to compare them with each other. Since VB has no way to do this I created my own and though others may care.
Only works with variants.
VB Code:
Public Type Test2 aa As Variant bb As Variant cc As Variant dd As Variant ee As Variant End Type 'Copy Memory Func Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef pDest As Any, ByVal pSource As Any, ByVal Length As Long) 'VB own TypeName func, need to pass pointer Public Declare Function rTypeName Lib "MSVBVM60.dll" Alias "rtcTypeName" (ByVal SS As Any) As String '************************ 'In: pass TWO vaptr(UDTvariable) 's to func call with size of UDT 'Out: String Public Function CompareUDTs(UDTptr1 As Long, UDTptr2 As Long, UDTSize As Long) As String Dim retString As String Dim tempString As String Dim StringPtr As Long Dim i As Long Dim VariantType1 As String Dim VariantType2 As String Dim tempVariant1 As Variant Dim tempVariant2 As Variant Debug.Print UDTSize 'each variant is 16 bytes long For i = 0 To UDTSize - 16 Step 16 'lets determine the variant type for the fun of it VariantType1 = Replace(rTypeName(UDTptr1 + i), vbNullChar, "") VariantType2 = Replace(rTypeName(UDTptr2 + i), vbNullChar, "") Debug.Print VariantType1, VariantType2 'now copy the current variant to the tempvariant CopyMemory tempVariant1, UDTptr1 + i, 16 CopyMemory tempVariant2, UDTptr2 + i, 16 Debug.Print ":" & tempVariant1, tempVariant2 If tempVariant1 = tempVariant2 Then retString = retString & "Equal" & vbCrLf Else retString = retString & "Not Equal" & vbCrLf End If Next i Debug.Print retString CompareUDTs = retString End Function '****on FORM Private Sub Command1_Click() Dim ff As Test2 Dim cc As Test2 Dim aString As String ff.aa = "1" ff.bb = 200 ff.cc = "a" ff.dd = 1 ff.ee = 839 cc.aa = "0923" cc.bb = 200 cc.cc = "a" cc.dd = 10 cc.ee = 839 aString = CompareUDTs(VarPtr(ff), VarPtr(cc), Len(ff)) Text1.Text = aString End Sub





Reply With Quote