请教base64还原?

Option Explicit



Private Const BASE64CHR         As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

Private psBase64Chr(0 To 63)    As String



'從一個經過Base64的字串中解易做图到源字串

Public Function DecodeBase64String(str2Decode As String) As String

    DecodeBase64String = StrConv(DecodeBase64Byte(str2Decode), vbUnicode)

End Function

 

'從一個經過Base64的字串中解易做图到源位元組陣列

Public Function DecodeBase64Byte(str2Decode As String) As Byte()



    Dim lPtr            As Long

    Dim iValue          As Integer

    Dim iLen            As Integer

    Dim iCtr            As Integer

    Dim Bits(1 To 4)    As Byte

    Dim strDecode       As String

    Dim str             As String

    Dim Output()        As Byte

    

    Dim iIndex          As Long



    Dim lFrom As Long

    Dim lTo As Long

    

    InitBase

    

    '//除去回車

    str = Replace(str2Decode, vbCrLf, "")

 

    '//每4個字元一組（4個字元表示3個字）

    For lPtr = 1 To Len(str) Step 4

        iLen = 4

        For iCtr = 0 To 3

            '//查找字元在BASE64字串中的位置

            iValue = InStr(1, BASE64CHR, Mid$(str, lPtr + iCtr, 1), vbBinaryCompare)

            Select Case iValue  'A~Za~z0~9+/

                Case 1 To 64:

                    Bits(iCtr + 1) = iValue - 1

                Case 65         '=

                    iLen = iCtr

                    Exit For

                    '//沒有發現

                Case 0: Exit Function

            End Select

        Next

 

        '//轉換4個6比特數成為3個8比特數

        Bits(1) = Bits(1) * &H4 + (Bits(2) And &H30) \ &H10

        Bits(2) = (Bits(2) And &HF) * &H10 + (Bits(3) And &H3C) \ &H4

        Bits(3) = (Bits(3) And &H3) * &H40 + Bits(4)

 

        '//計算陣列的起始位置

        lFrom = lTo

        lTo = lTo + (iLen - 1) - 1

                

        '//重新定義輸出陣列

        ReDim Preserve Output(0 To lTo)

        

        For iIndex = lFrom To lTo

            Output(iIndex) = Bits(iIndex - lFrom + 1)

        Next

 

        lTo = lTo + 1

        

    Next

    DecodeBase64Byte = Output

End Function

 

'將一個位元組陣列進行Base64編易做图，並返回字串

Public Function EncodeBase64Byte(sValue() As Byte) As String

    Dim lCtr                As Long

    Dim lPtr                As Long

    Dim lLen                As Long

    Dim sEncoded            As String

    Dim Bits8(1 To 3)       As Byte

    Dim Bits6(1 To 4)       As Byte

    

    Dim I As Integer

    

    InitBase

 

    For lCtr = 1 To UBound(sValue) + 1 Step 3

        For I = 1 To 3

            If lCtr + I - 2 <= UBound(sValue) Then

                Bits8(I) = sValue(lCtr + I - 2)

                lLen = 3

            Else

                Bits8(I) = 0

                lLen = lLen - 1

            End If

        Next

 

        '//轉換字串為陣列，然後轉換為4個6位(0-63)

        Bits6(1) = (Bits8(1) And &HFC) \ 4

        Bits6(2) = (Bits8(1) And &H3) * &H10 + (Bits8(2) And &HF0) \ &H10

        Bits6(3) = (Bits8(2) And &HF) * 4 + (Bits8(3) And &HC0) \ &H40

        Bits6(4) = Bits8(3) And &H3F

 

        '//添加4個新字元

        For lPtr = 1 To lLen + 1

            sEncoded = sEncoded & psBase64Chr(Bits6(lPtr))

        Next

    Next

 

    '//不足4位，以=填充

    Select Case lLen + 1

        Case 2: sEncoded = sEncoded & "=="

        Case 3: sEncoded = sEncoded & "="

        Case 4:

    End Select

 

    EncodeBase64Byte = sEncoded

End Function

 



'對字串進行Base64編易做图並返回字串

Public Function EncodeBase64String(str2Encode As String) As String

    Dim sValue()            As Byte

    sValue = StrConv(str2Encode, vbFromUnicode)

    EncodeBase64String = EncodeBase64Byte(sValue)

End Function



Private Sub InitBase()

    Dim iPtr    As Integer

    '初始化 BASE64陣列

    For iPtr = 0 To 63

        psBase64Chr(iPtr) = Mid$(BASE64CHR, iPtr + 1, 1)

    Next

End Sub

补充：VB ,  基础类

上一个：找了很多例子都没用，大侠帮我解决一下闪动托盘托标问题
下一个：怎么给 Text filters 的contains 中加3个条件？