Skopiuj odwołanie do tablicy w VBA

Question

Czy istnieje sposób na skopiowanie odwołania do tablicy w VBA (lub VB6)?

W języku VBA tablice są typami wartości. Przypisanie jednej zmiennej tablicy do drugiej powoduje skopiowanie całej tablicy. Chcę uzyskać dwie zmienne tablicowe wskazujące na tę samą tablicę. Czy jest jakiś sposób, aby to osiągnąć, być może używając niektórych funkcji pamięci API i/lub funkcji , która w rzeczywistości zwraca adres zmiennej w 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. 

Nawiasem mówiąc, jest to możliwe, aby uzyskać wiele odniesień do tej samej tablicy, przekazując tę ​​samą zmienną tablicową ByRef do wielu parametrów metody:

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) 

Ale to nadal nie pozwalają na wprost wytwarzać nowe odniesienie w tym samym zakresie co istniejący.

Answer 1

Tak, można, jeśli obie zmienne są typu Variant.

Oto dlaczego: Typ wariantu sam jest opakowaniem. Rzeczywista zawartość bitowa wariantu wynosi 16 bajtów. Pierwszy bajt wskazuje aktualnie zapisany typ danych. Wartość odpowiada dokładnie enumowi VbVarType. Jeśli na przykład Wariant ma wartość Long, pierwszy bajt będzie miał wartość 0x03, wartość vbLong. Drugi bajt zawiera trochę bitowych flag. Dla przykładu, jeśli wariant zawiera tablicę, zostanie ustawiony bit o numerze 0x20 w tym bajcie.

Użycie pozostałych 14 bajtów zależy od przechowywanego typu danych. Dla dowolnego typu tablicy zawiera on adres adresu tablicy.

Oznacza to, że jeśli bezpośrednio zastąpić wartość jednego wariantu użyciu RtlMoveMemory zostały nadpisane w efekcie odniesienie do tablicy. To w rzeczywistości działa!

Jest jedno zastrzeżenie: gdy zmienna tablicy wykracza poza zakres, środowisko wykonawcze VB odzyska pamięć, która zawiera faktyczne elementy tablicy. Kiedy ręcznie zduplikowałeś odwołanie do tablicy za pomocą techniki Variant CopyMemory, którą właśnie opisałem, wynikiem jest, że środowisko wykonawcze spróbuje odzyskać tę samą pamięć dwukrotnie, gdy oba warianty wykroczą poza zakres, a program się zawiesi. Aby tego uniknąć, musisz ręcznie "wymazać" wszystkie z wyjątkiem jednego odniesienia przez ponowne nadpisanie wariantu, na przykład 0, zanim zmienne wykroczą poza zakres.

Przykład 1: To działa, ale padnie raz obie zmienne wychodzić z zakresu (przy wyjściu 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 

Przykład 2: Dzięki starannemu czyszczeniu, można uciec z to!

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 

Answer 2

Co o tym rozwiązaniu ...

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 

Pojęcie pochodzi z artykułu CodeProject here

Answer 3

A co do stworzenia wraper? Jak tego modułu klasy 'MyArray' (uproszczony przykład):

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 

Następnie w module standardowym:

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 

Czy to pomoże?