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

Тема в разделе "VB", создана пользователем Thetrik, 8 дек 2016.

  1. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    860
    Всем привет.
    Решил пореверсить коллекции. Выяснилось что это двоичное дерево, все смещения в классах соответствуют смещениям в оригинальной коллекции (можете заменять на структуры и смело обращаться по указателю, меняя данные). Реализованы не все методы, но для понимания алгоритма работы - это не требуется.

    Элемент коллекции CVBCollectionItem:
    Код (Visual Basic):
    1.  
    2. ' //
    3. ' // Native VB collection item
    4. ' // Decompiled by The trick
    5. ' //
    6.  
    7. Option Explicit
    8.  
    9. Public vtItem              As Variant
    10. Public bstrKey             As String
    11. Public pPrevIndexedItem    As CVBCollectionItem
    12. Public pNextIndexedItem    As CVBCollectionItem
    13. Public pvUnknown           As Long
    14. Public pParentItem         As CVBCollectionItem
    15. Public pRight              As CVBCollectionItem
    16. Public pLeft               As CVBCollectionItem
    17. Public bFlag               As Boolean
    18.  
     
  2. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    860
    Сама коллекция CVBCollection:
    Код (Visual Basic):
    1.  
    2. ' //
    3. ' // Native VB collection
    4. ' // Decompiled by The trick
    5. ' //
    6.  
    7. Option Explicit
    8.  
    9. Private Const DISP_E_PARAMNOTFOUND        As Long = &H80020004
    10. Private Const CTL_E_ILLEGALFUNCTIONCALL   As Long = &H800A0005
    11. Private Const DISP_E_OVERFLOW             As Long = &H8002000A
    12. Private Const E_OUTOFMEMORY               As Long = &H8007000E
    13.  
    14. Public pInterface1         As IUnknown            ' // 0x00
    15. Public pInterface2         As IUnknown            ' // 0x04
    16. Public pInterface3         As IUnknown            ' // 0x08
    17. Public lRefCounter         As Long                ' // 0x0C
    18. Public lNumOfItems         As Long                ' // 0x10
    19. Public pvUnk1              As Long                ' // 0x14
    20. Public pFirstIndexedItem   As CVBCollectionItem   ' // 0x18
    21. Public pLastIndexedItem    As CVBCollectionItem   ' // 0x1C
    22. Public pvUnk4              As Long                ' // 0x20
    23. Public pFirstItem          As CVBCollectionItem   ' // 0x24
    24. Public pRootItem           As CVBCollectionItem   ' // 0x28
    25. Public pvUnk5              As Long                ' // 0x2C
    26.  
    27. ' // Get item
    28. Public Property Get Item( _
    29.                     ByRef vKeyIndex As Variant) As Variant
    30.     Dim hr      As Long
    31.     Dim pItem   As CVBCollectionItem
    32.    
    33.     hr = GetItemByKey(vKeyIndex, pItem)
    34.    
    35.     If hr < 0 Then
    36.         Err.Raise hr
    37.         Exit Property
    38.     End If
    39.    
    40.     If IsObject(pItem.vtItem) Then
    41.         Set Item = pItem.vtItem
    42.     Else
    43.         Item = pItem.vtItem
    44.     End If
    45.    
    46. End Property
    47.  
    48. ' // Add item to collection
    49. Public Sub Add( _
    50.            ByRef vItem As Variant, _
    51.            Optional ByRef vKey As Variant, _
    52.            Optional ByRef vBefore As Variant, _
    53.            Optional ByRef vAfter As Variant)
    54.     Dim bIsEmptyKey     As Boolean
    55.     Dim bIsEmptyBefore  As Boolean
    56.     Dim bIsEmptyAfter   As Boolean
    57.     Dim vIndex          As Variant
    58.     Dim pNewItem        As CVBCollectionItem
    59.     Dim pItem           As CVBCollectionItem
    60.     Dim pTempItem       As CVBCollectionItem
    61.     Dim bstrKey         As String
    62.     Dim hr              As Long
    63.    
    64.     bIsEmptyKey = IsMissingParam(vKey)
    65.     bIsEmptyBefore = IsMissingParam(vBefore)
    66.     bIsEmptyAfter = IsMissingParam(vAfter)
    67.    
    68.     If bIsEmptyBefore Then
    69.         If Not bIsEmptyAfter Then
    70.             vIndex = vAfter
    71.         End If
    72.     Else
    73.         If Not bIsEmptyAfter Then
    74.             Err.Raise CTL_E_ILLEGALFUNCTIONCALL
    75.             Exit Sub
    76.         End If
    77.         vIndex = vBefore
    78.     End If
    79.    
    80.     If lNumOfItems < 0 Then
    81.         Err.Raise DISP_E_OVERFLOW
    82.         Exit Sub
    83.     End If
    84.    
    85.     If bIsEmptyKey Then
    86.         Set pNewItem = New CVBCollectionItem
    87.     Else
    88.        
    89.         hr = GetItemByKey(vKey, pNewItem)
    90.         If hr >= 0 Then
    91.             Err.Raise &H800A01C9
    92.             Exit Sub
    93.         End If
    94.        
    95.         ' // 48
    96.         Set pNewItem = New CVBCollectionItem
    97.        
    98.         bstrKey = BSTRKeyFromVariant(vKey)
    99.        
    100.         If Len(bstrKey) = 0 Then
    101.             Err.Raise &H800A000D
    102.             Exit Sub
    103.         End If
    104.        
    105.         pNewItem.bstrKey = bstrKey
    106.         pNewItem.bFlag = False
    107.        
    108.         Set pNewItem.pRight = pRootItem
    109.         Set pNewItem.pLeft = pRootItem
    110.        
    111.     End If
    112.    
    113.     ' // VariantCopyInd
    114.     pNewItem.vtItem = vItem
    115.    
    116.     If IsEmpty(vIndex) Then
    117.         Set pItem = pLastIndexedItem
    118.     Else
    119.    
    120.         hr = GetItemByKey(vIndex, pItem)
    121.         If hr < 0 Then
    122.             Err.Raise hr
    123.             Exit Sub
    124.         End If
    125.        
    126.         If Not bIsEmptyBefore Then
    127.             Set pItem = pItem.pPrevIndexedItem
    128.         End If
    129.        
    130.     End If
    131.    
    132.     If Not bIsEmptyBefore And pItem Is Nothing Then
    133.    
    134.         Dim pTmpItem As CVBCollectionItem
    135.        
    136.         Set pTmpItem = pFirstIndexedItem
    137.         Set pFirstIndexedItem = pNewItem
    138.         Set pTmpItem.pPrevIndexedItem = pNewItem
    139.         Set pNewItem.pPrevIndexedItem = Nothing
    140.         Set pNewItem.pNextIndexedItem = pTmpItem
    141.        
    142.     Else
    143.    
    144.         If Not pItem Is Nothing Then
    145.        
    146.             Set pNewItem.pNextIndexedItem = pItem.pNextIndexedItem
    147.            
    148.             If Not pItem.pNextIndexedItem Is Nothing Then
    149.                 Set pNewItem.pNextIndexedItem.pPrevIndexedItem = pNewItem
    150.             Else
    151.                 Set pLastIndexedItem = pNewItem
    152.             End If
    153.            
    154.             Set pItem.pNextIndexedItem = pNewItem
    155.            
    156.         Else
    157.        
    158.             Set pNewItem.pNextIndexedItem = Nothing
    159.             Set pFirstIndexedItem = pNewItem
    160.             Set pLastIndexedItem = pNewItem
    161.          
    162.         End If
    163.        
    164.     End If
    165.    
    166.     Set pNewItem.pPrevIndexedItem = pItem
    167.  
    168.     If Not bIsEmptyKey Then
    169.         AddItemWithKeyToTree pNewItem
    170.     End If
    171.    
    172.     lNumOfItems = lNumOfItems + 1
    173.    
    174. End Sub
    175.  
    176. ' // Get item by variant key/index
    177. Private Function GetItemByKey( _
    178.                  ByRef vKey As Variant, _
    179.                  ByRef pOutItem As CVBCollectionItem) As Long
    180.     Dim bIsEmptyKey As Boolean
    181.     Dim bstrKey     As String
    182.     Dim lIndex      As Long
    183.     Dim pItem       As CVBCollectionItem
    184.    
    185.     bIsEmptyKey = IsMissingParam(vKey)
    186.  
    187.     If bIsEmptyKey Or pFirstIndexedItem Is Nothing Then
    188.         GetItemByKey = CTL_E_ILLEGALFUNCTIONCALL
    189.         Exit Function
    190.     End If
    191.    
    192.     bstrKey = BSTRKeyFromVariant(vKey)
    193.    
    194.     ' // This is string key
    195.     If Len(bstrKey) Then
    196.        
    197.         Set pOutItem = FindItemFrom(pFirstItem, bstrKey)
    198.        
    199.         If pOutItem Is pRootItem Then
    200.             GetItemByKey = CTL_E_ILLEGALFUNCTIONCALL
    201.             Exit Function
    202.         End If
    203.        
    204.     Else
    205.    
    206.         lIndex = Int(vKey)
    207.        
    208.         If lIndex <= 0 Or lIndex > lNumOfItems Then
    209.             GetItemByKey = &H800A000D
    210.             Exit Function
    211.         End If
    212.  
    213.         Set pOutItem = pFirstIndexedItem
    214.  
    215.         Do Until lIndex = 1
    216.             Set pOutItem = pOutItem.pNextIndexedItem
    217.             lIndex = lIndex - 1
    218.         Loop
    219.        
    220.     End If
    221.    
    222. End Function
    223.  
    224. ' // Add item that has a key to tree
    225. Private Function AddItemWithKeyToTree( _
    226.                  ByVal pItem As CVBCollectionItem) As Long
    227.     Dim pCurItem            As CVBCollectionItem
    228.     Dim pParentItem         As CVBCollectionItem
    229.     Dim pParentParentItem   As CVBCollectionItem
    230.     Dim pParentLeft         As CVBCollectionItem
    231.  
    232.     ' // Insert item to tree
    233.     InsertItemToTree pItem
    234.    
    235.     pItem.bFlag = False
    236.    
    237.     Set pCurItem = pItem
    238.    
    239.     Do Until pCurItem Is pFirstItem
    240.    
    241.         Set pParentItem = pCurItem.pParentItem
    242.        
    243.         If pParentItem.bFlag Then Exit Do
    244.        
    245.         Set pParentParentItem = pParentItem.pParentItem
    246.         Set pParentLeft = pParentParentItem.pLeft
    247.        
    248.         If pParentItem Is pParentLeft Then
    249.            
    250.             Set pParentLeft = pParentParentItem.pRight
    251.            
    252.             If Not pParentLeft.bFlag Then
    253.            
    254.                 pParentItem.bFlag = True
    255.                 pParentLeft.bFlag = True
    256.                 pParentItem.pParentItem.bFlag = False
    257.                 Set pCurItem = pCurItem.pParentItem.pParentItem
    258.                
    259.             Else
    260.            
    261.                 If pCurItem Is pParentItem.pParentItem Then
    262.                
    263.                     Set pCurItem = pCurItem.pParentItem
    264.                     MoveDownRight pParentItem
    265.                    
    266.                 Else
    267.                
    268.                     pParentItem.bFlag = True
    269.                     pParentItem.pParentItem.bFlag = False
    270.                     MoveDownLeft pCurItem.pParentItem.pParentItem
    271.                
    272.                 End If
    273.                
    274.             End If
    275.            
    276.         Else
    277.            
    278.             If pParentLeft.bFlag Then
    279.            
    280.                 If pCurItem Is pParentItem.pLeft Then
    281.                
    282.                     Set pCurItem = pCurItem.pParentItem
    283.                     MoveDownLeft pParentItem
    284.                
    285.                 Else
    286.                    
    287.                     pParentItem.bFlag = True
    288.                     pParentItem.pParentItem.bFlag = False
    289.                     MoveDownRight pCurItem.pParentItem.pParentItem
    290.                    
    291.                 End If
    292.                
    293.             Else
    294.            
    295.                 pParentItem.bFlag = True
    296.                 pParentLeft.bFlag = True
    297.                 pParentItem.pParentItem.bFlag = False
    298.                 Set pCurItem = pCurItem.pParentItem.pParentItem
    299.                
    300.             End If
    301.  
    302.         End If
    303.    
    304.     Loop
    305.    
    306.     pFirstItem.bFlag = True
    307.    
    308. End Function
    309.  
    310. ' // Move tree item down and left
    311. Private Sub MoveDownLeft( _
    312.             ByVal pItem As CVBCollectionItem)
    313.     Dim pParentLeft   As CVBCollectionItem
    314.    
    315.     Set pParentLeft = pItem.pLeft
    316.     Set pItem.pLeft = pParentLeft.pRight
    317.    
    318.     If Not pParentLeft.pRight Is pRootItem Then
    319.         Set pParentLeft.pRight.pParentItem = pItem
    320.     End If
    321.    
    322.     Set pParentLeft.pParentItem = pItem.pParentItem
    323.    
    324.     If pItem.pParentItem Is pRootItem Then
    325.         Set pFirstItem = pParentLeft
    326.     Else
    327.         If pItem Is pItem.pParentItem.pRight Then
    328.             Set pItem.pParentItem.pRight = pParentLeft
    329.         Else
    330.             Set pItem.pParentItem.pLeft = pParentLeft
    331.         End If
    332.     End If
    333.    
    334.     Set pParentLeft.pRight = pItem
    335.     Set pItem.pParentItem = pParentLeft
    336.    
    337. End Sub
    338.  
     
  3. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    860
    Продолжение кода класса CVBCollection:
    Код (Visual Basic):
    1. ' // Move tree item down and right
    2. Private Sub MoveDownRight( _
    3.             ByVal pItem As CVBCollectionItem)
    4.     Dim pRight  As CVBCollectionItem
    5.    
    6.     Set pRight = pItem.pRight
    7.     Set pItem.pRight = pRight.pLeft
    8.    
    9.     If Not pRight.pLeft Is pRootItem Then
    10.         Set pRight.pLeft.pParentItem = pItem
    11.     End If
    12.    
    13.     Set pRight.pParentItem = pItem.pParentItem
    14.    
    15.     If pItem.pParentItem Is pRootItem Then
    16.         Set pFirstItem = pRight
    17.     Else
    18.         If pItem Is pItem.pParentItem.pLeft Then
    19.             Set pItem.pParentItem.pLeft = pRight
    20.         Else
    21.             Set pItem.pParentItem.pRight = pRight
    22.         End If
    23.     End If
    24.    
    25.     Set pRight.pLeft = pItem
    26.     Set pItem.pParentItem = pRight
    27.    
    28. End Sub
    29. ' // Insert item to tree
    30. Private Function InsertItemToTree( _
    31.                  ByVal pItem As CVBCollectionItem) As Long
    32.     Dim pCurItem    As CVBCollectionItem
    33.     Dim pParentItem As CVBCollectionItem
    34.     Dim hr          As Long
    35.    
    36.     Set pParentItem = pRootItem
    37.     Set pCurItem = pFirstItem
    38.    
    39.     ' // Check if item exists
    40.     If Not pParentItem Is pCurItem Then
    41.        
    42.         ' // Find tree node for passed item
    43.         Do
    44.        
    45.             Set pParentItem = pCurItem
    46.            
    47.             hr = StrComp(pItem.bstrKey, pCurItem.bstrKey, vbTextCompare) + 1
    48.            
    49.             Select Case hr
    50.             Case 0
    51.                 Set pCurItem = pCurItem.pLeft
    52.             Case 1
    53.                 ' // Error. Specified item already exists
    54.                 InsertItemToTree = &H800A01C9
    55.                 Exit Function
    56.             Case 2
    57.                 Set pCurItem = pCurItem.pRight
    58.             End Select
    59.            
    60.         Loop Until pCurItem Is pRootItem
    61.        
    62.     Else:   hr = ObjPtr(pItem)
    63.     End If
    64.    
    65.     ' // Set parent node for passed item
    66.     Set pItem.pParentItem = pParentItem
    67.    
    68.     ' // Check if it is the root node
    69.     If pParentItem Is pRootItem Then
    70.         Set pFirstItem = pItem
    71.     Else
    72.         ' // Place item depending on value
    73.         If hr Then
    74.             Set pParentItem.pRight = pItem
    75.         Else
    76.             Set pParentItem.pLeft = pItem
    77.         End If
    78.     End If
    79.    
    80. End Function
    81.                
    82. ' // Find an item by key from specified item
    83. Private Function FindItemFrom( _
    84.                  ByVal pStartItem As CVBCollectionItem, _
    85.                  ByRef bstrKey As String) As CVBCollectionItem
    86.     Dim pCurItem    As CVBCollectionItem
    87.    
    88.     Set pCurItem = pStartItem
    89.    
    90.     Do Until pCurItem Is pRootItem
    91.    
    92.         Select Case StrComp(bstrKey, pCurItem.bstrKey, vbTextCompare)
    93.         Case -1:    Set pCurItem = pCurItem.pLeft
    94.         Case 0:     Exit Do
    95.         Case 1:     Set pCurItem = pCurItem.pRight
    96.         End Select
    97.        
    98.     Loop
    99.    
    100.     Set FindItemFrom = pCurItem
    101.    
    102. End Function
    103. ' // Convert a variant value to string
    104. Private Function BSTRKeyFromVariant( _
    105.                  ByRef vKey As Variant) As String
    106.     Dim vTemp   As Variant
    107.     Dim pTmpObj As Object
    108.    
    109.     If IsObject(vKey) Then
    110.    
    111.         Set pTmpObj = vKey
    112.        
    113.         If Not pTmpObj Is Nothing Then
    114.             vTemp = CStr(vKey)
    115.         Else
    116.             Set vTemp = vKey
    117.         End If
    118.    
    119.     Else
    120.         vTemp = vKey
    121.     End If
    122.    
    123.     If VarType(vTemp) = vbString Then
    124.         BSTRKeyFromVariant = CStr(vTemp)
    125.     End If
    126.    
    127. End Function
    128. Private Function IsMissingParam( _
    129.                  ByRef vParam As Variant) As Boolean
    130.                
    131. #If COMPILED Then
    132.    
    133.     If IsError(vParam) Then
    134.         If CInt(vParam) = DISP_E_PARAMNOTFOUND Then
    135.             IsMissingParam = True
    136.         End If
    137.     End If
    138.    
    139. #Else
    140.     IsMissingParam = IsMissing(vParam)
    141.    
    142. #End If
    143. End Function
    144. Private Sub Class_Initialize()
    145.     Set pRootItem = New CVBCollectionItem
    146.     Set pFirstItem = pRootItem
    147.    
    148. #If Not COMPILED Then
    149.    
    150.     pRootItem.bstrKey = "root"
    151.    
    152. #End If
    153. End Sub