binaryreader.cls

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

    Call FillBuffer(8)
    ReadCurrency = AsCurr(ByVal mPtrBuffer)
End Function

''
' Reads 4 bytes from the stream and returns them as a Single datatype.
'
' @return A Single datatype.
'
Public Function ReadSingle() As Single
    Call FillBuffer(4)
    ReadSingle = AsSingle(ByVal mPtrBuffer)
End Function

''
' Reads 16 bytes from the stream and returns them as a Variant Decimal datatype.
'
' @return A Variant Decimal datatype.
' @remarks <p>The Decimal datatype is created from 16 bytes with the same
' layout as used in .NET. The layout is different than that of VB.<br><br>
' VB Decimal layout<br>
' bytes 0-1: Variant datatype information<br>
' bytes 2: precision<br>
' bytes 3: sign (&h80 is negative)<br>
' bytes 4-7: the 32 highest bits in the 96bit value<br>
' bytes 8-11: the 32 lowest bits in the 96bit value<br>
' bytes 12-15: the 32 middle bits in the 96bit value<br>
' <br>
' .NET Decimal layout<br>
' bytes 0-3: the 32 lowest bits in the 96bit value<br>
' bytes 4-7: the 32 middle bits in the 96bit value<br>
' bytes 8-11: the 32 highest bits in the 96bit value<br>
' bytes 12-13: unused (zero)<br>
' bytes 14: precision<br>
' bytes 15: sign (&h80 is negative)<br><br>
' If the sign byte is non-zero, then the Decimal will be set as negative.<br>
'
Public Function ReadDecimal() As Variant
    Call FillBuffer(16)
    ReadDecimal = BitConverter.ToDecimal(mBuffer, 0)
End Function

''
' Reads a String from the stream.
'
' @return The string datatype.
' @remarks The string is stored in the stream with the number of encoded bytes preceding
' the actual string data. The bytes are not the typical 4 bytes as is used by VB when
' representing the length of the string. The bytes represent a value encoded as
' 7bits per byte. While the next read byte has the high bit set (&h80), then the
' following byte is also part of the length value. For each byte read, first 7 bits of
' that byte is pushed out 7 bits multiplied by the current byte number - 1 in the sequence.
' This is not the normal shifting of the current sum of the values. Each read byte
' must be shifted left individually, as each byte represents a higher set of bits
' in the resulting number.<br><br>
' We AND the byte with &h3f because we only want the lower 7 bits.<br>
' byte 1: (byte and &h3f) << shifted 0 bits added to the sum<br>
' byte 2: (byte and &h3f) << shifted 7 bits added to the sum<br>
' byte 3: (byte and &H3f) << shifted 14 bits added to the sum<br><br>
' .. this continues until a byte is less than 128. At which point, it is shifted and summed like the
' rest, but no more bytes are to be read in. The sum now contains the number of bytes to
' be read in and decoded into the string. The same Encoding type must be used to retrieve
' the correct string value. Using a different Encoding method will create the wrong string.
'
' <p>Once the length is determined, then enough bytes are read in that can be decoded
' to the string using the current Encoding system.</p>
'
Public Function ReadString() As String
    Call VerifyIsOpen
    
    Dim EncodedStringLength As Long
    EncodedStringLength = ReadStringLength
    
    If EncodedStringLength > 0 Then
        Dim EncodedBytes() As Byte
        ReDim EncodedBytes(0 To EncodedStringLength - 1)
        
        Dim BytesRead As Long
        BytesRead = mStream.ReadBlock(EncodedBytes, 0, EncodedStringLength)
        If BytesRead < EncodedStringLength Then Throw New EndOfStreamException
        ReadString = mEncoding.GetString(EncodedBytes)
    End If
End Function

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

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

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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByVal Stream As Stream, ByVal Encoding As Encoding)
    If Stream Is Nothing Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Stream), "Stream")
    If Not Stream.CanRead Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_ReadableStreamRequired), "Stream")
    
    Set mStream = Stream
    If Encoding Is Nothing Then
        Set mEncoding = New UTF8Encoding
    Else
        Set mEncoding = Encoding
    End If
    mIsOpen = True
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub VerifyIsOpen()
    If Not mIsOpen Then Throw Cor.NewObjectDisposedException("BinaryReader", "Cannot read from a closed BinaryReader.")
End Sub

Private Sub FillBuffer(ByVal Count As Long)
    Call VerifyIsOpen
    
    ' optimize for reading a single byte
    Dim num As Long
    If Count = 1 Then
        num = mStream.ReadByte
        If num >= 0 Then
            mBuffer(0) = num
            Exit Sub
        End If
    Else
        num = mStream.ReadBlock(mBuffer, 0, Count)
    End If
    If num < Count Then Throw New EndOfStreamException
End Sub

Private Function ReadStringLength() As Long
    Dim ret         As Long
    Dim num         As Long
    Dim shiftCount  As Long
    
    num = mStream.ReadByte
    Do While num >= &H80
        ret = ret + Helper.ShiftLeft(num And &H7F, shiftCount)
        num = mStream.ReadByte
        shiftCount = shiftCount + 7
    Loop
    If num > 0 Then
        ReadStringLength = ret + Helper.ShiftLeft(num, shiftCount)
    Else
        ReadStringLength = ret
    End If
End Function

Private Function ReadCharBytes(ByRef Chars() As Integer, ByVal Index As Long, ByVal Count As Long) As Long
    Dim Result As Long
    
    Result = VerifyArrayRange(SAPtr(Chars), Index, Count)
    If Result <> NO_ERROR Then ThrowArrayRangeException Result, "Chars", Index, "Index", Count, "Count"
    
    Call EnsureCapacity(mEncoding.GetMaxByteCount(Count))
    
    Dim b       As Long
    Dim pos     As Long
    Dim NumRead As Long
    Do While NumRead < Count
        b = mStream.ReadByte
        If b < 0 Then Exit Do
        mBuffer(pos) = b
        pos = pos + 1
        NumRead = NumRead + mEncoding.GetCharsEx(mBuffer, 0, pos, Chars, Index)
    Loop
    ReadCharBytes = pos
End Function

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

Private Function ReadBuffer(ByRef Buffer As Variant, ByRef Index As Variant, ByRef Count As Variant) As Long
    Dim ElemIndex As Long
    ElemIndex = GetOptionalLong(Index, 0)
    
    Dim ElemCount As Long
    ElemCount = GetOptionalLong(Count, 0)
    
    Dim Bytes() As Byte
    Dim Chars() As Integer

    On Error GoTo errTrap
    Select Case VarType(Buffer)
        Case vbByteArray
            SAPtr(Bytes) = GetArrayPointer(Buffer, True)
            ReadBuffer = mStream.ReadBlock(Bytes, ElemIndex, ElemCount)
        Case vbIntegerArray
            SAPtr(Chars) = GetArrayPointer(Buffer, True)
            ReadBuffer = ReadCharBytes(Chars, ElemIndex, ElemCount)
        Case Else
            On Error GoTo 0
            Throw Cor.NewArgumentException("A Byte or Integer array is required.", "Buffer")
    End Select

errTrap:
    SAPtr(Bytes) = 0
    SAPtr(Chars) = 0

    Dim ex As Exception
    If Catch(ex) Then Throw ex
End Function

Private Function ReadOneChar() As Long
    Call VerifyIsOpen
    If ReadCharBytes(mOneChar, 0, 1) = 0 Then
        ReadOneChar = -1
    Else
        AsWord(ReadOneChar) = mOneChar(0)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    Call EnsureCapacity(DEF_CAPACITY)
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