VBA - Persistence - CopyMemory can be used to serialise state

First, a health warning, the code in this blog comes with no warranty. Microsoft would say that copying memory can have unpredictable results. Nevertheless, if you are fascinated by VBA then you might be interested in the guts of VBA.

In the previous post I showed how LSet can be used to copy the state from a user-defined type (UDT) into a byte array and vice versa. This can be used in distributed systems but also one could save the byte array to a file and then load into a subsequent Excel session. Thus it is possible to persist a (UDT) to file, and if you use classes then you can gather all your class level variables into a UDT. One can begin to see how a whole object graph (i.e. the state of a whole hierarchy of classes) might be persist-able.

At the end of the previous post I introduced the CopyMemory() function and I used it to replace the copying of a byte array.

The copied byte array was located in a companion UDT defined solely for LSet-ting to the real UDT. I wondered if I could cut out the middle step and use CopyMemory() to copy directly from the byte array to the real UDT. I have conducted some experiments and you can so long as you use Byte arrays for your strings. Details of my experimental code follow.

modTestCopyStringToBytes Standard Module

So we need to treat strings differently because they are not inherently contiguous, we need to convert them to a byte array but this is not too difficult. What is important is ensuring that no overwriting of other memory happens. In the procedure TestCopyStringToBytes() below you can see that we find the length of the array and the length of the string we're asked to copy and we truncate the string if the byte array is not large enough. We copy over only safe number of bytes. The code has plenty of comments.

1. Option Explicit
2.  
3. '* No Warranty, use this code at your own risk!
4.  
5. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
6.  
7. '*
8. '* Not used in the main code.
9. '* Illustrates how strings have be treated carefully as an array of bytes
10. '*
11. Private Sub TestCopyStringToBytes()
12.  
13.     '* set up string
14.     Dim sRHS As String
15.     sRHS = "hello world"
16.  
17.     '* defining the string length here but it could passed in and thus unknown
18.     Dim abStringAsBytes(0 To 9) As Byte
19.  
20.     '* standard array length determination, I know it is fixed above but ...
21.     '* ... in other cases the array could be passed in and be of unknown length
22.     Dim lMaxLen As Long
23.     lMaxLen = (UBound(abStringAsBytes) - LBound(abStringAsBytes) + 1)
24.  
25.     '* we'd like to not overwrite the allocated memory so truncate the string
26.     '* remember strings are two bytes for each character so we divide by 2
27.     Dim sSafeRHS As String
28.     sSafeRHS = Left$(sRHS, lMaxLen / 2)
29.  
30.     '* give a truncation warning to avoid shock
31.     If lMaxLen < Len(sRHS) Then Debug.Print "Warning contents of sRHS will be truncated from '" & sRHS & "' to '" & sSafeRHS & "'"
32.  
33.     '* this next function will copy the memory from the string sSafeRHS to the first byte of the byte array, abStringAsBytes(0)
34.     CopyMemory ByVal VarPtr(abStringAsBytes(0)), ByVal StrPtr(sSafeRHS), LenB(sSafeRHS)
35.  
36.     '* this next line works thanks to VBA being nice and interpreting a byte array as a string for us
37.     '* (saves us having to reverse the memory copy operation)
38.     Debug.Print abStringAsBytes
39. End Sub

If you run the code you should get a truncation warning and the output of the copied truncated string like this

Warning contents of sRHS will be truncated from 'hello world' to 'hello'
hello

modCopyMemoryDirectToUdt Standard Module

Here is a a very full listing with plenty of debug code to illustrate what is going on. The code is heavily commented. The indented code in Main() is not strictly necessary but it serves as a guide as to what is going on.

1. Option Explicit
2.  
3. '* No Warranty, use this code at your own risk!
4.  
5. Private Const mlPAD As Long = 28 '* just for formatting
6.  
7. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
8.  
9. '*
10. '* See here we only need one type per entity/class
11. '* DO NOT USE   "aFixedString As String * 20" as it is not contiguous!
12. '* INSTEAD USE  "aFixedStringAsBytes(0 To 19) As Byte"
13. '*
14. Public Type udtContiguousType
15.     aLong As Long
16.     anInt As Integer
17.     aDouble As Double
18.     aFixedStringAsBytes(0 To 9) As Byte  '
19.     aSecondLong As Long
20.     aSecondDouble As Double
21. End Type
22.  
23. '*
24. '* The following property procedures could be adjusted to sit in a class
25. '* the class could store the string as a byte array in the class's state UDT
26. '* to the callers of the class the property could look like just a string
27. '*
28. Property Let MyFixedString(ByRef uType As udtContiguousType, ByVal sRHS As String)
29.  
30.     '* array length determination
31.     Dim lMaxLen As Long
32.     lMaxLen = ByteArrayLen(uType.aFixedStringAsBytes)
33.  
34.     '* we'd like to not overwrite the allocated memory so truncate the string
35.     '* remember strings are two bytes for each character so we divide by 2
36.     Dim sSafeRHS As String
37.     sSafeRHS = Left$(sRHS, lMaxLen / 2)
38.  
39.     '* give a truncation warning to avoid shock
40.     If lMaxLen < Len(sRHS) Then Debug.Print "Warning contents of sRHS will be truncated from '" & sRHS & "' to '" & sSafeRHS & "'"
41.  
42.     '* this next function will copy the memory from the string sSafeRHS ...
43.     '* ... to the first byte of the byte array, uType.aFixedStringAsBytes(0)
44.     CopyMemory ByVal VarPtr(uType.aFixedStringAsBytes(0)), ByVal StrPtr(sSafeRHS), LenB(sSafeRHS)
45. End Property
46.  
47. Property Get MyFixedString(ByRef uType As udtContiguousType) As String
48.     '* this line works thanks to VBA being nice and interpreting a byte array as a string for us
49.     '* (saves us having to reverse the memory copy operation)
50.     MyFixedString = uType.aFixedStringAsBytes
51. End Property
52.  
53.  
54. '*
55. '* the main code, run this code
56. '*
57. Private Sub Main()
58.     Dim bDebug As Boolean
59.     bDebug = True
60.  
61.     Dim uTypeSrc As udtContiguousType
62.     Dim uTypeDest As udtContiguousType
63.  
64.     '* set some values just like any other UDT, except for the strings
65.     uTypeSrc.aLong = 1
66.     uTypeSrc.anInt = 2
67.     uTypeSrc.aDouble = 3.141
68.     uTypeSrc.aSecondLong = -434634634
69.     uTypeSrc.aSecondDouble = Sqr(10) * -1
70.  
71.     '* we have to treat strings specially
72.     '* the string's special treatment is abstracted by the property procedures
73.     MyFixedString(uTypeSrc) = "hello world"
74.  
75.     If bDebug Then
76.         '* we have to be aware of truncation
77.         Debug.Assert MyFixedString(uTypeSrc) = Left$("hello world", ByteArrayLen(uTypeSrc.aFixedStringAsBytes) / 2)
78.  
79.         '* for illustration we print the memory addresses so that one can see the udt's memory layout , not strictly necessary
80.         PrintMemoryAddresses "uTypeSrc", uTypeSrc
81.  
82.         '* these next lines highlight the byte length of each member
83.         '* not strictly necessary
84.         Debug.Assert VarPtr(uTypeSrc) = VarPtr(uTypeSrc.aLong)
85.         Debug.Assert VarPtr(uTypeSrc.anInt) - VarPtr(uTypeSrc.aLong) = 4
86.         Debug.Assert VarPtr(uTypeSrc.aDouble) - VarPtr(uTypeSrc.anInt) = 4
87.         Debug.Assert VarPtr(uTypeSrc.aFixedStringAsBytes(0)) - VarPtr(uTypeSrc.aDouble) = 8
88.         Debug.Assert VarPtr(uTypeSrc.aSecondLong) - VarPtr(uTypeSrc.aFixedStringAsBytes(0)) =
89.                                                             BytesAlignedLen(ByteArrayLen(uTypeSrc.aFixedStringAsBytes))
90.         Debug.Assert VarPtr(uTypeSrc.aSecondDouble) - VarPtr(uTypeSrc.aSecondLong) = 4
91.  
92.         '* for illustration we print the memory addresses so that one can see the udt's memory layout , not strictly necessary
93.         PrintMemoryAddresses "uTypeDest", uTypeDest
94.  
95.         '* more layout illustration
96.         Debug.Assert VarPtr(uTypeDest) = VarPtr(uTypeDest.aLong)
97.     End If
98.  
99.     CopyMemory ByVal (VarPtr(uTypeDest.aLong)), ByVal (VarPtr(uTypeSrc.aLong)), LenB(uTypeSrc)
100.  
101.     If bDebug Then
102.         Debug.Assert MyFixedString(uTypeDest) = Left$("hello world", ByteArrayLen(uTypeSrc.aFixedStringAsBytes) / 2)
103.         Debug.Assert uTypeDest.aLong = uTypeSrc.aLong
104.         Debug.Assert uTypeDest.anInt = uTypeSrc.anInt
105.         Debug.Assert uTypeDest.aDouble = uTypeSrc.aDouble
106.         Debug.Assert MyFixedString(uTypeDest) = MyFixedString(uTypeSrc)
107.         Debug.Assert uTypeDest.aSecondLong = uTypeSrc.aSecondLong
108.         Debug.Assert uTypeDest.aSecondDouble = uTypeSrc.aSecondDouble
109.     End If
110.     Stop 'please go look at the Locals window
111. End Sub
112.  
113. '*
114. '* standard array length calculation
115. '*
116. Private Function ByteArrayLen(ByRef abBytes() As Byte) As Long
117.     ByteArrayLen = (UBound(abBytes()) - LBound(abBytes()) + 1)
118. End Function
119.  
120. '*
121. '* each member of a user defined type is 32-bit aligned so this function calcs the aligned byte length
122. '*
123. Private Function BytesAlignedLen(ByVal cbByteCount As Long) As Long
124.     If cbByteCount \ 4 = cbByteCount / 4 Then
125.         BytesAlignedLen = cbByteCount
126.     Else
127.         BytesAlignedLen = ((cbByteCount \ 4) + 1) * 4
128.     End If
129. End Function
130.  
131. '*
132. '* this prints the memory addresses so one can see the memory laid out
133. '*
134. Private Function PrintMemoryAddresses(ByVal sVarName As String, ByRef uType As udtContiguousType)
135.     Debug.Print()
136.     Debug.Print Pad("&" & sVarName & "", mlPAD) & " = " & VarPtr(uType)
137.     Debug.Print Pad("&" & sVarName & ".aLong", mlPAD) & " = " & VarPtr(uType.aLong) & " a Long has 4 bytes"
138.     Debug.Print Pad("&" & sVarName & ".anInt", mlPAD) & " = " & VarPtr(uType.anInt) &
139.         " an Int has 2 bytes but is 32-bit aligned so has 4 bytes"
140.     Debug.Print Pad("&" & sVarName & ".aDouble", mlPAD) & " = " & VarPtr(uType.aDouble) & " a Double has 8 bytes"
141.  
142.     Dim lMaxLen As Long
143.     lMaxLen = ByteArrayLen(uType.aFixedStringAsBytes)
144.  
145.     Dim lAlignedMaxLen As Long
146.     lAlignedMaxLen = BytesAlignedLen(lMaxLen)
147.  
148.     Dim sByteLen As String
149.     sByteLen = " this byte array has " & lMaxLen & " bytes" &
150.         VBA.IIf(lAlignedMaxLen <> lMaxLen, " but is 32-bit aligned to " & lAlignedMaxLen & " bytes", "")
151.  
152.     Debug.Print Pad("&" & sVarName & ".aFixedStringAsBytes", mlPAD) & " = " & VarPtr(uType.aFixedStringAsBytes(0)) & sByteLen
153.     Debug.Print Pad("&" & sVarName & ".aSecondLong", mlPAD) & " = " & VarPtr(uType.aSecondLong) & " a Long has 4 bytes"
154.     Debug.Print Pad("&" & sVarName & ".aSecondDouble", mlPAD) & " = " & VarPtr(uType.aSecondDouble) & " a Double has 8 bytes"
155.     Debug.Print Pad("&" & sVarName & " total length", mlPAD) & " = " & LenB(uType)
156.  
157. End Function
158.  
159. '*
160. '* this pads a string to help it looks columnar
161. '*
162. Private Function Pad(ByVal sText As String, ByVal lLen As Long) As String
163.     Pad = Left$(sText & String(lLen, " "), lLen)
164. End Function

So when the Main() code runs we have two things to look at (1) the Immediate Window and (2) the Locals Window. Here are mine, firstly the Immediate Window

Warning contents of sRHS will be truncated from 'hello world' to 'hello'

&uTypeSrc                    = 5240168
&uTypeSrc.aLong              = 5240168 a Long has 4 bytes
&uTypeSrc.anInt              = 5240172 an Int has 2 bytes but is 32-bit aligned so has 4 bytes
&uTypeSrc.aDouble            = 5240176 a Double has 8 bytes
&uTypeSrc.aFixedStringAsByte = 5240184 this byte array has 10 bytes but is 32-bit aligned to 12 bytes
&uTypeSrc.aSecondLong        = 5240196 a Long has 4 bytes
&uTypeSrc.aSecondDouble      = 5240200 a Double has 8 bytes
&uTypeSrc total length       = 40

&uTypeDest                   = 5240128
&uTypeDest.aLong             = 5240128 a Long has 4 bytes
&uTypeDest.anInt             = 5240132 an Int has 2 bytes but is 32-bit aligned so has 4 bytes
&uTypeDest.aDouble           = 5240136 a Double has 8 bytes
&uTypeDest.aFixedStringAsByt = 5240144 this byte array has 10 bytes but is 32-bit aligned to 12 bytes
&uTypeDest.aSecondLong       = 5240156 a Long has 4 bytes
&uTypeDest.aSecondDouble     = 5240160 a Double has 8 bytes
&uTypeDest total length      = 40

Now here is my Locals Window screenshot with the variables expanded to show the members. It shows the contents successfully copied from uTypeSrc to uTypeDest.

Commentary

It is interesting that VBA could potentially participate in a persistence scheme. I am minded to investigate the persistence interfaces of the COM specification such as IPersist to see if VBA could indeed play in this league. One problem is that IPersist has non Automation types so one would need to define a proxy component and a proxy interface.

Final Warranty Warning

I can't give a warranty for this code (nor any code on this blog for that matter).