VB、VBS 、ASP 的 UTF-8 base64 實現

    先前一直在用的Base64編碼（https://blog.csdn.net/jessezappy/article/details/53561739?utm_source=blogxgwz5），一切正常，這幾天有個項目需要用 UTF-8 編碼 base64 ，隨即試了一下，發現結果不同，檢查才發現，原 base64 編碼使用的是 unicode(GB2312) 數據進行編碼的，於是找了個字符串 unicode(GB2312) 轉 UTF-8 的函數改造了一下，重新打造了個 VB 的 base84(utf-8)，經測試（https://tool.oschina.net/encrypt?type=3） 工作正確，代碼如下：

Public Function UB64EnArr(pasStr, map) '編碼MD5的文本型十六進制串數值內容,例：E4B8AD  -----20200524改合
    Dim max, idx, i, L, mAllByteIn()
    L = Len(pasStr) / 2 - 1
    ReDim mAllByteIn(L)
    For i = 0 To L
        mAllByteIn(i) = CByte("&H" & Mid(pasStr, i * 2 + 1, 2))
    Next
    UB64EnArr = UB64En(mAllByteIn, map)
End Function

Public Function UB64En(mAllByteIn, map) '編碼去除 unicode 空 0 字符串byte字節數組 -----20200524改合
    Dim max, idx, Base64EncMap(64), BASE_64_MAP_INIT, i, L
    Dim ret, ndx, by3
    Dim first, second, third
    Dim inLangth
    'On Error Resume Next  '---------防止非法字串
    UB64En = ""
    L = UBound(mAllByteIn)
    If (L > 1) Then
        Select Case Len(map) '---20200509改
            Case 0  '標準Base64碼錶
                BASE_64_MAP_INIT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
            Case 1  '自定義碼錶1
                BASE_64_MAP_INIT ="略，請自行設置" '---web不能用 = +號,改爲用 [ _ 代替'
            Case 2  '標準UUE碼錶
                BASE_64_MAP_INIT = "`!" & """" & "#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_~"
            Case Else  '直接傳入自定義碼錶
                BASE_64_MAP_INIT = map
        End Select
        max = Len(BASE_64_MAP_INIT)
        For idx = 0 To max - 1
            Base64EncMap(idx) = Asc(Mid(BASE_64_MAP_INIT, idx + 1, 1))
        Next
        inLangth = UBound(mAllByteIn) + 1
        by3 = (inLangth \ 3) * 3
        ndx = 1
        Do While ndx <= by3
            first = mAllByteIn(ndx - 1)
            second = mAllByteIn(ndx + 0)
            third = mAllByteIn(ndx + 1)
            ret = ret & Chr(Base64EncMap((first \ 4) And 63))
            ret = ret & Chr(Base64EncMap(((first * 16) And 48) + ((second \ 16) And 15)))
            ret = ret & Chr(Base64EncMap(((second * 4) And 60) + ((third \ 64) And 3)))
            ret = ret & Chr(Base64EncMap(third And 63))
            ndx = ndx + 3
        Loop
        If by3 < inLangth Then
            first = mAllByteIn(ndx - 1)
            ret = ret & Chr(Base64EncMap((first \ 4) And 63))
            If (inLangth Mod 3) = 2 Then
                second = mAllByteIn(ndx + 0)
                ret = ret & Chr(Base64EncMap(((first * 16) And 48) + ((second \ 16) And 15)))
                ret = ret & Chr(Base64EncMap(((second * 4) And 60))) & Chr(Base64EncMap(UBound(Base64EncMap)))
            Else
                ret = ret & Chr(Base64EncMap((first * 16) And 48))
                ret = ret & Chr(Base64EncMap(UBound(Base64EncMap))) & Chr(Base64EncMap(UBound(Base64EncMap)))
            End If
        End If
        UB64En = ret
    Else
        UB64En = ""
    End If
End Function

Public Function UB64EnStr(pasStr, map, codepage) '編碼普通字符串 加入編碼類型設置base64_utf8,默認爲GB2312 -----20200524改合
    Dim L, mAllByteIn
    'On Error Resume Next  '---------防止非法字串
    UB64EnStr = ""
    L = Len(pasStr) - 1
    If (L > 1) Then
        If UCase(codepage) = "UTF-8" Then
            UB64EnStr = UB64EnArr(str2UTF8(pasStr), map)
        Else
            mAllByteIn = str2arr(pasStr)
            UB64EnStr = UB64En(mAllByteIn, map)
        End If
    Else
        UB64EnStr = ""
    End If
End Function

Public Function str2UTF8(szInput) '只返回十六進制文本串 -----20200524改合
    Dim wch, uch, szRet
    Dim x, i
    Dim nAsc, nAsc2, nAsc3, s2b()
    '如果輸入參數爲空，則退出函數
    If szInput = "" Then
        str2UTF8 = szInput
        Exit Function
    End If
    '開始轉換
    For x = 1 To Len(szInput)
        '利用mid函數分拆GB編碼文字
        wch = Mid(szInput, x, 1)
        '利用ascW函數返回每一個GB編碼文字的Unicode字符代碼
        '注：asc函數返回的是ANSI 字符代碼，注意區別
        nAsc = AscW(wch)
        If nAsc < 0 Then
            nAsc = nAsc + 65536
        End If
 
        If (nAsc And &HFF80) = 0 Then
            szRet = szRet & Right("00" & Hex(Asc(wch)), 2)
        Else
            If (nAsc And &HF000) = 0 Then
                uch = Hex(((nAsc \ 64)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            Else
                'GB編碼文字的Unicode字符代碼在0800 - FFFF之間採用三字節模版 ， 2 ^ 12=4096 ， 2 ^ 6=64
                uch = Hex((nAsc \ 4096) Or &HE0) & _
                      Hex((nAsc \ 64) And &H3F Or &H80) & _
                      Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            End If
        End If
    Next
    '---------翻譯爲byte數組
'    ReDim s2b(Len(szRet) / 2 - 1)
'    For i = 1 To Len(szRet) Step 2
'        s2b((i - 1) / 2) = CByte("&H" & Mid(szRet, i, 2))
'    Next
    str2UTF8 = szRet
End Function

Public Function str2arr(varstr) '把普通字符串轉成二進制數組函數
    Dim i, varlow, varhigh, varasc, varchar, k
    Dim s2b() 'As Byte
    'str2bin = ""
    For i = 0 To Len(varstr) - 1
        varchar = Mid(varstr, i + 1, 1)
        varasc = Asc(varchar)
        ' asc對中文字符求出來的值可能爲負數，
        ' 加上65536就可求出它的無符號數值
        ' -1在機器內是用補碼錶示的0xffff,
        ' 其無符號值爲65535,65535=-1+65536
        ' 其他負數依次類推。
        If varasc < 0 Then
            varasc = varasc + 65535
        End If
       '對中文的處理：把雙字節低位和高位分開
        If varasc > 255 Then
            varlow = Left(Hex(Asc(varchar)), 2)
            varhigh = Right(Hex(Asc(varchar)), 2)
            'str2bin = str2bin & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
            If i = 0 Then
                ReDim s2b(1)
                k = 0
                s2b(k) = CByte("&H" & varlow) '強制轉換爲字節，下同
                s2b(k + 1) = CByte("&H" & varhigh)
                k = 1
            Else
                ReDim Preserve s2b(k + 2)
                s2b(k + 1) = CByte("&H" & varlow)
                s2b(k + 2) = CByte("&H" & varhigh)
                k = k + 2
            End If
        Else
            'str2bin = str2bin & ChrB(AscB(varchar))
            If i = 0 Then
                ReDim s2b(0)
                k = 0
                s2b(k) = Asc(varchar)
            Else
                ReDim Preserve s2b(k + 1)
                s2b(k + 1) = Asc(varchar)
                k = k + 1
            End If
        End If
    Next
    str2arr = s2b
End Function

使用範例：

Sub testa()
    Dim a, d
    a = "123中文，？αabc"
    d = UB64EnStr(a, "", "utf-8") '  MTIz5Lit5paH77yM77yfzrFhYmM=
    d = UB64EnStr(a, "", " ")     '  MTIz1tDOxKOso7+mwWFiYw==
End Sub

其實和以前使用的變化僅僅是編碼操作使用的字節數組進行了 UTF-8 編碼轉換而已。

以上代碼以去除 AS 標識，可直接用於 VB6、VBS、ASP、VBA

此記！