[RESOLVED] hex to based64 conversion gives different result from online tools

[softcrewtech]

Need an urget help.
I have hex values that need to be converted to based64. I used the below code from this thread
https://www.vbforums.com/showthread....ase64-Encoding
but it gives me different results when I convert my hex via
https://base64.guru/converter/encode/hex

For example, my hex value is
010C426F6273205265636F726473020F3331303132323339333530303030330314323032322D30342D32355431353A33303A 30305A0407313030302E303005063135302E3030

From vbforums function from above link, I got this result
MDEwQzQyNkY2MjczMjA1MjY1NjM2RjcyNjQ3MzAyMEYzMzMxMzAzMTMyMzIzMzM5
MzMzNTMwMzAzMDMwMzMwMzE0MzIzMDMyMzIyRDMwMzQyRDMyMzU1NDMxMzUzQTMz
MzAzQTMwMzA1QTA0MDczMTMwMzAzMDJFMzAzMDA1MDYzMTM1MzAyRTMwMzA=

But in https://base64.guru/converter/encode/hex, I got this result
AQxCb2JzIFJlY29yZHMCDzMxMDEyMjM5MzUwMDAwMwMUMjAyMi0wNC0yNVQxNTozMDowMFoEBzEwMDAuMDAFBjE1MC4wMA==

Does anyone have an idea on how to achieve the same result as base64.guru generates? thanks a lot.

[dilettante]

It looks like you have taken your "hex" string of Unicode characters then transcoded that into 8-bit ASCII characters then encoded that mess into Base64.

I suspect what you really want is to decode the "hex" characters to binary, i.e. a Byte array, and only then encode that into Base64.

[Elroy]

Just for reference, softcrewtech, the following will take a VB6 (Unicode) string and convert it to a Byte array of ASCII/ANSI characters:

Dim bb() As Byte
Dim s As String
s = "asdf"
bb = StrConv(s, vbFromUnicode)
' And now, that bb Byte array is ASCII/ANSI characters.

And then, if you wanted, you could directly assign that bb Byte array to a String, and it would be a String with ASCII/ANSI characters:

s = bb

Now, you couldn't print that string or put it in a TextBox or any Caption, but it would truly be a string of ASCII/ANSI characters, and you could process it byte-by-byte knowing that ... say, with a Base64 algorithm. It might be better though to just process the Byte array, as that'd be more clear as to what you're doing.

I didn't look at your code, but it seems that's what you may need to do.

[dilettante]

I didn't look at your code, but it seems that's what you may need to do.

As far as I could tell he is doing that already, by hook or by crook.

When I do that I get the same wrong result he does. When I do it right (decode hex to binary first) I get the desired/expected result.

I think the problem is that people don't know what hex is, much less Base64 or even character encodings.

[Elroy]

Also, another question. Why in the world would you Base64 encode a Hex string. Hex is already encoded. Another word for Hex is Base16. And, as such, it's even more transmittable over finicky channels than Base64.

[dilettante]

Well I suspect that web site accepts hex because it is hard to paste the raw binary itself. There is an implicit assumption that you have a clue.

[Elroy]

Well I suspect that web site accepts hex because it is hard to paste the raw binary itself. There is an implicit assumption that you have a clue.

*nods* Good point. They could have had an "upload file" function, but I didn't look.

[softcrewtech]

Thanks to all.
I came up with the following solution based on your suggestions and ideas. Please suggest making this better. It's already working from my side.
I added a utf8 conversion from a string as part of my requirement.

Private Sub cmdGetBased64_Click()
Dim bb() As Byte
Dim ss As String
Dim strname As String

strname = "Example Text"
ss = bv_HexFromBytesSp(ConvertStringToUtf8Bytes(strname))
bb = HexBytes(ss)
Debug.Print GetBase64String(bb)
End Sub

'Microsoft ActiveX data Objects 2.5 Library
Public Function ConvertStringToUtf8Bytes(ByRef strText As String) As Byte()
    Dim objStream As ADODB.Stream
    Dim data() As Byte
   
    ' init stream
    Set objStream = New ADODB.Stream
    objStream.Charset = "utf-8"
    objStream.Mode = adModeReadWrite
    objStream.Type = adTypeText
    objStream.Open
   
    ' write bytes into stream
    objStream.WriteText strText
    objStream.Flush
   
    ' rewind stream and read text
    objStream.Position = 0
    objStream.Type = adTypeBinary
    objStream.Read 3
    data = objStream.Read()
   
    ' close up and return
    objStream.Close
    ConvertStringToUtf8Bytes = data
End Function

Public Function bv_HexFromBytesSp(aBytes() As Byte) As String
    Dim i As Long

    If Not IsArray(aBytes) Then
        Exit Function
    End If
    
    For i = LBound(aBytes) To UBound(aBytes)
        'If (i > 0) Then bv_HexFromBytesSp = bv_HexFromBytesSp & " "
        If (i > 0) Then bv_HexFromBytesSp = bv_HexFromBytesSp
        If aBytes(i) < 16 Then
            bv_HexFromBytesSp = bv_HexFromBytesSp & "0" & Hex(aBytes(i))
        Else
            bv_HexFromBytesSp = bv_HexFromBytesSp & Hex(aBytes(i))
        End If
    Next
    
End Function

Public Function GetBase64String(ByRef data() As Byte) As String

    Dim doc As DOMDocument
    Dim root As IXMLDOMElement

    Set doc = New DOMDocument
    Set root = doc.createElement("encode")
    root.dataType = "bin.base64"
    root.nodeTypedValue = data

    GetBase64String = root.Text

End Function

[couttsj]

Without using the class:

Option Explicit

Private Declare Function CryptBinaryToString Lib "Crypt32.dll" Alias "CryptBinaryToStringW" (ByRef pbBinary As Byte, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long

Private Function Base64Encode(bData() As Byte) As String
    Const CRYPT_STRING_BASE64 As Long = 1
    Dim lLen As Long
    'Determine Base64 output String length required.
    If CryptBinaryToString(bData(0), GetbSize(bData), CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen) = 0 Then
        Debug.Print Error(Err.LastDllError)
    End If
    'Convert binary to Base64.
    Base64Encode = String$(lLen - 1, Chr$(0))
    If CryptBinaryToString(bData(0), GetbSize(bData), CRYPT_STRING_BASE64, StrPtr(Base64Encode), lLen) = 0 Then
        Debug.Print Error(Err.LastDllError)
    End If
End Function

Private Sub DebugPrintByte(sDescr As String, bArray() As Byte)
    Dim lPtr As Long
    Debug.Print sDescr & ":"
    For lPtr = 0 To UBound(bArray)
        Debug.Print Right$("0" & Hex$(bArray(lPtr)), 2) & " ";
        If (lPtr + 1) Mod 16 = 0 Then Debug.Print
    Next lPtr
    Debug.Print
End Sub

Private Function GetbSize(bArray() As Byte) As Long
    On Error GoTo GetSizeErr
    GetbSize = UBound(bArray) + 1
    Exit Function
GetSizeErr:
    GetbSize = 0
End Function

Private Function HexToByte(HexStr As String) As Byte()
    Dim lLen As Long
    Dim lPntr As Long
    Dim bTmp() As Byte
    Dim bHex() As Byte
    If Len(HexStr) > 1 Then
        lLen = Len(HexStr) / 2
        ReDim bHex(lLen - 1)
        For lPntr = 0 To UBound(bHex)
            bHex(lPntr) = Val("&H" & Mid$(HexStr, lPntr * 2 + 1, 2))
        Next lPntr
        HexToByte = bHex
    Else
        bHex = bTmp
    End If
End Function

Private Sub Command1_Click()
    Dim sHex As String
    Dim sBase64 As String
    Dim bTmp() As Byte
    sHex = "010C426F6273205265636F726473020F33313031" _
         & "32323339333530303030330314323032322D3034" _
         & "2D32355431353A33303A30305A0407313030302E" _
         & "303005063135302E3030"
    bTmp = HexToByte(sHex)
    DebugPrintByte "Sample", bTmp
    sBase64 = Base64Encode(bTmp)
    Debug.Print sBase64
End Sub

To convert Unicode string to byte I use:

Option Explicit

Private Const CP_UTF8 = 65001
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Private Function GetbSize(bArray() As Byte) As Long
    On Error GoTo GetSizeErr
    GetbSize = UBound(bArray) + 1
    Exit Function
GetSizeErr:
    GetbSize = 0
End Function

Public Function StrToUtf8(strInput As String) As Byte()
    Dim nBytes As Long
    Dim abBuffer() As Byte
    If Len(strInput) < 1 Then Exit Function
    ' Get length in bytes *including* terminating null
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, 0&, 0&, 0&, 0&)
    ' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
    ReDim abBuffer(nBytes - 2)  ' NB ReDim with one less byte than you need
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
    StrToUtf8 = abBuffer
End Function

Public Function Utf8ToStr(abUtf8Array() As Byte) As String
    Dim nBytes As Long
    Dim nChars As Long
    Dim strOut As String
    ' Catch uninitialized input array
    nBytes = GetbSize(abUtf8Array)
    If nBytes <= 0 Then Exit Function
    ' Get number of characters in output string
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, 0&, 0&)
    ' Dimension output buffer to receive string
    strOut = String(nChars, 0)
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, StrPtr(strOut), nChars)
    Utf8ToStr = Replace(strOut, Chr$(0), "") 'Remove Null terminating characters
End Function

J.A. Coutts

[dilettante]

This thread just gets sillier and sillier.

Look at the set of characters used in Base64 encoding. They are intentionally ASCII characters, and those are the same values when encoded as UTF-8 or ANSI/DBCS. So if you really want UTF-8 (why?) you can just use StrConv() and call it good. Or you could use the ANSI-output CryptBinaryToStringA() and skip the transcoding step.

It's still hard to imagine how you would have a string of hex digits in your program in the first place. It could happen, but it would sure be odd.

[softcrewtech]

This thread just gets sillier and sillier.

Look at the set of characters used in Base64 encoding. They are intentionally ASCII characters, and those are the same values when encoded as UTF-8 or ANSI/DBCS. So if you really want UTF-8 (why?) you can just use StrConv() and call it good. Or you could use the ANSI-output CryptBinaryToStringA() and skip the transcoding step.

It's still hard to imagine how you would have a string of hex digits in your program in the first place. It could happen, but it would sure be odd.

Thanks for the idea.
But sometimes the text to be encoded as based64 is multilanguage(English, Arabic).
Each must be stored in 1 byte.
They suggested converting the string first to utf8 to handle the encoding.

[softcrewtech]

Without using the class:

Option Explicit

Private Declare Function CryptBinaryToString Lib "Crypt32.dll" Alias "CryptBinaryToStringW" (ByRef pbBinary As Byte, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long

Private Function Base64Encode(bData() As Byte) As String
    Const CRYPT_STRING_BASE64 As Long = 1
    Dim lLen As Long
    'Determine Base64 output String length required.
    If CryptBinaryToString(bData(0), GetbSize(bData), CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen) = 0 Then
        Debug.Print Error(Err.LastDllError)
    End If
    'Convert binary to Base64.
    Base64Encode = String$(lLen - 1, Chr$(0))
    If CryptBinaryToString(bData(0), GetbSize(bData), CRYPT_STRING_BASE64, StrPtr(Base64Encode), lLen) = 0 Then
        Debug.Print Error(Err.LastDllError)
    End If
End Function

Private Sub DebugPrintByte(sDescr As String, bArray() As Byte)
    Dim lPtr As Long
    Debug.Print sDescr & ":"
    For lPtr = 0 To UBound(bArray)
        Debug.Print Right$("0" & Hex$(bArray(lPtr)), 2) & " ";
        If (lPtr + 1) Mod 16 = 0 Then Debug.Print
    Next lPtr
    Debug.Print
End Sub

Private Function GetbSize(bArray() As Byte) As Long
    On Error GoTo GetSizeErr
    GetbSize = UBound(bArray) + 1
    Exit Function
GetSizeErr:
    GetbSize = 0
End Function

Private Function HexToByte(HexStr As String) As Byte()
    Dim lLen As Long
    Dim lPntr As Long
    Dim bTmp() As Byte
    Dim bHex() As Byte
    If Len(HexStr) > 1 Then
        lLen = Len(HexStr) / 2
        ReDim bHex(lLen - 1)
        For lPntr = 0 To UBound(bHex)
            bHex(lPntr) = Val("&H" & Mid$(HexStr, lPntr * 2 + 1, 2))
        Next lPntr
        HexToByte = bHex
    Else
        bHex = bTmp
    End If
End Function

Private Sub Command1_Click()
    Dim sHex As String
    Dim sBase64 As String
    Dim bTmp() As Byte
    sHex = "010C426F6273205265636F726473020F33313031" _
         & "32323339333530303030330314323032322D3034" _
         & "2D32355431353A33303A30305A0407313030302E" _
         & "303005063135302E3030"
    bTmp = HexToByte(sHex)
    DebugPrintByte "Sample", bTmp
    sBase64 = Base64Encode(bTmp)
    Debug.Print sBase64
End Sub

To convert Unicode string to byte I use:

Option Explicit

Private Const CP_UTF8 = 65001
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Private Function GetbSize(bArray() As Byte) As Long
    On Error GoTo GetSizeErr
    GetbSize = UBound(bArray) + 1
    Exit Function
GetSizeErr:
    GetbSize = 0
End Function

Public Function StrToUtf8(strInput As String) As Byte()
    Dim nBytes As Long
    Dim abBuffer() As Byte
    If Len(strInput) < 1 Then Exit Function
    ' Get length in bytes *including* terminating null
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, 0&, 0&, 0&, 0&)
    ' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
    ReDim abBuffer(nBytes - 2)  ' NB ReDim with one less byte than you need
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
    StrToUtf8 = abBuffer
End Function

Public Function Utf8ToStr(abUtf8Array() As Byte) As String
    Dim nBytes As Long
    Dim nChars As Long
    Dim strOut As String
    ' Catch uninitialized input array
    nBytes = GetbSize(abUtf8Array)
    If nBytes <= 0 Then Exit Function
    ' Get number of characters in output string
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, 0&, 0&)
    ' Dimension output buffer to receive string
    strOut = String(nChars, 0)
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, StrPtr(strOut), nChars)
    Utf8ToStr = Replace(strOut, Chr$(0), "") 'Remove Null terminating characters
End Function

J.A. Coutts

thank you for sharing. I sued some of it.

[yngent]

Dear softcrewtech ,

By using the above code, i manage to get the desired result in English string, but with Arabic , results error.

Can you please show us with the arabic text , how to convert to hex and then to encode64.

I appreciate if you help me out.

Thanks.