base64 字符串到字节到图像

Question

我有一个 base64 字符串，它是使用另一个应用程序从图像生成的。现在在我的应用程序中，我想将 base64 字符串转换为字节并将其显示在 PictureBox 上。

我已经找到了一个示例应用程序，它接受一个字节输入并设置一个 PictureBox 图像。不幸的是，示例应用程序从图像中获取字节数组并将其翻译回来。这是它使用的功能。

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

这是我找到的将base64字符串转换为字节的函数，它似乎正在转换它，但是当我将字节数据传递给上述函数时，没有图像出现。

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

这是我调用函数的代码。

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

Answer 1

试试这个：

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