Как работать с потоками IStream в Visual Basic 6

Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
Private Declare Function GdipSaveImageToStream Lib "gdiplus" (ByVal image As Long, ByVal stream As IUnknown, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As IUnknown) As Long
Private Declare Function GetHGlobalFromStream Lib "ole32" (ByVal ppstm As IUnknown, hGlobal As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
 
Private Function SaveAsPng(ByVal cImage As IPicture) As Byte()
    Dim cBuf(3) As Currency, hToken As Long, hBmp As Long, cStm As IUnknown, hMem As Long, lSize As Long, bData() As Byte
    
    cBuf(0) = 0.0001@: cBuf(2) = 128439892464716.6982@: cBuf(3) = 338308179558612.6746@
 
    If GdiplusStartup(hToken, cBuf(0)) = 0 And CreateStreamOnHGlobal(0, 1, cStm) >= 0 Then
        If GdipCreateBitmapFromHBITMAP(Me.Picture.Handle, 0, hBmp) = 0 Then
            If GdipSaveImageToStream(hBmp, cStm, cBuf(2), ByVal 0&) = 0 Then
                If GetHGlobalFromStream(cStm, hMem) >= 0 Then
                    lSize = GlobalSize(hMem)
                    ReDim bData(lSize - 1)
                    memcpy bData(0), ByVal GlobalLock(hMem), lSize
                    SaveAsPng = bData
                    GlobalUnlock hMem
                End If
            End If
            GdipDisposeImage hBmp
        End If
        GdiplusShutdown hToken
    End If
    
End Function

pPic.SaveAsFile ByVal vbaCastObj(ADOStream, bIID_IStream(0)), True, 0

Function SafeArrayElementsCountVB(Arr As Variant) As Long
    Dim i&, Lb&, Ub&, Cnt&
    On Error GoTo endFunc
    Cnt = (UBound(Arr) - LBound(Arr) + 1)
    For i = 2 To 100
        Lb = LBound(Arr, i)
        Ub = UBound(Arr, i)
        Cnt = Cnt * (Ub - Lb + 1)
    Next
endFunc:
    SafeArrayElementsCountVB = Cnt
End Function

    lLength = SafeArrayElementsCountVB(bData)
    If lLength = 0 Then Exit Function
    
    ReDim bOut(lLength - 1)
    
    lLength = lLength \ 4

Option Explicit
Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal Length As Long)
 
Private Type SAFEARRAYBOUND
    cCount              As Long
    lBound              As Long
End Type
 
Private Type SAFEARRAY
    cDims               As Integer
    fFeatures           As Integer
    cbElements          As Long
    cLocks              As Long
    pvData              As Long
    Bounds              As SAFEARRAYBOUND
End Type
 
' //
' // Get number of elements in array by pointer
' //
Public Function SafeArrayElementsCountVB(Arr As Variant) As Long
    Dim i&, Lb&, Ub&, Cnt&
    On Error GoTo endFunc
    Cnt = (UBound(Arr) - LBound(Arr) + 1)
    For i = 2 To 100
        Lb = LBound(Arr, i)
        Ub = UBound(Arr, i)
        Cnt = Cnt * (Ub - Lb + 1)
    Next
endFunc:
    SafeArrayElementsCountVB = Cnt
End Function
 
Public Function MakeHexString( _
                ByRef bData() As Byte) As String
    Dim lLength As Long
    Dim bOut()  As Byte
    Dim lIndex  As Long
    Dim lChar   As Long
    Dim lSymbol As Long
    Dim lDig    As Long
    Dim lValue  As Long
    
    lLength = SafeArrayElementsCountVB(bData)
    If lLength = 0 Then Exit Function
    
    ReDim bOut(lLength - 1)
    
    lLength = lLength \ 4
    
    ReDim bOut(lLength * 4 - 1)
    
    For lIndex = 0 To lLength - 1
        
        lValue = bData(lIndex)
        
        For lDig = 0 To 1
            
            lSymbol = (lValue And &HF0) \ &H10
            
            Select Case lSymbol
            Case Is < 10:   lSymbol = lSymbol + &H30
            Case Else:      lSymbol = lSymbol + &H37
            End Select
            
            bOut(lChar) = lSymbol
            
            lValue = lValue * &H10
            lChar = lChar + 2
            
        Next
        
    Next
    
    MakeHexString = bOut()
    
End Function
 
Private Sub Command1_Click()
    Dim str As String
    Dim bArray() As Byte
    
    str = "This is a string value 1234567890"
    bArray = str
    
    MsgBox MakeHexString(bArray)
End Sub