Base64编码VBA中的字节

Question

我有以下问题：

我有一个值的字节表示，我希望Base64-Encode这个字节值，如下面的截图所示。

这是我试过的代码。它有效，但我没有得到我预期的输出。 该函数的输出为：AAB/AQatAQIBAA==

但我希望：AAECAa0GAX8AAA==

我怎么能在VBA中做到这一点，或者甚至可能做到这一点？

Private Function encodeBase64(ByRef arrData() As Byte) As String
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement

Set objXML = New MSXML2.DOMDocument

Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
encodeBase64 = objNode.text

Set objNode = Nothing
Set objXML = Nothing
End Function

Function bin2Byte(ByVal s As String) As Byte()
Dim bitsIn As Long
bitsIn = 8

Dim i As Long
'pad with zeros
If Len(s) Mod bitsIn <> 0 Then
    For i = 1 To bitsIn - Len(s) Mod bitsIn
        s = "0" & s
    Next i
End If

i = Len(s)
Dim bytes() As Byte
Dim byteCount As Long
byteCount = -1
Dim sByte As String
Do While LenB(s) > 0
    byteCount = byteCount + 1
    ReDim Preserve bytes(byteCount)

    sByte = Mid$(s, Len(s) - bitsIn + 1)
    'sByte = Mid$(s, 1, bitsIn)
    For i = 0 To 7 Step 1
        bytes(byteCount) = bytes(byteCount) + CLng(Mid$(sByte, 8 - i, 1)) * 2 ^ i
    Next i
    s = Mid$(s, 1, Len(s) - bitsIn)
    's = Mid$(s, bitsIn + 1)
Loop
bin2Byte = bytes
End Function

Sub tester()
'note we can't add any 0 padding to the test binary string
Dim bin As String
bin = "00000000000000010000001000000001101011010000011000000001011111110000000000000000"
Dim binOut As String
binOut = encodeBase64(bin2Byte(bin))

Debug.Print (binOut)
End Sub

截图

Answer 1

您的问题不在于Base64编码，而在于bin2Byte。它没有正确解析输入字符串中表示的位。

使用此函数来获取字符串中的字节：

Public Function BinStr2Bytes(ByVal str As String) As Byte()
    If Len(str) Mod 8 Then Err.Raise 5, , "Invalid length (needs to be a multiple of 8)"

    Dim bytes() As Byte, i As Long, j As Long
    ReDim bytes(0 To Len(str) \ 8 - 1)

    For i = 1 To Len(str)
      j = (i - 1) \ 8
      bytes(j) = bytes(j) * 2 - (AscW(Mid(str, i, 1)) = 49)
    Next

    BinStr2Bytes = bytes
End Function