284
VB6下BASE64轉換
Option ExplicitPrivate 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
最後更新：2017-04-02 00:06:22