Решил пореверсить коллекции. Выяснилось что это двоичное дерево, все смещения в классах соответствуют смещениям в оригинальной коллекции (можете заменять на структуры и смело обращаться по указателю, меняя данные). Реализованы не все методы, но для понимания алгоритма работы - это не требуется.
Сама коллекция CVBCollection:
- Код: Выделить всё
' //
' // 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
Элемент коллекции CVBCollectionItem:
- Код: Выделить всё
' //
' // 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