bitarray.cls

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

        mLength = RHS
    End If
    mVersion = mVersion + 1
End Property

''
' Returns an enumerator to be used in For..Each loops.
'
' @return An enumerator.
'
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    Set NewEnum = CreateEnumerator(GetEnumerator)
End Function

''
' Performs bitwise negate operation on the internal array.
'
' @return The instance returns a reference to itself to allow
' for concatenated operations.
'
Public Function NotBits() As BitArray
    Dim i As Long
    For i = 0 To mUBound
        mBits(i) = Not mBits(i)
    Next i
    mVersion = mVersion + 1
    Set NotBits = Me
End Function

''
' Performs a bitwise OR on the current instance of BitArray using the
' bits in another instance of BitArray.
'
' @param bits The BitArray object with which to perform the bitwise
' OR operation with.
' @return The internal set of bits is modified based on the operation,
' however, the object returns itself for ease of concatenated operations.
'
Public Function OrBits(ByVal Bits As BitArray) As BitArray
    If Bits Is Nothing Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "bits")
    If Bits.Length <> mLength Then _
        Throw Cor.NewArgumentException("Both arrays must have the same length.", "bits")
    
    Call Bits.ApplyOrTo(mBits)
    mVersion = mVersion + 1
    Set OrBits = Me
End Function

''
' Sets all of the bits to the specified value of True (1) or False (0).
'
' @param value The value to set all the bits to.
'
Public Sub SetAll(ByVal Value As Boolean)
    Dim i As Long
    For i = 0 To mUBound
        mBits(i) = Value
    Next i
    mVersion = mVersion + 1
End Sub

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

''
' Performs a bitwise XOR on the current instance of BitArray using the
' bits in another instance of BitArray.
'
' @param bits The BitArray object with which to perform the bitwise
' XOR operation with.
' @return The internal set of bits is modified based on the operation,
' however, the object returns itself for ease of concatenated operations.
'
Public Function XorBits(ByVal Bits As BitArray) As BitArray
    If Bits Is Nothing Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "bits")
    If Bits.Length <> mLength Then _
        Throw Cor.NewArgumentException("Both arrays must have the same length.", "bits")

    Call Bits.ApplyXorTo(mBits)
    mVersion = mVersion + 1
    Set XorBits = Me
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub ApplyAndTo(ByRef Bits() As Long)
    Dim i As Long
    For i = 0 To mUBound
        Bits(i) = Bits(i) And mBits(i)
    Next i
End Sub

Friend Sub ApplyOrTo(ByRef Bits() As Long)
    Dim i As Long
    For i = 0 To mUBound
        Bits(i) = Bits(i) Or mBits(i)
    Next i
End Sub

Friend Sub ApplyXorTo(ByRef Bits() As Long)
    Dim i As Long
    For i = 0 To mUBound
        Bits(i) = Bits(i) Xor mBits(i)
    Next
End Sub

Friend Sub CloneHelper(ByRef Bits() As Long, ByVal Length As Long)
    mBits = Bits
    mLength = Length
End Sub

Friend Sub Init(ByVal Length As Long, ByVal Value As Boolean)
    Me.Length = Length
    Call SetAll(Value)
End Sub

Friend Sub InitFromBooleans(ByRef Values() As Boolean)
    If cArray.IsNull(Values) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "values")

    Dim i   As Long
    Dim lb  As Long
    Me.Length = cArray.GetLength(Values, 1)
    lb = LBound(Values)
    For i = 0 To mLength - 1
        Item(i) = Values(lb + i)
    Next i
End Sub

Friend Sub InitFromBytes(ByRef Values() As Byte)
    If cArray.IsNull(Values) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "values")
    
    Dim Size As Long
    Size = cArray.GetLength(Values, 1)
    Me.Length = Size * 8
    Call CopyMemory(mBits(0), Values(0), Size)
End Sub

Friend Sub InitFromLongs(ByRef Values() As Long)
    If cArray.IsNull(Values) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "values")
    
    mBits = Values
    mUBound = UBound(Values)
    mLength = (mUBound + 1) * 32
End Sub

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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_InitProperties()
    ReDim mBits(0)
    mLength = 32
End Sub

Private Sub Class_ReadProperties(PropBag As PropertyBag)
    With PropBag
        mUBound = .ReadProperty(PROP_UBOUND)
        mLength = .ReadProperty(PROP_LENGTH)
        
        ReDim mBits(0 To CLng(.ReadProperty(PROP_BITSUBOUND)))
        Dim i As Long
        For i = 0 To UBound(mBits)
            mBits(i) = .ReadProperty(PROP_BITS & i, 0)
        Next i
    End With
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag)
    With PropBag
        Call .WriteProperty(PROP_UBOUND, mUBound)
        Call .WriteProperty(PROP_LENGTH, mLength)
        Call .WriteProperty(PROP_BITSUBOUND, UBound(mBits))
        
        Dim i As Long
        For i = 0 To UBound(mBits)
            Call .WriteProperty(PROP_BITS & i, mBits(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 Function GetBitIndex(ByVal Index As Long, ByRef bit As Long) As Long
    GetBitIndex = Index \ 32
    bit = Powers(Index - GetBitIndex * 32)
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