utf7encoding.cls

VB 加密----------能够加密解密控件

' Decodes a set of bytes into the supplied Integer array.
'
' @param Bytes The set of bytes to be decoded into characters.
' @param ByteIndex The index of the first byte to begin decoding from.
' @param ByteCount The number of bytes to be used in decoding.
' @param Chars The destination character array for the decoded bytes.
' @param CharIndex The first index to begin storing decoded bytes in <i>Chars</i>.
' @return The number of characters decoded from the array of bytes.
' @remarks The <i>Chars</i> array must be large enough to handle all the bytes that will
' be decoded. To ensure the <i>Chars</i> array is large enough, use either GetCharCount or
' GetMaxCharCount to determine a size that will hold the decoded bytes.
'
Public Function GetCharsEx(ByRef Bytes() As Byte, ByVal ByteIndex As Long, ByVal ByteCount As Long, ByRef Chars() As Integer, ByVal CharIndex As Long) As Long
    Dim Result As Long
    Result = VerifyArrayRange(SAPtr(Bytes), ByteIndex, ByteCount)
    If Result <> NO_ERROR Then ThrowArrayRangeException Result, "Bytes", ByteIndex, "ByteIndex", ByteCount, "ByteCount"
    
    GetCharsEx = InternalGetChars(Bytes, ByteIndex, ByteCount, Chars, CharIndex, Nothing)
End Function

''
' Returns the maximum number of characters than can be decoded from the number of bytes specified.
'
' @param ByteCount The number of bytes to be decoded.
' @return The maximum number of characters that can be decoded from the specified number of bytes.
'
Public Function GetMaxCharCount(ByVal ByteCount As Long) As Long
    If ByteCount < 0 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "ByteCount", ByteCount)
        
    GetMaxCharCount = ByteCount
End Function

''
' Returns the maximum number of bytes that can be created from a specific number of characters.
'
' @param CharCount The number of characters to be encoded.
' @return The maximum number of bytes that can be generated from the specified number of characters.
'
Public Function GetMaxByteCount(ByVal CharCount As Long) As Long
    If CharCount < 0 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "CharCount", CharCount)
    
    GetMaxByteCount = 2 + (-(Int(-((CharCount * 16) / 6))))
End Function

''
' Returns an array of bytes that represents this encoding.
'
' @return A byte array containg the bytes to be used to identify this encoding type.
' @remarks <p>There is no identifier for UTF7 so an empty array is returned.</p>
'
Public Function GetPreamble() As Byte()
    GetPreamble = Cor.NewBytes()
End Function

''
' Returns an encoder that maintains state.
'
' @return The stateful encoder.
' @remarks Unlike UTF7Encoding, the encoder maintains state between encoding calls. This allows
' for a set of characters to be split up but still be encoded as a single set of characters. This
' will allow Modified Base64 encoding to continue between encoding calls.
'
Public Function GetEncoder() As Encoder
    Dim Ret As New UTF7Encoder
    Call Ret.Init(Me)
    Set GetEncoder = Ret
End Function

''
' Returns a decoder that maintains state.
'
' @return The stateful decoder.
' @remarks Unlike UTF8Encoding, the decoder maintains state between decoding calls. this allows
' for a sequence of bytes to not have to be in the same call in order to be decoded to the
' representive character. All characters other than directly encodable characters are encoded
' in a Modified Base64 encoding, which can be require 3 bytes to decode to a single character.
' This decoder allows the Base64 encoded byte set to be decoded across multiple calls and still
' be decoded as a single set of bytes. A multi-byte encoded characters does not need to be in
' the same call in order to be decoded properly.
'
Public Function GetDecoder() As Decoder
    Dim Ret As New UTF7Decoder
    Call Ret.Init(Me)
    Set GetDecoder = Ret
End Function

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

''
' 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.
Public Function Equals(ByRef Value As Variant) As Boolean
    If IsObject(Value) Then
        If Value Is Nothing Then Exit Function
        
        If TypeOf Value Is UTF7Encoding Then
            Dim en As UTF7Encoding
            Set en = Value
            Equals = (en.AllowOptionals = mAllowOptionals)
        End If
    End If
End Function

''
' Returns a pseudo-unique number identifying this instance.
'
' @return Pseudo-unique number identifying this instance.
Public Function GetHashCode() As Long
    GetHashCode = CODE_PAGE Or CLng(IIf(mAllowOptionals, &H80000000, 0))
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByVal AllowOptionals As Boolean)
    Dim i As Long
    
    If AllowOptionals Then
        For i = 1 To 20
            mDirectlyEncodable(Choose(i, 33, 34, 35, 36, 37, 38, 42, 59, 60, 61, 62, 64, 91, 93, 94, 95, 96, 123, 124, 125)) = True
        Next i
    End If
    mAllowOptionals = AllowOptionals
End Sub

Friend Property Get AllowOptionals() As Boolean
    AllowOptionals = mAllowOptionals
End Property

Friend Function InternalGetBytes(ByRef Chars() As Integer, ByVal Index As Long, ByVal Count As Long, ByRef Bytes() As Byte, ByVal ByteIndex As Long, ByRef Encoder As UTF7Encoder) As Long
    Dim Bits As Long
    Dim BitCount As Long
    Dim maxCharIndex As Long
    Dim MaxByteIndex As Long
    Dim Ch As Long
    Dim ByteStartIndex As Long
    Dim directlyEncodable As Boolean
    
    If cArray.IsNull(Bytes) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "Bytes")
    If ByteIndex < LBound(Bytes) Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_LBound), "ByteIndex", ByteIndex)
    
    If Not Encoder Is Nothing Then
        With Encoder
            Bits = .Bits
            BitCount = .BitCount
        End With
    Else
        BitCount = -1
    End If
    
    ByteStartIndex = ByteIndex
    maxCharIndex = Index + Count - 1
    MaxByteIndex = UBound(Bytes)
    Do While Index <= maxCharIndex
        AsWord(Ch) = Chars(Index)
        directlyEncodable = False
        If Ch < &H80 Then
            If mDirectlyEncodable(Ch) Then
                If BitCount >= 0 Then
                    If BitCount > 0 Then
                        If ByteIndex > MaxByteIndex Then Call SmallBufferError("Bytes")
                        Bytes(ByteIndex) = Base64Bytes(Helper.ShiftLeft(Bits, 6 - BitCount) And &H3F)
                        ByteIndex = ByteIndex + 1
                    End If
                    If ByteIndex > MaxByteIndex Then Call SmallBufferError("Bytes")
                    Bytes(ByteIndex) = vbMinus
                    ByteIndex = ByteIndex + 1
                End If
                If ByteIndex > MaxByteIndex Then Call SmallBufferError("Bytes")
                Bytes(ByteIndex) = Ch
                ByteIndex = ByteIndex + 1
                BitCount = -1
                directlyEncodable = True
            End If
        End If
        If Not directlyEncodable Then
            If Ch = vbPlus And BitCount < 0 Then
                If ByteIndex > MaxByteIndex Then Call SmallBufferError("Bytes")
                Bytes(ByteIndex) = vbPlus
                Bytes(ByteIndex + 1) = vbMinus
                ByteIndex = ByteIndex + 2
            Else
                If BitCount < 0 Then
                    If ByteIndex > MaxByteIndex Then Call SmallBufferError("Bytes")
                    Bytes(ByteIndex) = vbPlus
                    ByteIndex = ByteIndex + 1
                    BitCount = 0
                End If
                Bits = (Bits * &H10000) Or Ch
                BitCount = BitCount + 16
                Do While BitCount >= 6
                    BitCount = BitCount - 6
                    If ByteIndex > MaxByteIndex Then Call SmallBufferError("Bytes")
                    Bytes(ByteIndex) = Base64Bytes(Helper.ShiftRight(Bits, BitCount) And &H3F)
                    ByteIndex = ByteIndex + 1
                Loop
                Bits = Bits And (Powers(BitCount) - 1)
            End If
        End If
        Index = Index + 1
    Loop
    
    Dim Flush As Boolean
    If Encoder Is Nothing Then
        Flush = True
    Else
        Flush = Encoder.Flush
    End If
    
    If Flush And (BitCount >= 0) Then
        If BitCount > 0 Then
            If ByteIndex > MaxByteIndex Then _
                Throw Cor.NewArgumentException("Bytes conversion buffer is too small.", "Bytes")
            
            Bytes(ByteIndex) = Base64Bytes(Helper.ShiftLeft(Bits, 6 - BitCount) And &H3F)
            ByteIndex = ByteIndex + 1
        End If
        If ByteIndex > MaxByteIndex Then _
            Throw Cor.NewArgumentException("Bytes conversion buffer is too small.", "Bytes")
        
        Bytes(ByteIndex) = vbMinus
        ByteIndex = ByteIndex + 1
        BitCount = -1
    End If
    
    If Not Encoder Is Nothing Then
        With Encoder
            .Bits = Bits
            .BitCount = BitCount
        End With
    End If
    
    InternalGetBytes = ByteIndex - ByteStartIndex
End Function

Friend Function InternalGetByteCount(ByRef Chars() As Integer, ByVal Index As Long, ByVal Count As Long, ByRef Encoder As UTF7Encoder) As Long
    Dim BitCount As Long
    Dim maxCharIndex As Long
    Dim Ch As Long
    Dim directlyEncodable As Boolean
    Dim ByteIndex As Long
    
    If Not Encoder Is Nothing Then
        BitCount = Encoder.BitCount
    Else
        BitCount = -1
    End If
    
    maxCharIndex = Index + Count - 1
    Do While Index <= maxCharIndex
        AsWord(Ch) = Chars(Index)
        directlyEncodable = False
        If Ch < &H80 Then
            If mDirectlyEncodable(Ch) Then
                If BitCount >= 0 Then
                    If BitCount > 0 Then ByteIndex = ByteIndex + 1
                    ByteIndex = ByteIndex + 1
                End If
                ByteIndex = ByteIndex + 1
                BitCount = -1
                directlyEncodable = True
            End If
        End If
        If Not directlyEncodable Then
            If Ch = vbPlus And BitCount < 0 Then
                ByteIndex = ByteIndex + 2
            Else
                If BitCount < 0 Then
                    ByteIndex = ByteIndex + 1
                    BitCount = 0
                End If
                BitCount = BitCount + 16
                Do While BitCount >= 6
                    BitCount = BitCount - 6
                    ByteIndex = ByteIndex + 1
                Loop
            End If
        End If
        Index = Index + 1
    Loop
    
    Dim Flush As Boolean
    If Encoder Is Nothing Then
        Flush = True
    Else
        Flush = Encoder.Flush
    End If
    
    If Flush And (BitCount >= 0) Then
        If BitCount > 0 Then
            ByteIndex = ByteIndex + 1
        End If
        ByteIndex = ByteIndex + 1
        BitCount = -1
    End If
    
    InternalGetByteCount = ByteIndex