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