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.
Leave a Reply