Convert hex string (image) to base64 (for browser rendering) in VBScript - vbscript

Question

I have a script that outputs a .bmp captcha image.
The image is built in hexadecimal, and converted to binary and sent to the browser via response.binaryWrite chrB(CByte(myHexImage)) (as an image mime type = bmp)
I want the option to move away from that (changing mime type, etc) and toward just sending something to the output like this:
data:image/jpeg;base64,/9j/4AAQSkZJRgABAQAAAQABAAD/2 ...
(except that my images are BMP)
Is there a quick and easy way to convert that hex or binary to base64 in vbscript? Here is a snippet of what I have implmented now as described above.
how can I change this so I output, to the screen, valid hex format (which i can then easily convert to base64) or base64 directly?
Dim sBmpEndLine, sBmpInfoHeader, sBmpHeader, sTmpHex
If (m_iBmpWidth Mod 4) <> 0 Then
sBmpEndLine = string((4 - (m_iBmpWidth Mod 4)) * 2, "0")
Else
sBmpEndLine = vbNullString
End If
sBmpInfoHeader = array("28000000", "00000000", "00000000", "0100", "0800", "00000000", "00000000", "120B0000", "120B0000", "00000000", "00000000")
sBmpInfoHeader(1) = formatHex(hex(m_iBmpWidth), 4, 0, True)
sBmpInfoHeader(2) = formatHex(hex(m_iBmpHeight), 4, 0, True)
sBmpInfoHeader(6) = formatHex(hex((m_iBmpHeight * m_iBmpWidth) + (m_iBmpHeight * (len(sBmpEndLine) / 2))), 4, 0, True)
sBmpInfoHeader(9) = formatHex(hex(len(m_sBmpColorMap) / 8), 4, 0, True)
sBmpInfoHeader(10) = sBmpInfoHeader(9)
sBmpHeader = array("424D", "00000000", "0000", "0000", "00000000")
sBmpHeader(1) = formatHex(hex((len(join(sBmpHeader, "")) / 2) + (len(join(sBmpInfoHeader, "")) / 2) + (len(m_sBmpColorMap) / 2) + (m_iBmpHeight * m_iBmpWidth) + (m_iBmpHeight * (len(sBmpEndLine) / 2))), 4, 0, True)
sBmpHeader(4) = formatHex(hex((len(join(sBmpHeader, "")) / 2) + (len(join(sBmpInfoHeader, "")) / 2) + (len(m_sBmpColorMap) / 2)), 4, 0, True)
sendHex(join(sBmpHeader, ""))
sendHex(join(sBmpInfoHeader, ""))
sendHex(m_sBmpColorMap)
For y = m_iBmpHeight To 1 Step -1
For x = 1 To m_iBmpWidth
sTmpHex = m_aBitmap(y, x)
If sTmpHex = vbNullString Then
sendHex(m_sBgColor)
Else
sendHex(sTmpHex)
End If
Next
sendHex(sBmpEndLine)
Next
Response.Flush
And here is the sendHex() function:
Private Sub sendHex(valHex)
Dim iCntHex
For iCntHex = 1 To len(valHex) Step 2
'Response.BinaryWrite chrB(CByte("&H" & mid(valHex, iCntHex, 2)))
response.Write "&H" & mid(valHex, iCntHex, 2)
Next
End Sub

Answer 1

The Microsoft.XMLDOM has built in converters for bin.base64 and bin.hex. I wrote functions that demonstrate how to use this:
Function TextToBinary(text, dataType)
Dim dom
Set dom = CreateObject("Microsoft.XMLDOM")
dom.loadXML("<HELLO/>")
dom.documentElement.nodeTypedValue = text
dom.documentElement.dataType = dataType
TextToBinary = dom.documentElement.nodeTypedValue
End Function
Function BinaryToText(binary, dataType)
Dim dom
Set dom = CreateObject("Microsoft.XMLDOM")
dom.loadXML("<HELLO/>")
dom.documentElement.dataType = dataType
dom.documentElement.nodeTypedValue = binary
dom.documentElement.removeAttribute("dt:dt")
BinaryToText = dom.documentElement.nodeTypedValue
End Function
Function HexToBase64(strHex)
HexToBase64 = BinaryToText(TextToBinary(strHex, "bin.hex"), "bin.base64")
End Function
Function Base64ToHex(strBase64)
Base64ToHex = BinaryToText(TextToBinary(strBase64, "bin.base64"), "bin.hex")
End Function
Here's an example of their usage:
MsgBox HexToBase64("41")
MsgBox Base64ToHex("QQ==")
Also look at the ADODB.Stream as a means of working with binary files. It'll work with these routines.

Answer 2

I was able to get this working. Here is how.
In sendHex, I removed the &H portion, and wrapped my string in hex():
Private Sub sendHex(valHex)
Dim iCntHex
For iCntHex = 1 To len(valHex) Step 2
If len( mid(valHex, iCntHex, 2)) = 1 Then
response.write "0"
end if
response.write mid(valHex, iCntHex, 2)
Next
End Sub
This results in a string output like this (in byte strings of 2 hexidecimal chars):
424d1e050000000000003e00000028000000340000001800000001000
I can then dump that proper hex string into a HEX to base64 function as follows (not written by me, but rather, by Richard Mueller - http://www.rlmueller.net/Base64.htm)
Function HexToBase64(strHex)
' Function to convert a hex string into a base64 encoded string.
' Constant B64 has global scope.
Dim lngValue, lngTemp, lngChar, intLen, k, j, strWord, str64, intTerm
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) & "="
End If
If (intTerm = 2) Then
HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 2) & "=="
End If
End Function
This converts the above to base64, and I can use the output like this (e.g. in a browser url bar) to view it as an image:
data:image/bmp;base64,Qk0eBQAAAAAAAD4AAAAo...