How do I manipulate data in variant arrays using rtlmovememory with VB6/VBA

Question

I have written a VB-Class to provide a data table, which is allowing you to handle data in a two-dimensional array (of type variant) similar to a ADO recordset.

To improve processing speed when adding records to the array, sorting the array (i.e. moving records around in the array) or reading records from the array, I want to use the RtlMoveMemory routine of the kernel32.dll of the Windows API. Whilst I have been able to successfully move around records within the array, writing data to a specific index of the array or reading data from a specific index of the array seems to somehow mix up the data upon further processing.

I have done quite a bit of reading to get where I am including the following:

As you will see, my code is an adaption of link no. 3 above. I am not a real pro but I am not an absolute beginner neither and I must be missing something but I can't figure out what.

Here is the code as it stands today:

Option Explicit
Option Base 1

'#======================================================================================================================
'# References
'#======================================================================================================================
#If Win64 Then
    Private Const PTR_LENGTH As Long = 8
    Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (ByRef Var() As Any) As LongPtr
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#Else
    Private Const PTR_LENGTH As Long = 4
    Private Declare Function VarPtrArray Lib "VBE7" Alias "VarPtr" (ByRef Var() As Any) As LongPtr
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If


'#======================================================================================================================
'# API Constants, Enumerations & Types
'#======================================================================================================================

'Type Declarations needed for SafeArray hacks

'The bounds of the SafeArray
Private Type SAFEARRAYBOUND
    cElements    As Long
    lLbound      As Long
End Type

Private Type SAFEARRAY1D
    cDims           As Integer
    fFeatures       As Integer
    cbElements      As Long
    cLocks          As Long
    pvData          As Long
    Bounds(0 To 0)  As SAFEARRAYBOUND
End Type

Private Type SAFEARRAY2D
    cDims           As Integer
    fFeatures       As Integer
    cbElements      As Long
    cLocks          As Long
    pvData          As Long
    Bounds(0 To 1)  As SAFEARRAYBOUND
End Type


'#======================================================================================================================
'# Private Variables
'#======================================================================================================================
Private m_List() As Variant                     ' The list array.


'#======================================================================================================================
'# Test Routines
'#======================================================================================================================

Private Sub MainTest()

    Dim iIdx As Long
    Dim aSingleRec() As Variant
    Dim i As Long

    LoadRange ActiveSheet.Range("dataInput")


    DataRowMove 5, 2

    DebugRecord 5

    DebugRecord 2


    ReDim aSingleRec(LBound(m_List, 1) To UBound(m_List, 1))

    aSingleRec(1) = "Test Gender (m)"
    aSingleRec(2) = "Steve"
    aSingleRec(3) = "Rogers"
    aSingleRec(4) = "425 Lafayette St"
    aSingleRec(5) = 10003
    aSingleRec(6) = "New York"

    DataRowPush 4, aSingleRec

    DebugRecord 4
    DebugSingleRecord aSingleRec


    aSingleRec(1) = "Test Gener (f)"
    aSingleRec(2) = "Wanda"
    aSingleRec(3) = "Maximoff"
    aSingleRec(4) = "72 W 36th St"
    aSingleRec(5) = 10018
    aSingleRec(6) = "New York"

    DataRowPush 6, aSingleRec

    DebugRecord 6
    DebugSingleRecord aSingleRec

    aSingleRec = DataRowGet(7)

    DebugSingleRecord aSingleRec

    DumpToRange ActiveSheet, ActiveSheet.Cells(10, 2)

    Debug.Print "Done..."


End Sub



Private Sub LoadRange(rInput As Range)

    m_List = rInput


End Sub


Private Sub DumpToRange(TargetWorksheet As Worksheet, TargetCell As Range)

    Dim iRow As Integer: iRow = TargetCell.Row
    Dim iCol As Integer: iCol = TargetCell.Column

    TargetWorksheet.Cells(iRow, iCol).Resize(UBound(m_List), UBound(m_List, 2)) = m_List


End Sub


Private Sub DebugRecord(iIdx As Long, Optional stInProcedure = "Main")

    Dim i As Long

    Debug.Print "---------------------------"
    Debug.Print "Record " & iIdx & " (in Procedure '" & stInProcedure & "')" & vbCrLf

    For i = 1 To UBound(m_List, 1)
        Debug.Print vbTab & "Field " & i & "[" & TypeName(m_List(i, iIdx)) & "] -> " & m_List(i, iIdx)
    Next i

    Debug.Print vbCrLf


End Sub


Private Sub DebugSingleRecord(aRec() As Variant)

    Dim i As Long

    Debug.Print "---------------------------"
    Debug.Print "Single Record " & vbCrLf

    For i = 1 To UBound(aRec)
        Debug.Print vbTab & "Field " & i & "[" & TypeName(aRec(i)) & "] -> " & aRec(i)
    Next i

    Debug.Print vbCrLf



End Sub


'#======================================================================================================================
'# Data Handling Routines
'#======================================================================================================================

Private Function DataRowGet(ByVal idxFrom As Long) As Variant()

    Dim ptrToArrayVar As LongPtr
    Dim ptrToSafeArray As LongPtr
    Dim ptrToArrayData As LongPtr
    Dim ptrToArrayData2 As LongPtr
    Dim uSAFEARRAY As SAFEARRAY1D
    Dim ptrCursor As LongPtr
    Dim cbElements As Long
    Dim atsBound1 As Long
    Dim elSize As Long

    Dim aSingleRec() As Variant

    Dim m_NumCols As Long


    m_NumCols = UBound(m_List, 1)

    ReDim aSingleRec(LBound(m_List, 1) To UBound(m_List, 1))

    'determine bound1 of source array (ie row Count)
    atsBound1 = m_NumCols

    'get pointer to source array Safearray
    ptrToArrayVar = VarPtrArray(m_List)
    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
    'get the safearray structure
    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
    'get the pointer to the data elemets
    ptrToArrayData = uSAFEARRAY.pvData
    'determine byte size of source elements
    cbElements = uSAFEARRAY.cbElements

    'get pointer to destination array Safearray
    ptrToArrayVar = VarPtrArray(aSingleRec)
    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
    ptrToArrayData2 = uSAFEARRAY.pvData

    'determine elements size
    elSize = m_NumCols
    'determine start position of data in source array
    ptrCursor = ptrToArrayData + (((idxFrom - 1) * atsBound1) * cbElements)
    'Copy source array to destination array
    CopyMemory ByVal ptrToArrayData2, ByVal ptrCursor, cbElements * elSize


    DataRowGet = aSingleRec

    ReDim aSingleRec(0 To 0)


End Function


Private Sub DataRowPush(ByVal idxTo As Long, ByRef sourceArray() As Variant)

    Dim ptrToArrayVar As LongPtr
    Dim ptrToSafeArray As LongPtr
    Dim ptrToArrayData As LongPtr
    Dim ptrToArrayData2 As LongPtr
    Dim uSAFEARRAY As SAFEARRAY1D
    Dim ptrCursor As LongPtr
    Dim ptrCursorSource As LongPtr
    Dim cbElementsS As Long
    Dim cbElementsT As Long
    Dim atsBound1 As Long
    Dim elSize As Long
    Dim m_NumCols As Long

    Dim aSingleRec() As Variant

    aSingleRec = sourceArray

    m_NumCols = UBound(m_List, 1)

    'determine bound1 of source array (ie row Count)
    atsBound1 = m_NumCols

    'get pointer to target array Safearray
    ptrToArrayVar = VarPtrArray(m_List)
    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
    'get the safearray structure
    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
    'get the pointer to the data elemets
    ptrToArrayData = uSAFEARRAY.pvData
    'determine byte size of source elements
    cbElementsT = uSAFEARRAY.cbElements



    'get pointer to source array Safearray
    ptrToArrayVar = VarPtrArray(aSingleRec)
    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH
    'get the safearray structure
    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)
    'get the pointer to the data elemets
    ptrToArrayData2 = uSAFEARRAY.pvData
    'determine byte size of source elements
    cbElementsS = uSAFEARRAY.cbElements

    'determine elements size
    elSize = m_NumCols
    'determine start position of data in target array
    ptrCursor = ptrToArrayData + (((idxTo - 1) * atsBound1) * cbElementsT)
    'Copy source array to destination array
    CopyMemory ByVal ptrCursor, ByVal ptrToArrayData2, cbElementsS * elSize

    'Debugging only
    DebugRecord idxTo, "DataRowPush"

End Sub


Private Sub DataRowMove(ByVal idxFrom As Long, ByVal idxTo As Long)

    Dim ptrToArrayVar As LongPtr
    Dim ptrToSafeArray As LongPtr
    Dim ptrToArrayData As LongPtr
    Dim ptrToArrayData2 As LongPtr
    Dim uSAFEARRAY As SAFEARRAY1D
    Dim ptrCursorFrom As LongPtr
    Dim ptrCursorTo As LongPtr
    Dim cbElements As Long
    Dim atsBound1 As Long
    Dim elSize As Long
    Dim m_NumCols As Long

    m_NumCols = UBound(m_List, 1)

    'determine bound1 of source array (ie row Count)
    atsBound1 = m_NumCols

    'get pointer to source array Safearray
    ptrToArrayVar = VarPtrArray(m_List)
    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH

    'get the safearray structure
    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)

    'get the pointer to the data elemets
    ptrToArrayData = uSAFEARRAY.pvData

    'determine byte size of source elements
    cbElements = uSAFEARRAY.cbElements

    'determine elements size
    elSize = m_NumCols

    'determine start position of  data source in array
    ptrCursorFrom = ptrToArrayData + (((idxFrom - 1) * atsBound1) * cbElements)

    'determine start position of data target in array
    ptrCursorTo = ptrToArrayData + (((idxTo - 1) * atsBound1) * cbElements)

    'Copy source array to destination array
    CopyMemory ByVal ptrCursorTo, ByVal ptrCursorFrom, cbElements * elSize

End Sub

This results in the following output:

---------------------------
Record 5 (in Procedure 'Main')

  Field 1[String] -> Mr
  Field 2[String] -> Peter
  Field 3[String] -> Parker
  Field 4[String] -> 401 7th Ave
  Field 5[Double] -> 10001
  Field 6[String] -> New York


---------------------------
Record 2 (in Procedure 'Main')

  Field 1[String] -> Mr
  Field 2[String] -> Peter
  Field 3[String] -> Parker
  Field 4[String] -> 401 7th Ave
  Field 5[Double] -> 10001
  Field 6[String] -> New York


---------------------------
Record 4 (in Procedure 'DataRowPush')

  Field 1[String] -> Test Gender (m)
  Field 2[String] -> Steve
  Field 3[String] -> Rogers
  Field 4[String] -> 425 Lafayette St
  Field 5[Integer] -> 10003
  Field 6[String] -> New York


---------------------------
Record 4 (in Procedure 'Main')

  Field 1[String] -> Test Gender (m)
  Field 2[String] -> Steve
  Field 3[String] ->  Field 
  Field 4[String] ->  Field 4[String
  Field 5[Integer] -> 10003
  Field 6[String] -> New York


---------------------------
Single Record 

  Field 1[String] -> Test Gender (m)
  Field 2[String] -> Steve
  Field 3[String] -> Rogers
  Field 4[String] -> 425 Lafayette St
  Field 5[Integer] -> 10003
  Field 6[String] -> New York


---------------------------
Record 6 (in Procedure 'DataRowPush')

  Field 1[String] -> Test Gener (f)
  Field 2[String] -> Wanda
  Field 3[String] -> Maximoff
  Field 4[String] -> 72 W 36th St
  Field 5[Integer] -> 10018
  Field 6[String] -> New York


---------------------------
Record 6 (in Procedure 'Main')

  Field 1[String] -> Test Gener (f)
  Field 2[String] ->  Field 
  Field 3[String] -> Maximoff
  Field 4[String] -> 72 W 36th St
  Field 5[Integer] -> 10018
  Field 6[String] -> New York


---------------------------
Single Record 

  Field 1[String] -> Test Gener (f)
  Field 2[String] -> Wanda
  Field 3[String] -> Maximoff
  Field 4[String] -> 72 W 36th St
  Field 5[Integer] -> 10018
  Field 6[String] -> New York


---------------------------
Single Record 

  Field 1[String] -> Mr
  Field 2[String] -> Bruce 
  Field 3[String] -> Banner
  Field 4[String] -> 222 W 51st St
  Field 5[Double] -> 10019
  Field 6[String] -> New York


Done...

My main issue is with 'DataRowPush' which seems to work fine while within the procedure itself but as soon as the program returns to the calling procedure, the content of the target array seems to be altered. You can see this in the debug output of records 4 and 6 above.

Similarly when reading the data with 'DataRowGet', the target single dimensional array is correctly populated but it seems the original data in m_List (the 2-dimensional array) seems to be altered as well. After reading the data with 'DataRowGet' Record no. 7 reads as

Mr
Resize
6
Field 6
10019
Field 6[

in m_List. Appreciate any help how to change my code to prevent the altering of the data.

From what I understand, you can't use VarPtr to get the pointer to the array, and I am guessing that is what is causing you pain. From some other sources [VB Secrets](http://www.thevbzone.com/secrets.htm) and [Classic VB](http://vb.mvps.org/tips/varptr/) a possible workaround is to pass the first element to `VarPtr`. — pstrjds, Jun 04 '17 at 14:17
Thanks for this hint - will look into it and get back with an update asap — Dan0175, Jun 04 '17 at 14:27
I have now changed the code to use a procedure to get to the pointer of the array which works in many other instances, but somehow the issue with the mixed data persists.. — Dan0175, Jun 04 '17 at 15:34
I have a feeling that the answer to your problem is going to be "Don't do that" You have a `VariantArray` which is holding strings and all of that starts to get pretty messy. It has been a long time since I messed with any of this so I don't feel qualified to answer, but at first glance of your code my gut reaction was "I don't think this will work consistently". The fact that you have to pInvoke from the VB dll to get to the `VarPtr` method should serve as a warning that "Here be dragons". You are trying to copy data from objects that might move while you are copying. — pstrjds, Jun 04 '17 at 16:44
I wholeheartedly agree with @pstrjds. This is going to give you some real headaches ... and the gains (versus manipulating the arrays themselves) will be minimal unless you have absolutely enormous datasets. I haven't looked through each line of your code, but one thing that sticks out is that your array variables are declared at routine-level, so the pointers can't be relied upon. There aren't just dragons here ... when working with pointers and `CopyMemory` in VBA you're riding the back of one. I'd be jumping off if it were me. — Ambie, Jun 05 '17 at 06:02
I agree with you that the gain on a single array is not worth while the effort and headache of this approach, but the usual data sets I am processing have 5 - 12 columns and somewhere between 200'000 and 10 - 15 million rows... hence my try to ride the back of a dragon. But thanks for your inputs - will continue my research and post any update I can share. — Dan0175, Jun 05 '17 at 13:11
Do you really want to bring a 15 million rows (especially of big fat variants) into memory? Sorting and the like is best donw in a DB. If you cannot do this on a server DB then use a local DB like SQLite. — tcarvin, Jun 07 '17 at 13:23
@Dan0175 Just saw this today. If you are still stumped by this all these months later, I have a suggestion that will probably fix the issue for you. Instead of hacking the array in a Subroutine, instead, employ a Function. Return the hacked array from the function. The returned array will likely behave as you expect. I would take it one step further. At the beginning of any function that will hack a passed array, copy the array to a new working array like so Array2 = Array1. This way, all alterations will not affect the original array, which is good functional programming style. — Excel Hero, Feb 23 '19 at 02:30
@Dan0175 And to be clear, when I say have the function return the array I mean something like this: `NewArray = YourFunction(OriginalArray)` — Excel Hero, Feb 23 '19 at 03:05

How do I manipulate data in variant arrays using rtlmovememory with VB6/VBA

0 Answers0