А вы задумывались как работает коллекция в VB6?

' //
' // Native VB collection
' // Decompiled by The trick
' //
 
Option Explicit
 
Private Const DISP_E_PARAMNOTFOUND        As Long = &H80020004
Private Const CTL_E_ILLEGALFUNCTIONCALL   As Long = &H800A0005
Private Const DISP_E_OVERFLOW             As Long = &H8002000A
Private Const E_OUTOFMEMORY               As Long = &H8007000E
 
Public pInterface1         As IUnknown            ' // 0x00
Public pInterface2         As IUnknown            ' // 0x04
Public pInterface3         As IUnknown            ' // 0x08
Public lRefCounter         As Long                ' // 0x0C
Public lNumOfItems         As Long                ' // 0x10
Public pvUnk1              As Long                ' // 0x14
Public pFirstIndexedItem   As CVBCollectionItem   ' // 0x18
Public pLastIndexedItem    As CVBCollectionItem   ' // 0x1C
Public pvUnk4              As Long                ' // 0x20
Public pFirstItem          As CVBCollectionItem   ' // 0x24
Public pRootItem           As CVBCollectionItem   ' // 0x28
Public pvUnk5              As Long                ' // 0x2C
 
' // Get item
Public Property Get Item( _
                    ByRef vKeyIndex As Variant) As Variant
    Dim hr      As Long
    Dim pItem   As CVBCollectionItem
    
    hr = GetItemByKey(vKeyIndex, pItem)
    
    If hr < 0 Then
        Err.Raise hr
        Exit Property
    End If
    
    If IsObject(pItem.vtItem) Then
        Set Item = pItem.vtItem
    Else
        Item = pItem.vtItem
    End If
    
End Property
 
' // Add item to collection
Public Sub Add( _
           ByRef vItem As Variant, _
           Optional ByRef vKey As Variant, _
           Optional ByRef vBefore As Variant, _
           Optional ByRef vAfter As Variant)
    Dim bIsEmptyKey     As Boolean
    Dim bIsEmptyBefore  As Boolean
    Dim bIsEmptyAfter   As Boolean
    Dim vIndex          As Variant
    Dim pNewItem        As CVBCollectionItem
    Dim pItem           As CVBCollectionItem
    Dim pTempItem       As CVBCollectionItem
    Dim bstrKey         As String
    Dim hr              As Long
    
    bIsEmptyKey = IsMissingParam(vKey)
    bIsEmptyBefore = IsMissingParam(vBefore)
    bIsEmptyAfter = IsMissingParam(vAfter)
    
    If bIsEmptyBefore Then
        If Not bIsEmptyAfter Then
            vIndex = vAfter
        End If
    Else
        If Not bIsEmptyAfter Then
            Err.Raise CTL_E_ILLEGALFUNCTIONCALL
            Exit Sub
        End If
        vIndex = vBefore
    End If
    
    If lNumOfItems < 0 Then
        Err.Raise DISP_E_OVERFLOW
        Exit Sub
    End If
    
    If bIsEmptyKey Then
        Set pNewItem = New CVBCollectionItem
    Else
        
        hr = GetItemByKey(vKey, pNewItem)
        If hr >= 0 Then
            Err.Raise &H800A01C9
            Exit Sub
        End If
        
        ' // 48
        Set pNewItem = New CVBCollectionItem
        
        bstrKey = BSTRKeyFromVariant(vKey)
        
        If Len(bstrKey) = 0 Then
            Err.Raise &H800A000D
            Exit Sub
        End If
        
        pNewItem.bstrKey = bstrKey
        pNewItem.bFlag = False
        
        Set pNewItem.pRight = pRootItem
        Set pNewItem.pLeft = pRootItem
        
    End If
    
    ' // VariantCopyInd
    pNewItem.vtItem = vItem
   
    If IsEmpty(vIndex) Then
        Set pItem = pLastIndexedItem
    Else
    
        hr = GetItemByKey(vIndex, pItem)
        If hr < 0 Then
            Err.Raise hr
            Exit Sub
        End If
        
        If Not bIsEmptyBefore Then
            Set pItem = pItem.pPrevIndexedItem
        End If
        
    End If
    
    If Not bIsEmptyBefore And pItem Is Nothing Then
    
        Dim pTmpItem As CVBCollectionItem
        
        Set pTmpItem = pFirstIndexedItem
        Set pFirstIndexedItem = pNewItem
        Set pTmpItem.pPrevIndexedItem = pNewItem
        Set pNewItem.pPrevIndexedItem = Nothing
        Set pNewItem.pNextIndexedItem = pTmpItem
        
    Else
    
        If Not pItem Is Nothing Then
        
            Set pNewItem.pNextIndexedItem = pItem.pNextIndexedItem
            
            If Not pItem.pNextIndexedItem Is Nothing Then
                Set pNewItem.pNextIndexedItem.pPrevIndexedItem = pNewItem
            Else
                Set pLastIndexedItem = pNewItem
            End If
            
            Set pItem.pNextIndexedItem = pNewItem
            
        Else
        
            Set pNewItem.pNextIndexedItem = Nothing
            Set pFirstIndexedItem = pNewItem
            Set pLastIndexedItem = pNewItem
          
        End If
        
    End If
    
    Set pNewItem.pPrevIndexedItem = pItem
 
    If Not bIsEmptyKey Then
        AddItemWithKeyToTree pNewItem
    End If
    
    lNumOfItems = lNumOfItems + 1
    
End Sub
 
' // Get item by variant key/index
Private Function GetItemByKey( _
                 ByRef vKey As Variant, _
                 ByRef pOutItem As CVBCollectionItem) As Long
    Dim bIsEmptyKey As Boolean
    Dim bstrKey     As String
    Dim lIndex      As Long
    Dim pItem       As CVBCollectionItem
    
    bIsEmptyKey = IsMissingParam(vKey)
 
    If bIsEmptyKey Or pFirstIndexedItem Is Nothing Then
        GetItemByKey = CTL_E_ILLEGALFUNCTIONCALL
        Exit Function
    End If
    
    bstrKey = BSTRKeyFromVariant(vKey)
    
    ' // This is string key
    If Len(bstrKey) Then
        
        Set pOutItem = FindItemFrom(pFirstItem, bstrKey)
        
        If pOutItem Is pRootItem Then
            GetItemByKey = CTL_E_ILLEGALFUNCTIONCALL
            Exit Function
        End If
        
    Else
    
        lIndex = Int(vKey)
        
        If lIndex <= 0 Or lIndex > lNumOfItems Then
            GetItemByKey = &H800A000D
            Exit Function
        End If
 
        Set pOutItem = pFirstIndexedItem
 
        Do Until lIndex = 1
            Set pOutItem = pOutItem.pNextIndexedItem
            lIndex = lIndex - 1
        Loop
        
    End If
    
End Function
 
' // Add item that has a key to tree
Private Function AddItemWithKeyToTree( _
                 ByVal pItem As CVBCollectionItem) As Long
    Dim pCurItem            As CVBCollectionItem
    Dim pParentItem         As CVBCollectionItem
    Dim pParentParentItem   As CVBCollectionItem
    Dim pParentLeft         As CVBCollectionItem
 
    ' // Insert item to tree
    InsertItemToTree pItem
    
    pItem.bFlag = False
    
    Set pCurItem = pItem
    
    Do Until pCurItem Is pFirstItem
    
        Set pParentItem = pCurItem.pParentItem
        
        If pParentItem.bFlag Then Exit Do
        
        Set pParentParentItem = pParentItem.pParentItem
        Set pParentLeft = pParentParentItem.pLeft
        
        If pParentItem Is pParentLeft Then
            
            Set pParentLeft = pParentParentItem.pRight
            
            If Not pParentLeft.bFlag Then
            
                pParentItem.bFlag = True
                pParentLeft.bFlag = True
                pParentItem.pParentItem.bFlag = False
                Set pCurItem = pCurItem.pParentItem.pParentItem
                
            Else
            
                If pCurItem Is pParentItem.pParentItem Then
                
                    Set pCurItem = pCurItem.pParentItem
                    MoveDownRight pParentItem
                    
                Else
                
                    pParentItem.bFlag = True
                    pParentItem.pParentItem.bFlag = False
                    MoveDownLeft pCurItem.pParentItem.pParentItem
                
                End If
                
            End If
            
        Else
            
            If pParentLeft.bFlag Then
            
                If pCurItem Is pParentItem.pLeft Then
                
                    Set pCurItem = pCurItem.pParentItem
                    MoveDownLeft pParentItem
                
                Else
                    
                    pParentItem.bFlag = True
                    pParentItem.pParentItem.bFlag = False
                    MoveDownRight pCurItem.pParentItem.pParentItem
                    
                End If
                
            Else
            
                pParentItem.bFlag = True
                pParentLeft.bFlag = True
                pParentItem.pParentItem.bFlag = False
                Set pCurItem = pCurItem.pParentItem.pParentItem
                
            End If
 
        End If
    
    Loop
    
    pFirstItem.bFlag = True
    
End Function
 
' // Move tree item down and left
Private Sub MoveDownLeft( _
            ByVal pItem As CVBCollectionItem)
    Dim pParentLeft   As CVBCollectionItem
    
    Set pParentLeft = pItem.pLeft
    Set pItem.pLeft = pParentLeft.pRight
    
    If Not pParentLeft.pRight Is pRootItem Then
        Set pParentLeft.pRight.pParentItem = pItem
    End If
    
    Set pParentLeft.pParentItem = pItem.pParentItem
    
    If pItem.pParentItem Is pRootItem Then
        Set pFirstItem = pParentLeft
    Else
        If pItem Is pItem.pParentItem.pRight Then
            Set pItem.pParentItem.pRight = pParentLeft
        Else
            Set pItem.pParentItem.pLeft = pParentLeft
        End If
    End If
    
    Set pParentLeft.pRight = pItem
    Set pItem.pParentItem = pParentLeft
    
End Sub
 
' // Move tree item down and right
Private Sub MoveDownRight( _
            ByVal pItem As CVBCollectionItem)
    Dim pRight  As CVBCollectionItem
    
    Set pRight = pItem.pRight
    Set pItem.pRight = pRight.pLeft
    
    If Not pRight.pLeft Is pRootItem Then
        Set pRight.pLeft.pParentItem = pItem
    End If
    
    Set pRight.pParentItem = pItem.pParentItem
    
    If pItem.pParentItem Is pRootItem Then
        Set pFirstItem = pRight
    Else
        If pItem Is pItem.pParentItem.pLeft Then
            Set pItem.pParentItem.pLeft = pRight
        Else
            Set pItem.pParentItem.pRight = pRight
        End If
    End If
    
    Set pRight.pLeft = pItem
    Set pItem.pParentItem = pRight
    
End Sub
 
' // Insert item to tree
Private Function InsertItemToTree( _
                 ByVal pItem As CVBCollectionItem) As Long
    Dim pCurItem    As CVBCollectionItem
    Dim pParentItem As CVBCollectionItem
    Dim hr          As Long
    
    Set pParentItem = pRootItem
    Set pCurItem = pFirstItem
    
    ' // Check if item exists
    If Not pParentItem Is pCurItem Then
        
        ' // Find tree node for passed item
        Do
        
            Set pParentItem = pCurItem
            
            hr = StrComp(pItem.bstrKey, pCurItem.bstrKey, vbTextCompare) + 1
            
            Select Case hr
            Case 0
                Set pCurItem = pCurItem.pLeft
            Case 1
                ' // Error. Specified item already exists
                InsertItemToTree = &H800A01C9
                Exit Function
            Case 2
                Set pCurItem = pCurItem.pRight
            End Select
            
        Loop Until pCurItem Is pRootItem
        
    Else:   hr = ObjPtr(pItem)
    End If
    
    ' // Set parent node for passed item
    Set pItem.pParentItem = pParentItem
    
    ' // Check if it is the root node
    If pParentItem Is pRootItem Then
        Set pFirstItem = pItem
    Else
        ' // Place item depending on value
        If hr Then
            Set pParentItem.pRight = pItem
        Else
            Set pParentItem.pLeft = pItem
        End If
    End If
    
End Function
                 
' // Find an item by key from specified item
Private Function FindItemFrom( _
                 ByVal pStartItem As CVBCollectionItem, _
                 ByRef bstrKey As String) As CVBCollectionItem
    Dim pCurItem    As CVBCollectionItem
    
    Set pCurItem = pStartItem
    
    Do Until pCurItem Is pRootItem
    
        Select Case StrComp(bstrKey, pCurItem.bstrKey, vbTextCompare)
        Case -1:    Set pCurItem = pCurItem.pLeft
        Case 0:     Exit Do
        Case 1:     Set pCurItem = pCurItem.pRight
        End Select
        
    Loop
    
    Set FindItemFrom = pCurItem
    
End Function
 
' // Convert a variant value to string
Private Function BSTRKeyFromVariant( _
                 ByRef vKey As Variant) As String
    Dim vTemp   As Variant
    Dim pTmpObj As Object
    
    If IsObject(vKey) Then
    
        Set pTmpObj = vKey
        
        If Not pTmpObj Is Nothing Then
            vTemp = CStr(vKey)
        Else
            Set vTemp = vKey
        End If
    
    Else
        vTemp = vKey
    End If
     
    If VarType(vTemp) = vbString Then
        BSTRKeyFromVariant = CStr(vTemp)
    End If
    
End Function
 
Private Function IsMissingParam( _
                 ByRef vParam As Variant) As Boolean
                 
#If COMPILED Then
    
    If IsError(vParam) Then
        If CInt(vParam) = DISP_E_PARAMNOTFOUND Then
            IsMissingParam = True
        End If
    End If
    
#Else
 
    IsMissingParam = IsMissing(vParam)
    
#End If
 
End Function
 
Private Sub Class_Initialize()
 
    Set pRootItem = New CVBCollectionItem
    Set pFirstItem = pRootItem
    
#If Not COMPILED Then
    
    pRootItem.bstrKey = "root"
    
#End If
 
End Sub

' //
' // Native VB collection item
' // Decompiled by The trick
' //
 
Option Explicit
 
Public vtItem              As Variant
Public bstrKey             As String
Public pPrevIndexedItem    As CVBCollectionItem
Public pNextIndexedItem    As CVBCollectionItem
Public pvUnknown           As Long
Public pParentItem         As CVBCollectionItem
Public pRight              As CVBCollectionItem
Public pLeft               As CVBCollectionItem
Public bFlag               As Boolean

RBTree = RBEmp

Private Declare Sub GetRunningObjectTable Lib "ole32.dll" (ByVal reserved As Long, ByVal pprot As Long)