arraylist.cls

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

' @remarks This is used to track if the list has been modified. Wrappers
' for an ArrayList may need to keep in sync with the list. An example would
' be the ArrayListEnumerator. If the list is modified during enumeration, then
' the enumerator throws an error by checking to see if the version has changed
' since the enumeration began. Since other objects implement the ArrayList
' interface and need to be enumerated using the same ArrayListEnumerator,
' the enumerator can't access a Friend method of ArrayList.
'
Public Property Get Version() As Long
    Version = mVersion
End Property


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub CloneHelper(ByRef Arr() As Variant, ByVal Count As Long)
    mItems = Arr
    mCount = Count
    mCapacity = UBound(Arr) + 1
End Sub

Friend Sub Init(ByRef Comparer As IComparer, ByRef c As Variant)
    Set mComparer = Comparer
    If Not IsMissing(c) Then Call AddRange(c)
End Sub


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

Private Sub InsertSpace(ByVal Index As Long, ByVal Size As Long)
    If Index < mCount Then
        Call CopyMemory(mItems(Index + Size), mItems(Index), (mCount - Index) * 16)
        Call ZeroMemory(mItems(Index), Size * 16)
    End If
End Sub

Private Sub RemoveSpace(ByVal Index As Long, ByVal Size As Long)
    If Index < mCount - 1 Then
        Call CopyMemory(mItems(Index), mItems(Index + Size), (mCount - Index - Size) * 16)
        Call ZeroMemory(mItems(mCount - Size), Size * 16)
    End If
End Sub

Private Sub WriteRange(ByVal Index As Long, ByRef c As Variant, ByVal Insert As Boolean)
    If IsArray(c) Then
        Call WriteArray(Index, c, Insert)
    ElseIf IsObject(c) Then
        If c Is Nothing Then _
            Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Collection), "c")
        
        If TypeOf c Is Collection Then
            Call WriteVBCollection(Index, c, Insert)
        ElseIf TypeOf c Is ICollection Then
            Call WriteICollection(Index, c, Insert)
        Else
            Throw Cor.NewInvalidCastException("An ICollection or VBA.Collection object is required.")
        End If
    Else
        Throw Cor.NewInvalidCastException("An Array, ICollection, or VBA.Collection object is required.")
    End If
End Sub

Private Sub WriteArray(ByVal Index As Long, ByRef Arr As Variant, ByVal Insert As Boolean)
    If cArray.IsNull(Arr) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "c")
    
    ' Get the number of elements in the array
    Dim SizeOfArray As Long
    SizeOfArray = UBound(Arr) - LBound(Arr) + 1
    
    Call WriteCollection(Index, SizeOfArray, Arr, Insert)
End Sub

Private Sub WriteVBCollection(ByVal Index As Long, ByVal CollectionToInsert As Collection, ByVal Insert As Boolean)
    Call WriteCollection(Index, CollectionToInsert.Count, CollectionToInsert, Insert)
End Sub

Private Sub WriteICollection(ByVal Index As Long, ByVal CollectionToInsert As ICollection, ByVal Insert As Boolean)
    Call WriteCollection(Index, CollectionToInsert.Count, CollectionToInsert, True)
End Sub

Private Sub WriteCollection(ByRef Index As Long, ByVal SizeOfCollection As Long, ByRef CollectionToWrite As Variant, ByVal Insert As Boolean)
    If Index < 0 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "Index", Index)
        
    If Insert Then
        ' Make sure the array can handle more elements.
        Call EnsureCapacity(mCount + SizeOfCollection)
        ' Move the elements out so we can insert in the middle.
        Call InsertSpace(Index, SizeOfCollection)
        mCount = mCount + SizeOfCollection
    End If
        
    If Index + SizeOfCollection > mCount Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Index), "Index")
    
    Dim Value As Variant
    For Each Value In CollectionToWrite
        Call Helper.MoveVariant(mItems(Index), Value)
        Index = Index + 1
    Next Value
    
End Sub


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

Private Sub Class_ReadProperties(PropBag As PropertyBag)
    On Error GoTo errTrap
    With PropBag
        mCount = .ReadProperty(PROP_COUNT, 0)
        Call EnsureCapacity(.ReadProperty(PROP_CAPACITY, DEF_CAPACITY))
        
        Dim i As Long
        For i = 0 To mCount - 1
            ' When persisting data within a Class_WriteProperties event, it seems that
            ' object values of Nothing and variant values of Empty do not get persisted
            ' correctly, or at all, except the key name. Even when reading with a default
            ' value of Empty, it returns an empty string "". So now we maintain a flag
            ' with each value to determine the correct value.
            Select Case .ReadProperty(PROP_SUBTYPE & i, SUBTYPE_NORMAL)
                Case SUBTYPE_NORMAL
                    Call Helper.MoveVariant(mItems(i), .ReadProperty(PROP_ITEMPREFIX & i))
                
                Case SUBTYPE_EMPTY
                    mItems(i) = Empty
                
                Case SUBTYPE_NOTHING
                    Set mItems(i) = Nothing
            End Select
        Next i
        
        If .ReadProperty(PROP_DEFAULTCOMPARER, False) Then
            Set mComparer = Comparer.Default
        Else
            Set mComparer = .ReadProperty(PROP_COMPARER, Nothing)
        End If
    End With
    Exit Sub
    
errTrap:
    Throw Cor.NewSerializationException(Err.Description)
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag)
    On Error GoTo errTrap
    With PropBag
        Dim i As Long
        For i = 0 To mCount - 1
            ' When persisting data within a Class_WriteProperties event, it seems that
            ' object values of Nothing and variant values of Empty do not get persisted
            ' correctly, or at all, except the key name. Even when reading with a default
            ' value of Empty, it returns an empty string "". So now we maintain a flag
            ' with each value to determine the correct value.
            Select Case VarType(mItems(i))
                Case vbEmpty
                    Call PropBag.WriteProperty(PROP_SUBTYPE & i, SUBTYPE_EMPTY)
                
                Case vbObject
                    If mItems(i) Is Nothing Then
                        Call PropBag.WriteProperty(PROP_SUBTYPE & i, SUBTYPE_NOTHING)
                    Else
                        Call PropBag.WriteProperty(PROP_ITEMPREFIX & i, mItems(i))
                    End If
                
                Case Else
                    Call PropBag.WriteProperty(PROP_ITEMPREFIX & i, mItems(i))
            
            End Select
        Next i
        
        Call .WriteProperty(PROP_COUNT, mCount)
        Call .WriteProperty(PROP_CAPACITY, mCapacity)
        If mComparer Is Comparer.Default Then
            Call .WriteProperty(PROP_DEFAULTCOMPARER, True)
        Else
            Call .WriteProperty(PROP_COMPARER, mComparer, Nothing)
        End If
    End With
    Exit Sub
    
errTrap:
    Throw Cor.NewSerializationException(Err.Description)
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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   ICloneable Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function ICloneable_Clone() As Object
    Set ICloneable_Clone = Clone
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IList Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IList_Add(Value As Variant) As Long
    IList_Add = Add(Value)
End Function

Private Sub IList_Clear()
    Call Clear
End Sub

Private Function IList_Contains(Value As Variant, Optional ByVal Comparer As IComparer) As Boolean
    IList_Contains = Contains(Value, Comparer)
End Function

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

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

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

Private Function IList_IndexOf(Value As Variant, Optional ByVal Comparer As IComparer) As Long
    IList_IndexOf = IndexOf(Value, , , Comparer)
End Function

Private Sub IList_Insert(ByVal Index As Long, Value As Variant)
    Call Insert(Index, Value)
End Sub

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

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

Private Property Set IList_Item(ByVal Index As Long, RHS As Variant)
    Set Item(Index) = RHS
End Property

Private Property Let IList_Item(ByVal Index As Long, RHS As Variant)
    Item(Index) = RHS
End Property

Private Property Get IList_Item(ByVal Index As Long) As Variant
    Call Helper.MoveVariant(IList_Item, Item(Index))
End Property

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

Private Sub IList_Remove(Value As Variant, Optional ByVal Comparer As IComparer)
    Call Remove(Value, Comparer)
End Sub

Private Sub IList_RemoveAt(ByVal Index As Long)
    Call RemoveAt(Index)
End Sub