Скопируйте ссылку на массив в VBA

есть ли способ скопировать ссылку на массив в VBA (или VB6)?

в VBA массивы являются типами значений. Назначение одной переменной массива другой копирует весь массив. Я хочу, чтобы две переменные массива указывали на один и тот же массив. Есть ли способ сделать это, возможно, используя некоторые функции памяти API и / или VarPtr функция, которая фактически возвращает адрес переменной в VBA?

Dim arr1(), arr2(), ref1 As LongPtr
arr1 = Array("A", "B", "C")

' Now I want to make arr2 refer to the same array object as arr1
' If this was C#, simply assign, since in .NET arrays are reference types:
arr2 = arr1

' ...Or if arrays were COM objects:
Set arr2 = arr1

' VarPtr lets me get the address of arr1 like this:
ref1 = VarPtr(arr1)

' ... But I don't know of a way to *set* address of arr2.

кстати, можно получить несколько ссылок в тот же массив, передав ту же переменную массива ByRef к нескольким параметрам метода:

Sub DuplicateRefs(ByRef Arr1() As String, ByRef Arr2() As String)
    Arr2(0) = "Hello"
    Debug.Print Arr1(0)
End Sub

Dim arrSource(2) As String
arrSource(0) = "Blah"

' This will print 'Hello', because inside DuplicateRefs, both variables
' point to the same array. That is, VarPtr(Arr1) == VarPtr(Arr2)
Call DuplicateRefs(arrSource, arrSource)

но это все еще не позволяет просто изготовить новую ссылку в той же области, что и существующая.

10
pointers reference vba

3 ответов

Да, вы можете, если обе переменные имеют тип Variant.

вот почему: тип Variant сам по себе является оболочкой. Фактическое битовое содержимое варианта составляет 16 байт. Первый байт указывает на тип данных, хранящихся в списке. Значение точно соответствует перечислению VbVarType. Т. е. если вариант в настоящее время содержит длинное значение, первый байт будет 0x03, стоимостью vbLong. Второй байт содержит некоторые битовые флаги. Для exampe, если вариант содержит массив, бит 0x20 в этом байте будет установлен.

использование оставшихся 14 байт зависит от типа данных, которые хранятся. Для любого типа массива он содержит адрес массива.

это означает, что если вы напрямую заменить стоимостью одного варианта с использованием RtlMoveMemory вы, по сути, заменило ссылка в массив. Это действительно работает!

есть одно предостережение: когда переменная массива идет вне области действия среда выполнения VB восстановит память, содержащуюся в фактических элементах массива. Когда вы вручную дублируете ссылку на массив с помощью метода Variant CopyMemory, который я только что описал, в результате среда выполнения попытается восстановить ту же память дважды, когда оба варианта выйдут из области действия, и программа аварийно завершит работу. Чтобы избежать этого, вам нужно вручную "стереть" все ссылки, кроме одной, перезаписав вариант снова, например, с 0s, прежде чем переменные выйдут область.

Пример 1: это работает, но произойдет сбой, как только обе переменные выйдут из области видимости (когда sub выходит)

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Sub CopyArrayRef_Bad()
    Dim v1 As Variant, v2 As Variant
    v1 = Array(1, 2, 3)
    CopyMemory v2, v1, 16

    ' Proof:
    v2(1) = "Hello"
    Debug.Print Join(v1, ", ")

    ' ... and now the program will crash
End Sub

Пример 2:при тщательной очистке вы можете уйти с этим!

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare PtrSafe Sub FillMemory Lib "kernel32" _
    Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)

Sub CopyArrayRef_Good()
    Dim v1 As Variant, v2 As Variant
    v1 = Array(1, 2, 3)
    CopyMemory v2, v1, 16

    ' Proof:
    v2(1) = "Hello"
    Debug.Print Join(v1, ", ")

    ' Clean up:
    FillMemory v2, 16, 0

    ' All good!
End Sub
14

Как насчет этого решения...

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                   (Destination As Any, Source As Any, ByVal Length As Long)

Public Sub TRIAL()
Dim myValueType As Integer
Dim mySecondValueType As Integer
Dim memPTR As Long

myValueType = 67
memPTR = VarPtr(mySecondValueType)
CopyMemory ByVal memPTR, myValueType, 2
Debug.Print mySecondValueType
End Sub

концепция пришла из статьи CodeProject здесь

1

а как насчет создания оболочки? Как этот модуль класса "MyArray" (упрощенный пример):

Private m_myArray() As Variant

Public Sub Add(ByVal items As Variant)
    m_myArray = items
End Sub

Public Sub Update(ByVal newItem As String, ByVal index As Integer)
    m_myArray(index) = newItem
End Sub

Public Function Item(ByVal index As Integer) As String
    Item = m_myArray(index)
End Function

затем в стандартном модуле:

Sub test()
    Dim arr1 As MyArray
    Dim arr2 As MyArray

    Set arr1 = New MyArray
    arr1.Add items:=Array("A", "B", "C")

    Set arr2 = arr1

    arr1.Update "A1", 0

    Debug.Print arr1.Item(0)
    Debug.Print arr2.Item(0)
End Sub

это поможет?

0