Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.191.240.243] |
|
Сообщ.
#1
,
|
|
|
Всем привет.
Решил пореверсить коллекции. Выяснилось что это двоичное красно-черное дерево, все смещения в классах соответствуют смещениям в оригинальной коллекции (можете заменять на структуры и смело обращаться по указателю, меняя данные). Реализованы не все методы, но для понимания алгоритма работы - это не требуется. Сама коллекция 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 |