sortedlist.cls

这是一个在vb下实现的各种加密程序,可以实现一般的文本加密和文件加密,但是很多算法都是已经被人破解过的.

' @param Value The value to be associated to the key.
' @remarks If the key already exists in the list, then that value
' is replaced with the new value. If the key does not exist, then
' it is added with the associated value.
'
Public Property Let Item(ByRef Key As Variant, ByRef Value As Variant)
    Dim i As Long
    i = cArray.BinarySearch(mKeys, Key, 0, mCount, mComparer)
    If i < 0 Then
        Call Add(Key, Value)
    Else
        mValues(i) = Value
        mVersion = mVersion + 1
    End If
End Property

''
' Sets a value to a key.
'
' @param Key The key to associate the value with.
' @param Value The value to be associated to the key.
' @remarks If the key already exists in the list, then that value
' is replaced with the new value. If the key does not exist, then
' it is added with the associated value.
'
Public Property Set Item(ByRef Key As Variant, ByRef Value As Variant)
    Dim i As Long
    i = cArray.BinarySearch(mKeys, Key, 0, mCount, mComparer)
    If i < 0 Then
        Call Add(Key, Value)
    Else
        Set mValues(i) = Value
        mVersion = mVersion + 1
    End If
End Property

''
' Returns the keys in the sorted list.
'
' @return An ICollection object containing the keys.
'
Public Property Get Keys() As ICollection
    Set Keys = NewSortedKeyList
End Property

''
' Returns a For..Each compatible enumerator.
'
' @return The enumerator.
'
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    Set NewEnum = CreateEnumerator(GetEnumerator)
End Function

''
' Removes a key/value pair based on the key.
'
' @param Key The key used to find the value to be removed.
'
Public Sub Remove(ByRef Key As Variant)
    Dim i As Long
    If mCount = 0 Then Exit Sub
    i = cArray.BinarySearch(mKeys, Key, 0, mCount, mComparer)
    If i >= 0 Then Call RemoveAt(i)
End Sub

''
' Removes a key/value pair at a specific index in the list.
'
' @param Index The index of the key/value pair to be removed.
'
Public Sub RemoveAt(ByVal Index As Long)
    If Index < 0 Or Index >= mCount Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Index), "index", Index)
    
    mKeys(Index) = Empty
    mValues(Index) = Empty
    If Index < mCount - 1 Then
        Call CopyMemory(mKeys(Index), mKeys(Index + 1), (mCount - Index) * 16)
        Call ZeroMemory(mKeys(mCount - 1), 16)
        Call CopyMemory(mValues(Index), mValues(Index + 1), (mCount - Index) * 16)
        Call ZeroMemory(mValues(mCount - 1), 16)
    End If
    mCount = mCount - 1
    mVersion = mVersion + 1
End Sub

''
' Sets the value at a specific index in the list.
'
' @param Index The index at which to set the value.
' @param Value The value to set at the specified index.
' @remarks The key at the index will be associated with the new value.
'
Public Sub SetByIndex(ByVal Index As Long, ByRef Value As Variant)
    If Index < 0 Or Index >= mCount Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Index), "index", Index)
    Call VariantCopyInd(mValues(Index), Value)
    mVersion = mVersion + 1
End Sub

''
' Returns a string representation of this object instance.
'
' @return String representing this instance.
Public Function ToString() As String
    ToString = Object.ToString(Me, App)
End Function

''
' Sets the capacity to the number of items in the list.
'
' @remarks This is used to release extra space being used by
' the internal array. The capacity is set to the number of
' items already in the list.
'
Public Sub TrimToSize()
    Capacity = mCount
End Sub

''
' Returns a list of the values in the list.
'
' @return An ICollection object used to access the values.
'
Public Property Get Values() As ICollection
    Set Values = NewSortedValueList
End Property


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Function GetKeyEnumerator() As IEnumerator
    Dim Ret As New SortedListEnumerator
    Call Ret.Init(Me, SAPtr(mKeys), SAPtr(mValues), slKeys)
    Set GetKeyEnumerator = Ret
End Function

Friend Function GetValueEnumerator() As IEnumerator
    Dim Ret As New SortedListEnumerator
    Call Ret.Init(Me, SAPtr(mKeys), SAPtr(mValues), slValues)
    Set GetValueEnumerator = Ret
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_InitProperties()
    ReDim mKeys(0 To DEF_CAPACITY - 1)
    ReDim mValues(0 To DEF_CAPACITY - 1)
    mCapacity = DEF_CAPACITY
End Sub

Private Sub Class_ReadProperties(PropBag As PropertyBag)
    With PropBag
        mCount = .ReadProperty("Count", 0)
        Call EnsureCapacity(.ReadProperty("Capacity", DEF_CAPACITY))
        Set mComparer = .ReadProperty("Comparer", Nothing)
        
        Dim i As Long
        For i = 0 To mCount - 1
            Call Helper.MoveVariant(mKeys(i), .ReadProperty("Key" & i))
            Call Helper.MoveVariant(mValues(i), .ReadProperty("Value" & i))
        Next i
    End With
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag)
    With PropBag
        Call .WriteProperty("Count", mCount)
        Call .WriteProperty("Capacity", mCapacity)
        Call .WriteProperty("Comparer", mComparer)
        
        Dim i As Long
        For i = 0 To mCount - 1
            Call .WriteProperty("Key" & i, mKeys(i))
            Call .WriteProperty("Value" & i, mValues(i))
        Next i
    End With
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IObject Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IObject_Equals(Value As Variant) As Boolean
    IObject_Equals = Equals(Value)
End Function

Private Function IObject_GetHashcode() As Long
    IObject_GetHashcode = GetHashCode
End Function

Private Function IObject_ToString() As String
    IObject_ToString = ToString
End Function

Private Sub EnsureCapacity(ByVal RequiredCapacity As Long)
    Dim NewCapacity As Long
    If RequiredCapacity <= mCapacity Then Exit Sub
    NewCapacity = mCapacity * 2
    If RequiredCapacity > NewCapacity Then NewCapacity = RequiredCapacity
    ReDim Preserve mKeys(0 To NewCapacity - 1)
    ReDim Preserve mValues(0 To NewCapacity - 1)
    mCapacity = NewCapacity
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   ICollection Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ICollection_CopyTo(Arr As Variant, ByVal Index As Long)
    Call CopyTo(Arr, Index)
End Sub

Private Property Get ICollection_Count() As Long
    ICollection_Count = Count
End Property

Private Function ICollection_GetEnumerator() As IEnumerator
    Set ICollection_GetEnumerator = GetEnumerator
End Function

Private Function ICollection_NewEnum() As stdole.IUnknown
    Set ICollection_NewEnum = NewEnum
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IDictionary Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub IDictionary_Add(Key As Variant, Value As Variant)
    Call Add(Key, Value)
End Sub

Private Sub IDictionary_Clear()
    Call Clear
End Sub

Private Function IDictionary_Contains(Key As Variant) As Boolean
    IDictionary_Contains = Contains(Key)
End Function

Private Sub IDictionary_CopyTo(Arr As Variant, ByVal Index As Long)
    Call CopyTo(Arr, Index)
End Sub

Private Property Get IDictionary_Count() As Long
    IDictionary_Count = Count
End Property

Private Function IDictionary_GetEnumerator() As IEnumerator
    Set IDictionary_GetEnumerator = GetEnumerator
End Function

Private Property Get IDictionary_IsFixedSize() As Boolean
    IDictionary_IsFixedSize = IsFixedSize
End Property

Private Property Get IDictionary_IsReadOnly() As Boolean
    IDictionary_IsReadOnly = IsReadOnly
End Property

Private Property Set IDictionary_Item(Key As Variant, RHS As Variant)
    Set Item(Key) = RHS
End Property

Private Property Let IDictionary_Item(Key As Variant, RHS As Variant)
    Item(Key) = RHS
End Property

Private Property Get IDictionary_Item(Key As Variant) As Variant
    Call Helper.MoveVariant(IDictionary_Item, Item(Key))
End Property

Private Property Get IDictionary_Keys() As ICollection
    Set IDictionary_Keys = Keys
End Property

Private Function IDictionary_NewEnum() As stdole.IUnknown
    Set IDictionary_NewEnum = NewEnum
End Function

Private Sub IDictionary_Remove(Key As Variant)
    Call Remove(Key)
End Sub

Private Property Get IDictionary_Values() As ICollection
    Set IDictionary_Values = Values
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IEnumerable Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IEnumerable_GetEnumerator() As IEnumerator
    Set IEnumerable_GetEnumerator = GetEnumerator
End Function

Private Function IEnumerable_NewEnum() As stdole.IUnknown
    Set IEnumerable_NewEnum = NewEnum
End Function

Private Function NewSortedKeyList() As SortedKeyList
    Set NewSortedKeyList = New SortedKeyList
    Call NewSortedKeyList.Init(Me)
End Function

Private Function NewSortedValueList() As SortedValueList
    Set NewSortedValueList = New SortedValueList
    Call NewSortedValueList.Init(Me)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub CloneHelper(ByRef Keys() As Variant, ByRef Values() As Variant, ByVal Count As Long, ByVal Comparer As IComparer)
    mCount = Count
    Set mComparer = Comparer
    mKeys = Keys
    mValues = Values
    mCapacity = UBound(Keys) + 1
End Sub

Friend Sub CopyKeysTo(ByRef DstArray As Variant, ByVal Index As Long)
    Call cArray.CopyEx(mKeys, 0, DstArray, Index, mCount)
End Sub

Friend Sub CopyValuesTo(ByRef DstArray As Variant, ByVal Index As Long)
    Call cArray.CopyEx(mValues, 0, DstArray, Index, mCount)
End Sub

Friend Sub Init(ByVal List As IDictionary, ByVal Comparer As IComparer, ByVal Capacity As Long)
    Set mComparer = Comparer
    If List Is Nothing Then
        Me.Capacity = Capacity
    Else
        mCount = List.Count
        Me.Capacity = mCount
        Call List.Keys.CopyTo(mKeys, 0)
        Call List.Values.CopyTo(mValues, 0)
        Call cArray.SortKeyEx(mKeys, mValues, 0, mCount, Comparer)
    End If
End Sub

Friend Property Get Version() As Long
    Version = mVersion
End Property