Collection VBA : liste de clés

Question

Après avoir ajouté des valeurs à la collection VBA, existe-t-il un moyen de conserver la liste de toutes les clés ?

Par exemple

Dim coll as new  Collection
Dim str1, str2, str3
str1="first string"
str2="second string"
str3="third string"
coll.add str1, "first key"
coll.add str2, "second key"
coll.add str3, "third key"

Je sais comment conserver la liste des chaînes :

first string
second string
third string

Encore une fois : existe-t-il un moyen de conserver les clés ?

first key
second key
third key

Note : J'utilise VBA dans AutoCAD 2007.

Answer 1

Si vous avez l'intention d'utiliser la version par défaut de VB6 Collection alors le plus simple est de le faire :

col1.add array("first key", "first string"), "first key"
col1.add array("second key", "second string"), "second key"
col1.add array("third key", "third string"), "third key"

Vous pouvez ensuite énumérer toutes les valeurs :

Dim i As Variant

For Each i In col1
  Debug.Print i(1)
Next

Ou toutes les clés :

Dim i As Variant

For Each i In col1
  Debug.Print i(0)
Next

Answer 2

Je ne pense pas que cela soit possible avec une collection vanille sans stocker les valeurs des clés dans un tableau indépendant.

La solution la plus simple est d'ajouter une référence à l'interface de l'utilisateur. Microsoft Scripting Runtime & utilisez plutôt un dictionnaire plus performant :

Dim dict As Dictionary
Set dict = New Dictionary

dict.Add "key1", "value1"
dict.Add "key2", "value2"

Dim key As Variant
For Each key In dict.Keys
    Debug.Print "Key: " & key, "Value: " & dict.Item(key)
Next

Answer 3

Vous pouvez créer une petite classe pour contenir la clé et la valeur, puis stocker les objets de cette classe dans la collection.

Classe KeyValue :

Public key As String
Public value As String
Public Sub Init(k As String, v As String)
    key = k
    value = v
End Sub

Puis de l'utiliser :

Public Sub Test()
    Dim col As Collection, kv As KeyValue
    Set col = New Collection
    Store col, "first key", "first string"
    Store col, "second key", "second string"
    Store col, "third key", "third string"
    For Each kv In col
        Debug.Print kv.key, kv.value
    Next kv
End Sub

Private Sub Store(col As Collection, k As String, v As String)
    If (Contains(col, k)) Then
        Set kv = col(k)
        kv.value = v
    Else
        Set kv = New KeyValue
        kv.Init k, v
        col.Add kv, k
    End If
End Sub

Private Function Contains(col As Collection, key As String) As Boolean
    On Error GoTo NotFound
    Dim itm As Object
    Set itm = col(key)
    Contains = True
MyExit:
    Exit Function
NotFound:
    Contains = False
    Resume MyExit
End Function

Ceci est bien sûr similaire à la suggestion du dictionnaire, mais sans aucune dépendance externe. La classe peut être rendue plus complexe si nécessaire, si vous souhaitez stocker plus d'informations.

Answer 4

Une autre solution consiste à stocker les clés dans une Collection séparée :

'Initialise these somewhere.
Dim Keys As Collection, Values As Collection

'Add types for K and V as necessary.
Sub Add(K, V) 
Keys.Add K
Values.Add V, K
End Sub

Vous pouvez gérer un ordre de tri distinct pour les clés et les valeurs, ce qui peut parfois être utile.

Answer 5

Vous pouvez fouiller dans votre mémoire à l'aide de RTLMoveMemory et récupérer directement l'information souhaitée :

32-Bit :

Option Explicit

'Provide direct memory access:
Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, _
    ByVal Source As Long, _
    ByVal Length As Long)

Function CollectionKeys(oColl As Collection) As String()

    'Declare Pointer- / Memory-Address-Variables
    Dim CollPtr As Long
    Dim KeyPtr As Long
    Dim ItemPtr As Long

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

    'Peek ElementCount
    Dim ElementCount As Long
    ElementCount = PeekLong(CollPtr + 16)

        'Verify ElementCount
        If ElementCount <> oColl.Count Then
            'Something's wrong!
            Stop
        End If

    'Declare Simple Counter
    Dim index As Long

    'Declare Temporary Array to hold our keys
    Dim Temp() As String
    ReDim Temp(ElementCount)

    'Get MemoryAddress of first CollectionItem
    ItemPtr = PeekLong(CollPtr + 24)

    'Loop through all CollectionItems in Chain
    While Not ItemPtr = 0 And index < ElementCount

        'increment Index
        index = index + 1

        'Get MemoryAddress of Element-Key
        KeyPtr = PeekLong(ItemPtr + 16)

        'Peek Key and add to temporary array (if present)
        If KeyPtr <> 0 Then
           Temp(index) = PeekBSTR(KeyPtr)
        End If

        'Get MemoryAddress of next Element in Chain
        ItemPtr = PeekLong(ItemPtr + 24)

    Wend

    'Assign temporary array as Return-Value
    CollectionKeys = Temp

End Function

'Peek Long from given MemoryAddress
Public Function PeekLong(Address As Long) As Long

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLong), Address, 4&)

End Function

'Peek String from given MemoryAddress
Public Function PeekBSTR(Address As Long) As String

    Dim Length As Long

    If Address = 0 Then Stop
    Length = PeekLong(Address - 4)

    PeekBSTR = Space(Length \ 2)
    Call MemCopy(VBA.StrPtr(PeekBSTR), Address, Length)

End Function

64-Bit :

Option Explicit

'Provide direct memory access:
Public Declare PtrSafe Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" ( _
     ByVal Destination As LongPtr, _
     ByVal Source As LongPtr, _
     ByVal Length As LongPtr)

Function CollectionKeys(oColl As Collection) As String()

    'Declare Pointer- / Memory-Address-Variables
    Dim CollPtr As LongPtr
    Dim KeyPtr As LongPtr
    Dim ItemPtr As LongPtr

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

    'Peek ElementCount
    Dim ElementCount As Long
    ElementCount = PeekLong(CollPtr + 28)

        'Verify ElementCount
        If ElementCount <> oColl.Count Then
            'Something's wrong!
            Stop
        End If

    'Declare Simple Counter
    Dim index As Long

    'Declare Temporary Array to hold our keys
    Dim Temp() As String
    ReDim Temp(ElementCount)

    'Get MemoryAddress of first CollectionItem
    ItemPtr = PeekLongLong(CollPtr + 40)

    'Loop through all CollectionItems in Chain
    While Not ItemPtr = 0 And index < ElementCount

        'increment Index
        index = index + 1

        'Get MemoryAddress of Element-Key
        KeyPtr = PeekLongLong(ItemPtr + 24)

        'Peek Key and add to temporary array (if present)
        If KeyPtr <> 0 Then
           Temp(index) = PeekBSTR(KeyPtr)
        End If

        'Get MemoryAddress of next Element in Chain
        ItemPtr = PeekLongLong(ItemPtr + 40)

    Wend

    'Assign temporary array as Return-Value
    CollectionKeys = Temp

End Function

'Peek Long from given Memory-Address
Public Function PeekLong(Address As LongPtr) As Long

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLong), Address, 4^)

End Function

'Peek LongLong from given Memory Address
Public Function PeekLongLong(Address As LongPtr) As LongLong

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLongLong), Address, 8^)

End Function

'Peek String from given MemoryAddress
Public Function PeekBSTR(Address As LongPtr) As String

    Dim Length As Long

    If Address = 0 Then Stop
    Length = PeekLong(Address - 4)

    PeekBSTR = Space(Length \ 2)
    Call MemCopy(VBA.StrPtr(PeekBSTR), Address, CLngLng(Length))

End Function