Blog of Travis Hydzik

Here are some functions to convert a binary string, to a byte array, to a Base64 string and then back to a byte array and binary string. Run tester to see it in action, enjoy.

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

Private Function decodeBase64(ByVal strData As String) As Byte()
    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.Text = strData
    decodeBase64 = objNode.nodeTypedValue

    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

Function byte2Bin(ByRef bytes() As Byte) As String
    Dim i As Long, j As Long
    Dim bin As String
    For i = 0 To UBound(bytes)
        bin = Space$(8)

        For j = 0 To 7
            If bytes(i) And 2 ^ j Then
                Mid(bin, 8 - j, 1) = "1"
            Else
                'Mid(bin, 8 - j, 1) = "0"
            End If
        Next j

        byte2Bin = bin & byte2Bin
    Next i
    byte2Bin = LTrim$(byte2Bin)
    byte2Bin = Replace(byte2Bin, " ", "0", 1, -1, vbBinaryCompare)
End Function

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

    MsgBox binOut = bin
End Sub

Thanks to Tim Hastings for the Base64 functions.