utf7encoding.cls

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

End Function

Friend Function InternalGetCharCount(ByRef Bytes() As Byte, ByVal Index As Long, ByVal Count As Long) As Long
    Dim InBase64 As Boolean
    Dim maxindex As Long
    Dim CharCount As Long
    Dim b As Byte
    Dim Bits As Currency
    
    maxindex = Index + Count
    Do While Index < maxindex
        b = Bytes(Index)
        If Not InBase64 Then
            If b = vbPlus Then
                InBase64 = True
            Else
                CharCount = CharCount + 1
            End If
        ElseIf b = vbMinus Then
            If Bytes(Index - 1) = vbPlus Then CharCount = CharCount + 1
            CharCount = CharCount + Int(Bits / 16@)
            Bits = 0@
            InBase64 = False
        Else
            Bits = Bits + 6@
        End If
        Index = Index + 1
    Loop
    
    InternalGetCharCount = Int(Bits / 16@) + CharCount
End Function

Friend Function InternalGetChars(ByRef Bytes() As Byte, ByVal ByteIndex As Long, ByVal ByteCount As Long, ByRef Chars() As Integer, ByVal CharIndex As Long, ByRef Decoder As UTF7Decoder) As Long
    Dim Bits As Long
    Dim BitCount As Long
    Dim b As Byte
    Dim InBase64 As Boolean
    Dim HasPlus As Boolean
    Dim CharStartIndex As Long
    Dim maxCharIndex As Long
    Dim MaxByteIndex As Long
    
    If cArray.IsNull(Chars) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "Chars")
    If CharIndex < LBound(Chars) Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_LBound), "CharIndex", CharIndex)
    
    If Not Decoder Is Nothing Then
        With Decoder
            Bits = .Bits
            BitCount = .BitCount
            InBase64 = .InBase64
            HasPlus = .HasPlus
        End With
    End If
    
    CharStartIndex = CharIndex
    maxCharIndex = UBound(Chars)
    MaxByteIndex = ByteIndex + ByteCount - 1
    Do While ByteIndex <= MaxByteIndex
        b = Bytes(ByteIndex)
        'Debug.Assert b <> 44
        Select Case b
            Case vbMinus
                If HasPlus Then
                    If CharIndex > maxCharIndex Then Call SmallBufferError("Chars")
                    Chars(CharIndex) = vbPlus
                    CharIndex = CharIndex + 1
                ElseIf InBase64 Then
                    BitCount = 0
                    Bits = 0
                    InBase64 = False
                Else
                    If CharIndex > maxCharIndex Then Call SmallBufferError("Chars")
                    Chars(CharIndex) = vbMinus
                    CharIndex = CharIndex + 1
                End If
                HasPlus = False
            Case vbPlus
                If InBase64 Then
                    Bits = (Bits * &H40) Or Base64CharToBits(b)
                    BitCount = BitCount + 6
                    HasPlus = False
                Else
                    Bits = 0
                    BitCount = 0
                    InBase64 = True
                    HasPlus = True
                End If
            Case Is < &H80
                If InBase64 Then
                    If Base64CharToBits(b) >= 0 Then
                        Bits = (Bits * &H40) Or Base64CharToBits(b)
                        BitCount = BitCount + 6
                    Else
                        If CharIndex > maxCharIndex Then Call SmallBufferError("Chars")
                        Chars(CharIndex) = b
                        CharIndex = CharIndex + 1
                        BitCount = 0
                        Bits = 0
                        InBase64 = False
                    End If
                Else
                    If CharIndex > maxCharIndex Then Call SmallBufferError("Chars")
                    Chars(CharIndex) = b
                    CharIndex = CharIndex + 1
                End If
                HasPlus = False
            Case Else
                If CharIndex > maxCharIndex Then Call SmallBufferError("Chars")
                Chars(CharIndex) = b
                CharIndex = CharIndex + 1
                BitCount = 0
                Bits = 0
                InBase64 = False
                HasPlus = False
        End Select
        If BitCount >= 16 Then
            If CharIndex > maxCharIndex Then Call SmallBufferError("Chars")
            Chars(CharIndex) = AsWord(Helper.ShiftRight(Bits, BitCount - 16) And &HFFFF&)
            CharIndex = CharIndex + 1
            BitCount = BitCount - 16
        End If
        ByteIndex = ByteIndex + 1
        Bits = Bits And &HFFFFFF
    Loop
    
    If Not Decoder Is Nothing Then
        With Decoder
            .BitCount = BitCount
            .Bits = Bits
            .HasPlus = HasPlus
            .InBase64 = InBase64
        End With
    End If
    
    InternalGetChars = CharIndex - CharStartIndex
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub SmallBufferError(ByVal ParamName As String)
    Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_SmallConversionBuffer), ParamName)
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    Dim i As Long
    
    ReDim mDirectlyEncodable(0 To 127)
    For i = 0 To 25
        mDirectlyEncodable(65 + i) = True
        mDirectlyEncodable(97 + i) = True
    Next i
    For i = 0 To 9
        mDirectlyEncodable(48 + i) = True
    Next i
    For i = 1 To 13
        mDirectlyEncodable(Choose(i, 9, 10, 13, 32, 39, 40, 41, 44, 45, 46, 47, 58, 63)) = True
    Next i

    With mCharsSA
        .cbElements = 2
        .cDims = 1
    End With
End Sub

Private Sub Class_ReadProperties(PropBag As PropertyBag)
    Call Init(PropBag.ReadProperty("AllowOptionals", False))
End Sub

Private Sub Class_Terminate()
    SAPtr(mChars) = 0
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("AllowOptionals", mAllowOptionals)
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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Encoding Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Property Get Encoding_BodyName() As String
    Encoding_BodyName = BodyName
End Property

Private Property Get Encoding_CodePage() As Long
    Encoding_CodePage = CodePage
End Property

Private Property Get Encoding_EncodingName() As String
    Encoding_EncodingName = EncodingName
End Property

Private Function Encoding_Equals(Value As Variant) As Boolean
    Encoding_Equals = Equals(Value)
End Function

Private Function Encoding_GetByteCount(Chars As Variant, Optional Index As Variant, Optional Count As Variant) As Long
    Encoding_GetByteCount = GetByteCount(Chars, Index, Count)
End Function

Private Function Encoding_GetBytes(Chars As Variant, Optional Index As Variant, Optional Count As Variant) As Byte()
    Encoding_GetBytes = GetBytes(Chars, Index, Count)
End Function

Private Function Encoding_GetBytesEx(Chars As Variant, ByVal CharIndex As Long, ByVal CharCount As Long, Bytes() As Byte, ByVal ByteIndex As Long) As Long
    Encoding_GetBytesEx = GetBytesEx(Chars, CharIndex, CharCount, Bytes, ByteIndex)
End Function

Private Function Encoding_GetCharCount(Bytes() As Byte, Optional Index As Variant, Optional Count As Variant) As Long
    Encoding_GetCharCount = GetCharCount(Bytes, Index, Count)
End Function

Private Function Encoding_GetChars(Bytes() As Byte, Optional Index As Variant, Optional Count As Variant) As Integer()
    Encoding_GetChars = GetChars(Bytes, Index, Count)
End Function

Private Function Encoding_GetCharsEx(Bytes() As Byte, ByVal ByteIndex As Long, ByVal ByteCount As Long, Chars() As Integer, ByVal CharIndex As Long) As Long
    Encoding_GetCharsEx = GetCharsEx(Bytes, ByteIndex, ByteCount, Chars, CharIndex)
End Function

Private Function Encoding_GetDecoder() As Decoder
    Set Encoding_GetDecoder = GetDecoder
End Function

Private Function Encoding_GetEncoder() As Encoder
    Set Encoding_GetEncoder = GetEncoder
End Function

Private Function Encoding_GetHashCode() As Long
    Encoding_GetHashCode = GetHashCode
End Function

Private Function Encoding_GetMaxByteCount(ByVal CharCount As Long) As Long
    Encoding_GetMaxByteCount = GetMaxByteCount(CharCount)
End Function

Private Function Encoding_GetMaxCharCount(ByVal ByteCount As Long) As Long
    Encoding_GetMaxCharCount = GetMaxCharCount(ByteCount)
End Function

Private Function Encoding_GetPreamble() As Byte()
    Encoding_GetPreamble = GetPreamble
End Function

Private Function Encoding_GetString(Bytes() As Byte, Optional Index As Variant, Optional Count As Variant) As String
    Encoding_GetString = GetString(Bytes, Index, Count)
End Function

Private Property Get Encoding_HeaderName() As String
    Encoding_HeaderName = HeaderName
End Property

Private Property Get Encoding_IsBrowserDisplay() As Boolean
    Encoding_IsBrowserDisplay = IsBrowserDisplay
End Property

Private Property Get Encoding_IsBrowserSave() As Boolean
    Encoding_IsBrowserSave = IsBrowserSave
End Property

Private Property Get Encoding_IsMailNewsDisplay() As Boolean
    Encoding_IsMailNewsDisplay = IsMailNewsDisplay
End Property

Private Property Get Encoding_IsMailNewsSave() As Boolean
    Encoding_IsMailNewsSave = IsMailNewsSave
End Property

Private Function Encoding_ToString() As String
    Encoding_ToString = ToString
End Function

Private Property Get Encoding_WebName() As String
    Encoding_WebName = WebName
End Property

Private Property Get Encoding_WindowsCodePage() As Long
    Encoding_WindowsCodePage = WindowsCodePage
End Property

Private Property Get Encoding_IsSingleByte() As Boolean
    Encoding_IsSingleByte = IsSingleByte
End Property