bitarray.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 1  'Persistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "BitArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'    CopyRight (c) 2004 Kelly Ethridge
'
'    This file is part of VBCorLib.
'
'    VBCorLib is free software; you can redistribute it and/or modify
'    it under the terms of the GNU Library General Public License as published by
'    the Free Software Foundation; either version 2.1 of the License, or
'    (at your option) any later version.
'
'    VBCorLib is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU Library General Public License for more details.
'
'    You should have received a copy of the GNU Library General Public License
'    along with Foobar; if not, write to the Free Software
'    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'    Module: BitArray
'

''
' Manages a compact array of bit values. Each bit represents
' a boolean, where True = 1, and False = 0.
'
' @remarks The default size is 32 bits represented. A <b>BitArray</b> with a
' different size can be creates using the public constructor or static constructors.
' <p>The following are some of the available methods to create a <b>BitArray</b>.
' <pre>
' Set bits = New BitArray
' - or -
' Set bits = NewBitArray(128)
' - or -
' Set bits = BitArray.FromBooleans(BooleanArray)
' </pre></p>
' @see Constructors
' @see BitArrayStatic
'
Option Explicit
Implements IObject
Implements IEnumerable
Implements ICollection
Implements ICloneable

Private Const PROP_UBOUND       As String = "Ubound"
Private Const PROP_LENGTH       As String = "Length"
Private Const PROP_BITSUBOUND   As String = "BitsUBound"
Private Const PROP_BITS         As String = "Bits"

Private mBits()     As Long
Private mLength     As Long
Private mUBound     As Long
Private mVersion    As Long

''
' Performs a bitwise AND 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
' AND 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 AndBits(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.ApplyAndTo(mBits)
    mVersion = mVersion + 1
    Set AndBits = Me
End Function

''
' Returns a duplicate of the current instance.
'
' @return A duplicate of the current instance.
'
Public Function Clone() As BitArray
    Set Clone = New BitArray
    Call Clone.CloneHelper(mBits, mLength)
End Function

''
' Copies the internal bit-array to a compatible array.
'
' @param dstArray The array to copy the values to.
' @param index The starting position in the array to
' begin copying to.
' @remarks CopyTo supports the copying to three array types: Long, Byte
' and Boolean. When copying to Long or Byte type arrays, the bits in the
' elements are equivalents to the bits in the BitArray. When copying to
' a Boolean array, each boolean element represents a single bit in the array.
'
Public Sub CopyTo(ByRef DstArray As Variant, ByVal Index As Long)
    If cArray.IsNull(DstArray) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "dstArray")
    If Index < LBound(DstArray) Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_LBound), "index", Index)
    If cArray.GetRank(DstArray) <> 1 Then _
        Throw Cor.NewRankException(Environment.GetResourceString(Rank_MultiDimension))
    
    Select Case VarType(DstArray)
        Case vbLongArray
            Call cArray.CopyEx(mBits, 0, DstArray, Index, (mLength + 31) \ 32)
        
        Case vbByteArray
            If (Index + (mLength + 7) \ 8) - 1 > UBound(DstArray) Then _
                Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_ArrayPlusOffTooSmall), "index")
            
            Call Buffer.BlockCopy(mBits, 0, DstArray, Index - LBound(DstArray), (mLength + 7) \ 8)
            
        Case vbBooleanArray
            If cArray.GetLength(DstArray) < mLength Then _
                Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_ArrayPlusOffTooSmall), "index")
            
            Dim i As Long
            For i = 0 To mLength - 1
                DstArray(Index + i) = CBool(mBits(i \ 32) And Powers(i Mod 32))
            Next i
        
        Case Else
            Throw Cor.NewArrayTypeMismatchException(Environment.GetResourceString(ArrayTypeMismatch_Incompatible))
    End Select
End Sub

''
' Returns the number of bits being represented in the array.
'
' @return The number of bits represented.
' @remarks This returns the same value as Length, however, this
' property is read-only.
'
Public Property Get Count() As Long
    Count = mLength
End Property

''
' Returns a boolean indicating if the value and this object
' instance are the same instance.
'
' @param value The value to compare equality to.
' @return Boolean indicating equality.
' @see IObject
'
Public Function Equals(ByRef Value As Variant) As Boolean
    Equals = Object.Equals(Me, Value)
End Function

''
' Returns an enumerator for this instance.
'
' @return An enumerator
'
Public Function GetEnumerator() As IEnumerator
    Dim Ret As New BitArrayEnumerator
    Call Ret.Init(Me)
    Set GetEnumerator = Ret
End Function

''
' Returns a pseudo-unique number identifying this instance.
'
' @return Pseudo-unique number identifying this instance.
' @see IObject
'
Public Function GetHashCode() As Long
    GetHashCode = ObjPtr(CUnk(Me))
End Function

''
' Returns if the instance is a read-only instance.
'
' @return Value indicating if the instance is read-only.
'
Public Property Get IsReadOnly() As Boolean
    IsReadOnly = False
End Property

''
' Returns the value of a specific bit in the array.
'
' @param index The specific bit to return.
' @return Value of the specified bit.
' @remarks The index is zero based.
'
Public Property Get Item(ByVal Index As Long) As Boolean
Attribute Item.VB_UserMemId = 0
    If Index < 0 Or Index >= mLength Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Index), "index", Index)
    
    Dim bit As Long
    Index = GetBitIndex(Index, bit)
    Item = CBool(mBits(Index) And bit)
End Property

''
' Sets the value of a specific bit in the array.
'
' @param index The specific bit to set.
' @param RHS The value to set the specified bit to.
' @remarks The index is zero based.'
'
Public Property Let Item(ByVal Index As Long, ByVal RHS As Boolean)
    If Index < 0 Or Index >= mLength Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Index), "index", Index)

    Dim bit As Long
    Index = GetBitIndex(Index, bit)
    If RHS Then
        mBits(Index) = mBits(Index) Or bit
    Else
        mBits(Index) = mBits(Index) And (Not bit)
    End If
    mVersion = mVersion + 1
End Property

''
' Returns the number of bits represented in the array.
'
' @return The number of bits represented.
'
Public Property Get Length() As Long
    Length = mLength
End Property

''
' Sets the number of bits represented in the array.
'
' @param RHS The number of bits to represent.
' @remarks If the length of the array is increased, then the
' newly available bits are set to 0 (False).
'
Public Property Let Length(ByVal RHS As Long)
    If RHS <> mLength Then
        Dim Index As Long
        Index = (RHS - 1) \ 32
        ReDim Preserve mBits(0 To Index)
        mUBound = Index
        
        Dim bit As Long
        bit = RHS - Index * 32
        If bit > 0 Then
            bit = Powers(bit - 1)
            mBits(mUBound) = mBits(mUBound) And bit
        End If