0

I have the following Problem:

I have a byte-representation of a value and I want to Base64-Encode this Byte-value like in the screenshot below.

Here is the code I tried. It works, but I didn't get the output I expected. The output from the function is: AAB/AQatAQIBAA==

But I expected: AAECAa0GAX8AAA==

How can I do that in VBA or is that even possible?

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

Screenshot

Screenshot

Community
  • 1
  • 1
Ma Thias
  • 27
  • 1
  • 5

1 Answers1

0

Your issue is not with the Base64 encoding but with bin2Byte. It doesn't parse correctly the bits represented in the input string.

Use this function instead to get the bytes from the string:

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
michael
  • 929
  • 6
  • 19