Convert hex string (image) to base64 (for browser rendering) in 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

possible duplicate of Base64 Encode String in VBScript

Cheran Shunmugavel
– Cheran Shunmugavel

2013-03-17 07:50:26 +00:00
Commented Mar 17, 2013 at 7:50 — Cheran Shunmugavel
– Cheran Shunmugavel, Commented Mar 17, 2013 at 7:50
This function may be convenient to convert hex to base64.

omegastripes
– omegastripes

2014-05-05 16:31:18 +00:00
Commented May 5, 2014 at 16:31 — omegastripes
– omegastripes, Commented May 5, 2014 at 16:31

GWR · Accepted Answer · 2013-01-24 18:24:14Z

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...

Stephen Quan · Accepted Answer · 2013-03-17 07:13:16Z

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.

I find this convenient, but creating the object can be prohibitively slow.

Collectives™ on Stack Overflow

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

2 Answers 2

Comments

1 Comment

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

1 Comment

Linked

Related