base64文字列からバイト画像へ

Question

私は別のアプリケーションを使って画像から生成されたbase64文字列を持っています。今私のアプリケーションでは、Base64文字列をバイトに変換して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