vb6 - base64 string to byte to image

Question

I have a base64 string which was generated from an image using another application. Now on my application I want to convert the base64 string to byte and display it on a PictureBox.

I already found a sample application which takes a byte input and sets a PictureBox image. Unfortunately the sample application gets the byte array from an image and just translates it back. Here's the function it uses.

Public Function PictureFromByteStream(b() As Byte) As IPicture
Dim LowerBound As Long
Dim ByteCount  As Long
Dim hMem  As Long
Dim lpMem  As Long
Dim IID_IPicture(15)
Dim istm As stdole.IUnknown

On Error GoTo Err_Init
If UBound(b, 1) < 0 Then
    Exit Function
End If

LowerBound = LBound(b)
ByteCount = (UBound(b) - LowerBound) + 1
hMem = GlobalAlloc(&H2, ByteCount)
If hMem <> 0 Then
    lpMem = GlobalLock(hMem)
    If lpMem <> 0 Then
        MoveMemory ByVal lpMem, b(LowerBound), ByteCount
        Call GlobalUnlock(hMem)
        If CreateStreamOnHGlobal(hMem, 1, istm) = 0 Then
            If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
              Call OleLoadPicture(ByVal ObjPtr(istm), ByteCount, 0, IID_IPicture(0), PictureFromByteStream)
            End If
        End If
    End If
End If

Exit Function

Err_Init:
If Err.Number = 9 Then
    'Uninitialized array
    MsgBox "You must pass a non-empty byte array to this function!"
Else
    MsgBox Err.Number & " - " & Err.Description
End If
End Function

Here's the function I found to convert a base64 string to a byte, it seems to be converting it but when I pass the byte data to the above function, no image appears.

Private Function DecodeBase64(ByVal strData As String) As Byte()


Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement

' help from MSXML
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue

' thanks, bye
Set objNode = Nothing
Set objXML = Nothing


End Function

And here's my code calling the functions.

Dim b() As Byte
b = DecodeBase64(Text1.Text)
Dim pic As StdPicture
Set pic = PictureFromByteStream(b)
Set Picture1.Picture = pic

Answer 1

Try this:

Option Explicit

Private Const CRYPT_STRING_BASE64 As Long = &H1&
Private Const STRING_IPICTURE_GUID As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

Private Declare Function CryptStringToBinaryW Lib "Crypt32.dll" ( _
    ByVal pszString As Long, _
    ByVal cchString As Long, _
    ByVal dwFlags As Long, _
    ByVal pbBinary As Long, _
    ByRef pcbBinary As Long, _
    ByVal pdwSkip As Long, _
    ByVal pdwFlags As Long) As Long

Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" ( _
    ByRef hGlobal As Any, _
    ByVal fDeleteOnResume As Long, _
    ByRef ppstr As Any) As Long

Private Declare Function OleLoadPicture Lib "olepro32.dll" ( _
ByVal lpStream As IUnknown, _
ByVal lSize As Long, _
ByVal fRunMode As Long, _
ByRef riid As GUID, _
ByRef lplpObj As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32.dll" ( _
    ByVal lpsz As Long, _
    ByRef pclsid As GUID) As Long

Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Public Function DecodeBase64(ByVal strData As String) As Byte()
    Dim Buffer() As Byte
    Dim dwBinaryBytes As Long
    dwBinaryBytes = LenB(strData)
    ReDim Buffer(dwBinaryBytes - 1) As Byte
    If CryptStringToBinaryW(StrPtr(strData), LenB(strData), CRYPT_STRING_BASE64, _
        VarPtr(Buffer(0)), dwBinaryBytes, 0, 0) Then
        ReDim Preserve Buffer(dwBinaryBytes - 1) As Byte
        DecodeBase64 = Buffer
    End If
    Erase Buffer
End Function

Public Function PictureFromByteStream(ByRef b() As Byte) As IPicture
    On Error GoTo errorHandler
    Dim istrm As IUnknown
    Dim tGuid As GUID

    If Not CreateStreamOnHGlobal(b(LBound(b)), False, istrm) Then
        CLSIDFromString StrPtr(STRING_IPICTURE_GUID), tGuid
        OleLoadPicture istrm, UBound(b) - LBound(b) + 1, False, tGuid, PictureFromByteStream
    End If

    Set istrm = Nothing
    Exit Function
errorHandler:
    Debug.Print "Error in converting to IPicture."
End Function