Base64 conversion

[mblumberg]

I am needing to take a MD5 output and convert to Base64. But, the output is Hex in a String, and thus all coverters I have found output the wrong result.

The MD5 output I need to covert is "83996150544BBCFFA8AD10089C7D3B2B"

The base64 I am looking for is "g5lhUFRLvP+orRAInH07Kw=="

NOT: "ODM5OTYxNTA1NDRiYmNmZmE4YWQxMDA4OWM3ZDNiMmI"

Can anyone help? Thanks!

[p45cal]

Adapted from http://www.rlmueller.net/Programs/HexToBase64.txt and http://www.rlmueller.net/Base64.htm where there is this:
[vba]' HexToBase64.vbs
' VBScript program to convert a hex string into a base64 encoded string.
'
' ----------------------------------------------------------------------
' Copyright (c) 2010 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - January 7, 2010
'
' Syntax:
' cscript //nologo HexToBase64.vbs <hex string>
' where:
' <hex string> is a string of hexadecimal bytes. Each byte is
' two hexadecimal digits.
' If no parameter is supplied, the program will prompt.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.[/vba]
I made a few changes for it to work in Excel vba.

Here's the function on its own:[vba]Function HexToBase64(strHex)
' Function to convert a hex string into a base64 encoded string.
Dim lngValue, lngTemp, lngChar, intLen, k, j, strWord, str64, intTerm
Const B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

intLen = Len(strHex)

' Pad with zeros to multiple of 3 bytes.
intTerm = intLen Mod 6
If (intTerm = 4) Then
strHex = strHex & "00"
intLen = intLen + 2
End If
If (intTerm = 2) Then
strHex = strHex & "0000"
intLen = intLen + 4
End If

' Parse into groups of 3 hex bytes.
j = 0
strWord = ""
HexToBase64 = ""
For k = 1 To intLen Step 2
j = j + 1
strWord = strWord & Mid(strHex, k, 2)
If (j = 3) Then
' Convert 3 8-bit bytes into 4 6-bit characters.
lngValue = CCur("&H" & strWord)

lngTemp = Fix(lngValue / 64)
lngChar = lngValue - (64 * lngTemp)
str64 = Mid(B64, lngChar + 1, 1)
lngValue = lngTemp

lngTemp = Fix(lngValue / 64)
lngChar = lngValue - (64 * lngTemp)
str64 = Mid(B64, lngChar + 1, 1) & str64
lngValue = lngTemp

lngTemp = Fix(lngValue / 64)
lngChar = lngValue - (64 * lngTemp)
str64 = Mid(B64, lngChar + 1, 1) & str64

str64 = Mid(B64, lngTemp + 1, 1) & str64

HexToBase64 = HexToBase64 & str64
j = 0
strWord = ""
End If
Next
' Account for padding.
If (intTerm = 4) Then HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 1) & "="
If (intTerm = 2) Then HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 2) & "=="
End Function
[/vba] But there is also an optional bit of code which makes a few checks on the input string first, calls the function, and makes it a little more friendly if it's a very long output string (again I've modified it a bit):[vba]Sub CallIt()
Dim strValue, strHexValue, intLen, objRE, objMatches, objMatch, strBase64, Msg

strValue = "83996150544BBCFFA8AD10089C7D3B2B"
If strValue = Empty Then
strValue = InputBox("Enter hexadecimal byte string", "HexToBase")
End If
' Remove allowed byte delimiters.
strHexValue = Replace(strValue, "/", "")
strHexValue = Replace(strHexValue, "\", "")
strHexValue = Replace(strHexValue, "-", "")
strHexValue = Replace(strHexValue, " ", "")
strHexValue = Replace(strHexValue, ",", "")

intLen = Len(strHexValue)
' Validate string.
'Set objRE = New RegExp
Set objRE = CreateObject("vbscript.regexp")
objRE.Pattern = "[A-Fa-f0-9]+"
objRE.Global = True
Set objMatches = objRE.Execute(strHexValue)
If (objMatches.Count <> 1) Then
MsgBox "Invalid hexadecimal string: " & strValue
Exit Sub
End If
For Each objMatch In objMatches
If (objMatch.Length <> intLen) Then
MsgBox "Invalid hexadecimal string: " & strValue
Exit Sub
End If
Next

If (intLen Mod 2 <> 0) Then
MsgBox "Byte string must have two hexadecimal characters per byte: " & strValue
Exit Sub
End If
' Convert hexadecimal string into Base64 characters.
strBase64 = HexToBase64(strHexValue)
' Output Base64 encoded string in lines of 76 characters each.
Msg = Mid(strBase64, 1, 76)
Do Until Len(strBase64) = 0
If (Len(strBase64) > 76) Then
strBase64 = Right(strBase64, Len(strBase64) - 76)
Msg = Msg & vbLf & Mid(strBase64, 1, 76)
Else
Exit Do
End If
Loop
MsgBox Msg
End Sub
[/vba]

[Crocus Crow]

Try the function in the top answer here - http://stackoverflow.com/questions/1...sing-excel-vba
This needs a reference to MS XML v6.0 in the VB editor (Tools -> References).

You will need to convert each hex character pair in your 32-character string to a character byte to create a 16-byte string which you pass to EncodeBase64.

[mblumberg]

p45cal: THANK YOU! I inserted all your code, changed it to a function and then passed my MD5 result to it... worked PERFECTLY! I will now be able to sleep tonight... I still have a long way to go, but one barrier broken down. Thanks!

[Crocus Crow]

Here's the code for my version:

[vba]Sub Test()

Dim MD5Hex As String
Dim MD5Bytes As String
Dim encoded As String
Dim i As Integer

Const Expected = "g5lhUFRLvP+orRAInH07Kw=="

MD5Hex = "83996150544BBCFFA8AD10089C7D3B2B"

'Convert each hex character pair in the 32-character string to a byte to create a 16 byte string

MD5Bytes = ""
For i = 1 To 32 Step 2
MD5Bytes = MD5Bytes & Chr("&H" & Mid(MD5Hex, i, 2))
Next

encoded = XMLEncodeBase64(MD5Bytes)

If encoded = Expected Then
MsgBox "Encoded = " & encoded & vbCrLf & "Expected = " & Expected, Title:="Test Passed"
Else
MsgBox "Encoded = " & encoded & vbCrLf & "Expected = " & Expected, Title:="Test Failed"
End If

End Sub


'http://stackoverflow.com/questions/169907/how-do-i-base64-encode-a-string-efficiently-using-excel-vba

'Free, Easy and Quick Base64 Encoding and Decoding in Visual Basic
'http://www.nonhostile.com/howto-encode-decode-base64-vb6.asp

Public Function XMLEncodeBase64(text As String) As String

If text = "" Then XMLEncodeBase64 = "": Exit Function

Dim arrData() As Byte
arrData = StrConv(text, vbFromUnicode)

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
XMLEncodeBase64 = objNode.text

Set objNode = Nothing
Set objXML = Nothing

End Function[/vba]