Как правильно определить размер указателей для доступа к ключам коллекции

Question

Я пытаюсь настроить от 32 до 64 битов код для доступа к ключам Коллекции.

Я знаю по этой фантазии c поток и здесь , что есть много решений, но для улучшения моих навыков low level я пытаюсь реализовать функции, использующие CopyMemory.

Мне удается избавьтесь от PutMem4 (msvbvm60) и исправьте извлеченные ключи Collection, оставаясь в 32-битном режиме; но у меня возникли проблемы при попытке выяснить, какие значения в 64 битах следует добавить в указатели, чтобы исправить получение предыдущих чисел итогов или числа коллекций.

Объявления:

#If Win64 Then 
    Private Declare PtrSafe Function ArrayPtr Lib "VBE7" Alias "VarPtr" (var() As Any) As LongPtr
    Private Declare PtrSafe Function lstrcmpiW Lib "kernel32" (ByVal Str1 As LongPtr, ByVal Str2 As LongPtr) As LongPtr
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As LongPtr, ByRef Source As LongPtr, ByVal Length As LongPtr)
    Private Declare PtrSafe Function SysAllocStringByteLen Lib "oleaut32" (ByVal ptr As LongPtr, ByVal Length As LongPtr) As LongPtr
    Const LongPtrSize As Long = 8
#ElseIf Win32 Then
    Private Declare Function ArrayPtr Lib "VBE7" Alias "VarPtr" (Arr() As Any) As Long
    Private Declare Function lstrcmpiW Lib "kernel32" (ByVal Str1 As Long, ByVal Str2 As Long) As Long
    Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByRef Source As Long, ByVal Length As Long)
    Const LongPtrSize As LongPtr = 4
#End If

Вот код :

Public Sub GetColKeys(Collection As Collection, StringArray() As String)
#If Win64 Then
    Dim lngA As LongPtr, lngCount As Long, lngCurPtr As LongPtr, lngKeyPtr As LongPtr, lngHeader(5) As LongPtr, lngLenB As LongPtr, lngPtr() As LongPtr, lngStrPtr As LongPtr
#ElseIf Win32 Then
    Dim lngA As Long, lngCount As Long, lngCurPtr As Long, lngKeyPtr As Long, lngHeader(5) As Long, lngLenB As Long, lngPtr() As Long, lngStrPtr As Long
#End If
    ' ensure the array is uninitialized
    If Not Not StringArray Then Erase StringArray
'    Debug.Assert app.hInstance
    ' shortest way to see whether Erase worked or not (can't Erase fixed size arrays)
    If Not Not StringArray Then Exit Sub
'    Debug.Assert app.hInstance
    If Not Collection Is Nothing Then
        If Collection.count Then
            ' reserve maximum amount of results
            ReDim StringArray(0 To Collection.count - 1)
            ' remember the pointer of first item for fast access
            lngKeyPtr = VarPtr(StringArray(0))
            ' we do not want to have API calls in a loop because they're slow
            ' we can avoid that by faking a safe array to our liking!
            lngHeader(0) = 1 ' dimensions
            lngHeader(1) = 4 ' bytes per item
            lngHeader(4) = 1 ' number of items
            ' put lngPtr array into our control
            CopyMemory ByVal ArrayPtr(lngPtr), VarPtr(lngHeader(0)), LongPtrSize
            ' starting pointer
            lngCurPtr = ObjPtr(Collection)
            ' and then we loop...
            For lngA = 1 To Collection.count
                ' pointer change: get next item
                lngHeader(3) = lngCurPtr + 24 ' <== for 64 bits, which value?
                ' remember current pointer
                lngCurPtr = lngPtr(0)
                ' pointer change: get string pointer
                lngHeader(3) = lngCurPtr + 16 ' <== for 64 bits, which value?
                ' see if we add it in
                lngStrPtr = lngPtr(0)
                If lngStrPtr Then
                    ' get string length
                    lngHeader(3) = lngStrPtr - 4 ' <== for 64 bits, which value?
                    lngLenB = lngPtr(0)
                    ' store a new string to output string array
                    CopyMemory ByVal lngKeyPtr, SysAllocStringByteLen(lngStrPtr, lngLenB), LongPtrSize
                    ' jump to next output string array item and increase counter
                    lngKeyPtr = lngKeyPtr + 4 ' <== for 64 bits, which value?
                    lngCount = lngCount + 1
                End If
            Next lngA
            ' we are done with that trick, reset lngPtr to null
            CopyMemory ArrayPtr(lngPtr), 0, LongPtrSize
        End If
        If lngCount = 0 Then
            ' return an empty initialized string array
            StringArray = Split(vbNullString)
        ElseIf lngCount < Collection.count Then
            ' remove unused items
            ReDim Preserve StringArray(lngCount - 1)
        End If
    Else
        ' No Object
        err.Raise 91
    End If
End Sub

Есть еще две функции (GetColIndex и GetColKey), но они не слишком сильно отличаются - они используют разные адреса указателей - и у них все еще есть много нераспакованной общности.

Попытка другого низкоуровневого кода , хотя он уже адаптирован к 64-битным системам, у меня возникают проблемы с получением непосредственного количества сборок:

'Get MemoryAddress of Collection Object
CollPtr = VBA.ObjPtr(oColl)

'Peek ElementCount
Dim ElementCount As Long
#If Win64 Then
CopyMemory VBA.VarPtr(ElementCount), CollPtr + 28, 4^ '<==it does not function, always getting 0
#ElseIf Win32 Then
CopyMemory VBA.VarPtr(ElementCount), CollPtr + 16, 4& '<==it functions

Попытка получить внутренний VBA Реализация коллекции и ее дескрипторы, я видел много полезных вещей для массивов здесь , этого превосходного сайта bytecomb и этого глубокого ответа от Comintern , который перенаправляет меня на Сам MS, где я видел несколько описаний структур, таких как Variant и SAFEARRAY , но ни одного для Collection.

Я не уверен, но думаю, что где-то читал, что коллекции в VBA реализованы поверх структуры массива, но я потерян; За последние 3 дня я не мог точно определить, как представлены Коллекции, и не могу правильно настроить адреса.

Даже если кто-то выплюнет правильные цифры, я буду очень признателен, если вы знаете некоторые ссылки или обзоры тоже .

TIA