Fast Native Memory Manipulation in VBA

Question

I've been quite annoyed lately by the fact that the CopyMemory API (RtlMoveMemory on Windows and MemMove on Mac) is running much slower than it used to, on certain computers. For example on one of my machines (x64 Windows and x32 Office) the CopyMemory API is running about 600 times slower than a month ago. I did do a Windows Update lately and maybe that is why. In this SO question is seems that Windows Defender is the cause of slowness. Regardless of why the API is much slower, it is unusable if the operations involving the API need to run many times (e.g. millions of times).

Even without the issue mentioned above, CopyMemory API is slower than other alternatives. Since I did not want to use references to msvbvm60.dll which is not available on most of my machines, I decided to create something similar with the GetMemX and PutMemX methods available in the mentioned dll. So, I created a couple of properties (Get/Let) called MemByte, MemInt, MemLong and MemLongPtr using the same ByRef technique that I've used in the WeakReference repository. In short, I am using 2 Variants that have the VT_BYREF flag set inside the 2 Bytes holding the VarType. These 2 Variants allow remote read/write of memory.

Code

The full module with more explanations and also demos are available on GitHub at VBA-MemoryTools.

LibMemory standard module:

Option Explicit
Option Private Module
'Used for raising errors
Private Const MODULE_NAME As String = "LibMemory"
#If Mac Then
 #If VBA7 Then
 Public Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, source As Any, ByVal Length As LongPtr) As LongPtr
 #Else
 Public Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, source As Any, ByVal Length As Long) As Long
 #End If
#Else 'Windows
 'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx
 #If VBA7 Then
 Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As LongPtr)
 #Else
 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long)
 #End If
#End If
#If VBA7 Then
 Public Declare PtrSafe Function VarPtrArray Lib "VBE7.dll" Alias "VarPtr" (ByRef ptr() As Any) As LongPtr
#Else
 Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef ptr() As Any) As Long
#End If
'The size in bytes of a memory address
#If Win64 Then
 Public Const PTR_SIZE As Long = 8
#Else
 Public Const PTR_SIZE As Long = 4
#End If
#If Win64 Then
 #If Mac Then
 Public Const vbLongLong As Long = 20 'Apparently missing for x64 on Mac
 #End If
 Public Const vbLongPtr As Long = vbLongLong
#Else
 Public Const vbLongPtr As Long = vbLong
#End If
Private Type REMOTE_MEMORY
 memValue As Variant
 remoteVT As Variant
 isInitialized As Boolean 'In case state is lost
End Type
'https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-oaut/3fe7db9f-5803-4dc4-9d14-5425d3f5461f
'https://docs.microsoft.com/en-us/windows/win32/api/oaidl/ns-oaidl-variant?redirectedfrom=MSDN
'Flag used to simulate ByRef Variants
Public Const VT_BYREF As Long = &H4000
Private m_remoteMemory As REMOTE_MEMORY
'*******************************************************************************
'Read/Write a Byte from/to memory
'*******************************************************************************
#If VBA7 Then
Public Property Get MemByte(ByVal memAddress As LongPtr) As Byte
#Else
Public Property Get MemByte(ByVal memAddress As Long) As Byte
#End If
 DeRefMem m_remoteMemory, memAddress, vbByte
 MemByte = m_remoteMemory.memValue
End Property
#If VBA7 Then
Public Property Let MemByte(ByVal memAddress As LongPtr, ByVal newValue As Byte)
#Else
Public Property Let MemByte(ByVal memAddress As Long, ByVal newValue As Byte)
#End If
 DeRefMem m_remoteMemory, memAddress, vbByte
 LetByRef(m_remoteMemory.memValue) = newValue
End Property
'*******************************************************************************
'Read/Write 2 Bytes (Integer) from/to memory
'*******************************************************************************
#If VBA7 Then
Public Property Get MemInt(ByVal memAddress As LongPtr) As Integer
#Else
Public Property Get MemInt(ByVal memAddress As Long) As Integer
#End If
 DeRefMem m_remoteMemory, memAddress, vbInteger
 MemInt = m_remoteMemory.memValue
End Property
#If VBA7 Then
Public Property Let MemInt(ByVal memAddress As LongPtr, ByVal newValue As Integer)
#Else
Public Property Let MemInt(ByVal memAddress As Long, ByVal newValue As Integer)
#End If
 DeRefMem m_remoteMemory, memAddress, vbInteger
 LetByRef(m_remoteMemory.memValue) = newValue
End Property
'*******************************************************************************
'Read/Write 4 Bytes (Long) from/to memory
'*******************************************************************************
#If VBA7 Then
Public Property Get MemLong(ByVal memAddress As LongPtr) As Long
#Else
Public Property Get MemLong(ByVal memAddress As Long) As Long
#End If
 DeRefMem m_remoteMemory, memAddress, vbLong
 MemLong = m_remoteMemory.memValue
End Property
#If VBA7 Then
Public Property Let MemLong(ByVal memAddress As LongPtr, ByVal newValue As Long)
#Else
Public Property Let MemLong(ByVal memAddress As Long, ByVal newValue As Long)
#End If
 DeRefMem m_remoteMemory, memAddress, vbLong
 LetByRef(m_remoteMemory.memValue) = newValue
End Property
'*******************************************************************************
'Read/Write 8 Bytes (LongLong) from/to memory
'*******************************************************************************
#If VBA7 Then
Public Property Get MemLongPtr(ByVal memAddress As LongPtr) As LongPtr
#Else
Public Property Get MemLongPtr(ByVal memAddress As Long) As Long
#End If
 DeRefMem m_remoteMemory, memAddress, vbLongPtr
 MemLongPtr = m_remoteMemory.memValue
End Property
#If VBA7 Then
Public Property Let MemLongPtr(ByVal memAddress As LongPtr, ByVal newValue As LongPtr)
#Else
Public Property Let MemLongPtr(ByVal memAddress As Long, ByVal newValue As Long)
#End If
 #If Win64 Then
 'Cannot set Variant/LongLong ByRef so we use a Currency instead
 Const currDivider As Currency = 10000
 DeRefMem m_remoteMemory, memAddress, vbCurrency
 LetByRef(m_remoteMemory.memValue) = CCur(newValue / currDivider)
 #Else
 MemLong(memAddress) = newValue
 #End If
End Property
'*******************************************************************************
'Redirects the rm.memValue Variant to the new memory address so that the value
' can be read ByRef
'*******************************************************************************
Private Sub DeRefMem(ByRef rm As REMOTE_MEMORY, ByRef memAddress As LongPtr, ByRef vt As VbVarType)
 With rm
 If Not .isInitialized Then
 'Link .remoteVt to the first 2 bytes of the .memValue Variant
 .remoteVT = VarPtr(.memValue)
 CopyMemory .remoteVT, vbInteger + VT_BYREF, 2
 '
 .isInitialized = True
 End If
 'Link .memValue to the desired address
 .memValue = memAddress
 LetByRef(.remoteVT) = vt + VT_BYREF 'Faster than: CopyMemory .memValue, vt + VT_BYREF, 2
 End With
End Sub
'*******************************************************************************
'Utility for updating remote values that have the VT_BYREF flag set
'*******************************************************************************
Private Property Let LetByRef(ByRef v As Variant, ByRef newValue As Variant)
 v = newValue
End Property
#If VBA7 Then
Public Function UnsignedAddition(ByVal val1 As LongPtr, ByVal val2 As LongPtr) As LongPtr
#Else
Public Function UnsignedAddition(ByVal val1 As Long, ByVal val2 As Long) As Long
#End If
 'The minimum negative integer value of a Long Integer in VBA
 #If Win64 Then
 Const minNegative As LongLong = &H8000000000000000^ '-9,223,372,036,854,775,808 (dec)
 #Else
 Const minNegative As Long = &H80000000 '-2,147,483,648 (dec)
 #End If
 '
 If val1 > 0 Then
 If val2 > 0 Then
 'Overflow could occur
 If (val1 + minNegative + val2) < 0 Then
 'The sum will not overflow
 UnsignedAddition = val1 + val2
 Else
 'Example for Long data type (x32):
 ' &H7FFFFFFD + &H0000000C = &H80000009
 ' 2147483645 +たす 12 =わ -ひく2147483639
 UnsignedAddition = val1 + minNegative + val2 + minNegative
 End If
 Else 'Val2 <= 0
 'Sum cannot overflow
 UnsignedAddition = val1 + val2
 End If
 Else 'Val1 <= 0
 If val2 > 0 Then
 'Sum cannot overflow
 UnsignedAddition = val1 + val2
 Else 'Val2 <= 0
 'Overflow could occur
 On Error GoTo ErrorHandler
 UnsignedAddition = val1 + val2
 End If
 End If
Exit Function
ErrorHandler:
 Err.Raise 6, MODULE_NAME & ".UnsignedAddition", "Overflow"
End Function

Demo

For demos that are testing speed go to the Demo module in the above mentioned repository.

Sub DemoMem()
 #If VBA7 Then
 Dim ptr As LongPtr
 #Else
 Dim ptr As Long
 #End If
 Dim i As Long
 Dim arr() As Variant
 ptr = ObjPtr(Application)
 '
 'Read Memory using MemByte
 ReDim arr(0 To PTR_SIZE - 1)
 For i = LBound(arr) To UBound(arr)
 arr(i) = MemByte(UnsignedAddition(ptr, i))
 Next i
 Debug.Print Join(arr, " ")
 '
 'Read Memory using MemInt
 ReDim arr(0 To PTR_SIZE / 2 - 1)
 For i = LBound(arr) To UBound(arr)
 arr(i) = MemInt(UnsignedAddition(ptr, i * 2))
 Next i
 Debug.Print Join(arr, " ")
 '
 'Read Memory using MemLong
 ReDim arr(0 To PTR_SIZE / 4 - 1)
 For i = LBound(arr) To UBound(arr)
 arr(i) = MemLong(UnsignedAddition(ptr, i * 4))
 Next i
 Debug.Print Join(arr, " ")
 '
 'Read Memory using MemLongPtr
 Debug.Print MemLongPtr(ptr)
 '
 'Write Memory using MemByte
 ptr = 0
 MemByte(VarPtr(ptr)) = 24
 Debug.Assert ptr = 24
 MemByte(UnsignedAddition(VarPtr(ptr), 2)) = 24
 Debug.Assert ptr = 1572888
 '
 'Write Memory using MemInt
 ptr = 0
 MemInt(UnsignedAddition(VarPtr(ptr), 2)) = 300
 Debug.Assert ptr = 19660800
 '
 'Write Memory using MemLong
 ptr = 0
 MemLong(VarPtr(ptr)) = 77777
 Debug.Assert ptr = 77777
 '
 'Write Memory using MemLongPtr
 MemLongPtr(VarPtr(ptr)) = ObjPtr(Application)
 Debug.Assert ptr = ObjPtr(Application)
End Sub

Decisions

For those that are not aware, a LongLong integer cannot be modified ByRef if it is passed inside a Variant. Example:

#If Win64 Then
Private Sub DemoByRefLongLong()
 Dim ll As LongLong
 EditByRefLLVar ll, 1^
End Sub
Private Sub EditByRefLLVar(ByRef ll As Variant, ByRef newValue As LongLong)
 ll = newValue 'Error 458 - Variable uses an Automation type not supported...
End Sub
#End If

Since I couldn't use the same approach I've used for Byte, Integer and Long I've finally decided to go for the Currency approach because it was the cleanest and fastest. A Currency variable is stored using 8 Bytes in an integer format, scaled by 10,000 resulting in a fixed point number. So, it was quite easy to use currency instead of LongLong (see the MemLongPtr Let property).

Another approach is to use a Double but looks absolutely horrendous (and is slower) and needs a second REMOTE_MEMORY variable:

#If VBA7 Then
Public Property Let MemLongPtr(ByVal memAddress As LongPtr, ByVal newValue As LongPtr)
#Else
Public Property Let MemLongPtr(ByVal memAddress As Long, ByVal newValue As Long)
#End If
 #If Win64 Then
 Static rm As REMOTE_MEMORY
 With rm
 If Not .isInitialized Then
 'Link .remoteVt to the first 2 bytes of the .memValue Variant
 .remoteVT = VarPtr(.memValue)
 CopyMemory .remoteVT, vbInteger + VT_BYREF, 2
 '
 .isInitialized = True
 End If
 .memValue = newValue
 LetByRef(.remoteVT) = vbDouble
 End With
 DeRefMem m_remoteMemory, memAddress, vbDouble
 LetByRef(m_remoteMemory.memValue) = rm.memValue
 #Else
 MemLong(memAddress) = newValue
 #End If
End Property

Another approach is to write two Longs:

#If VBA7 Then
Public Property Let MemLongPtr(ByVal memAddress As LongPtr, ByVal newValue As LongPtr)
#Else
Public Property Let MemLongPtr(ByVal memAddress As Long, ByVal newValue As Long)
#End If
 #If Win64 Then
 MemLong(memAddress) = LoLong(newValue)
 MemLong(UnsignedAddition(memAddress, 4)) = HiLong(newValue)
 #Else
 MemLong(memAddress) = newValue
 #End If
End Property
#If Win64 Then
Private Function HiLong(ByVal ll As LongLong) As Long
 HiLong = VBA.Int(ll / &H100000000^)
End Function
Private Function LoLong(ByVal ll As LongLong) As Long
 If ll And &H80000000^ Then
 LoLong = CLng(ll And &H7FFFFFFF^) Or &H80000000
 Else
 LoLong = CLng(ll And &H7FFFFFFF^)
 End If
End Function
#End If

This approach looks dangerous because it might change half of a pointer first and by the time the second half is changed, some other code uses that pointer to do something that will likely result in a crash or data corruption.

Another decision was to leave the DeRefMem method as a Sub. Consider the current code (excluding the VBA7 declarations):

Public Property Get MemByte(ByVal memAddress As LongPtr) As Byte
 DeRefMem m_remoteMemory, memAddress, vbByte
 MemByte = m_remoteMemory.memValue
End Property
Public Property Let MemByte(ByVal memAddress As LongPtr, ByVal newValue As Byte)
 DeRefMem m_remoteMemory, memAddress, vbByte
 LetByRef(m_remoteMemory.memValue) = newValue
End Property
Private Sub DeRefMem(ByRef rm As REMOTE_MEMORY, ByRef memAddress As LongPtr, ByRef vt As VbVarType)
 With rm
 If Not .isInitialized Then
 .isInitialized = True
 'Link .remoteVt to the first 2 bytes of the .memValue Variant
 .remoteVT = VarPtr(.memValue)
 CopyMemory .remoteVT, vbInteger + VT_BYREF, 2
 End If
 .memValue = memAddress
 LetByRef(.remoteVT) = vt + VT_BYREF
 End With
End Sub

and now the Function equivalent:

Public Property Get MemByte(ByVal memAddress As LongPtr) As Byte
 MemByte = DeRefMem(memAddress, vbByte).memValue
End Property
Public Property Let MemByte(ByVal memAddress As LongPtr, ByVal newValue As Byte)
 LetByRef(DeRefMem(memAddress, vbByte).memValue) = newValue
End Property
Private Function DeRefMem(ByRef memAddress As LongPtr, ByRef vt As VbVarType) As REMOTE_MEMORY
 Static rm As REMOTE_MEMORY
 With rm
 If Not .isInitialized Then
 .isInitialized = True
 'Link .remoteVt to the first 2 bytes of the .memValue Variant
 .remoteVT = VarPtr(.memValue)
 CopyMemory .remoteVT, vbInteger + VT_BYREF, 2
 End If
 .memValue = memAddress
 LetByRef(.remoteVT) = vt + VT_BYREF
 End With
 DeRefMem = rm
End Function

The Function approach looks definitely more readable. The problem is that it is 2-3 times slower than the Sub equivalent. Since this code will act as a library, I went with the faster approach.

---

I would be very grateful for suggestions that could improve the code.
Have I missed anything obvious? Are there any other useful methods that should be part of such a 'Memory' library (e.g. like I've added VarPtrArray and UnsignedAddition)?

I should also mention that although I wrote the necessary conditional compilations to make the code work for VB6, I cannot test it on VB6 because I don't have VB6 available.

Edit #1

The above has been extensively updated at the mentioned repository on GitHub at VBA-MemoryTools.

• Greedo: Why is the Function slower than the Sub?
• Cristian Buse: @Greedo Mainly because of the return value. If the return is just a Variant it seems to be 1.5x slower but that doesn't work for ByRef Variants so the return must be the whole UDT which is at least 2x slower. I've tested with multiples of 10 starting from 1000 to 10 milions (iterations) and it seems to be consistently slower. Quite unfortunate as it was definitely more elegant to have a Function instead. I assume the extra stack space and copy result operation are the reason

Answer 1

I have a very curious result of running the demo.

-------------------- Host info --------------------
OS: Microsoft Windows NT 10.0.17763.0, x64

VBA7-x64
Host Product: Microsoft Office 2016 x64
Host Version: 16.0.4266.1001
Host Executable: EXCEL.EXE

VBA6-x32
Host Product: Microsoft Office XP x86
Host Version: 10.0.6501
Host Executable: EXCEL.EXE

---

Immediate output after running the demo routine.

Operation	Method	Times	time, s / VBA6-x32	time, s / VBA7-x64
Copy <Byte>	By Ref	106	0.383	0.414
Copy <Byte>	By API	106	0.023	2.062
Copy <Integer>	By Ref	106	0.352	0.375
Copy <Integer>	By API	106	0.031	2.047
Copy <Long>	By Ref	106	0.781	0.375
Copy <Long>	By API	106	0.062	2.047
Copy <LongLong>	By Ref	106	0.508	0.484
Copy <LongLong>	By API	106	0.031	2.055
Dereferenced an Object	-	106	0.156	0.188

---

There is a minor bug in the demo code. You have:

t = Timer
For i = 1 To LOOPS
 CopyMemory x1, x2, 1
Next i

should be

Dim ByteCount As Long
ByteCount = Len(x1)
t = Timer
For i = 1 To LOOPS
 CopyMemory x1, x2, ByteCount
Next i

• Cristian Buse: Interesting. I didn't have VBA6 to test with. It seems that the API is super fast. However on VBA7 x32 I get the worst results using the API. SO, I guess for VBA7 is simply faster to use the ByRef approach instead of the API. BTW, I am due to push a faster version to GitHub next week.
• PChemGuy: @CristianBuse, see updated comment regarding a minor bug in the demo.
• Cristian Buse: Here are the results I get when running the demo. As you can see on my x32 VBA7 the API is completely unusable
• Cristian Buse: BTW, thanks for looking into this. +1 Helpful to see that VBA6 is not affected.