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

Set oStream = CreateObject("ADODB.Stream")

Option Explicit
Private Declare Function IStream_Size Lib "shlwapi" Alias "#214" (ByVal ptrIStream As Long, ULARGE_INTEGER As Currency) As Long
 
Private Sub Command1_Click()
    Dim ADOStream As Object
    Dim IStreamPtr As Long
    
    Set ADOStream = CreateObject("ADODB.Stream")
    IStreamPtr = ObjPtr(ADOStream) + 76 ' Волшебное число для Windows 7
    
    ' Открыть поток в бинарном режиме (аналог SHCreateMemStream)
    ADOStream.Type = 1 ' adTypeBinary
    ADOStream.Open
    
    ' Теперь попробуем что-нибудь записать в поток, например картинку с формы
    Dim pPic As IPicture
    
    Set pPic = Me.Picture
    pPic.SaveAsFile ByVal IStreamPtr, True, 0 ' Записать в поток картинку Picture с формы, сохраняя данные в BMP-формате
    
    ' Теперь попробуем узнать сколько байтов занимает этот поток
    Dim sizeStream As Currency
    
    IStream_Size IStreamPtr, sizeStream
    MsgBox "Поток занимает: " & sizeStream * 10000@ & " байт", vbInformation
    
    ' Этот код будет эквивалентен вызову ADOStream.Size
    MsgBox "Поток занимает: " & ADOStream.Size
    
    If ADOStream.Size > 0 Then
        ' Потом этот поток, можно сохранить в файл на диске например
        ' Получить байтовый массив из потока
        Dim bArray() As Byte
        
        ADOStream.Position = 0
        bArray = ADOStream.Read
        
        ' Сохранить на диск
        Dim FileNo As Integer
        
        FileNo = FreeFile
        On Error Resume Next: Kill App.Path & "\test_picture.bmp"
        Open App.Path & "\test_picture.bmp" For Binary As FileNo
            Put #FileNo, , bArray
        Close FileNo
    End If
End Sub

Public Declare Function SHCreateStreamOnFileEx Lib "Shlwapi" ( _
                        ByVal pszFile As Long, _
                        ByVal grfMode As Long, _
                        ByVal dwAttributes As Long, _
                        ByVal fCreate As Long, _
                        ByVal pstmTemplate As IUnknown, _
                        ByRef ppstm As IUnknown) As Long

Private Function SaveCurrentImage() As Boolean
    Dim tPNGCodec   As UUID
    Dim cFileStm    As IStream
    Dim sFullPath   As String
    Dim lPathLen    As Long
    
    If Not GetEncoders(tPNGCodec) Then
        Exit Function
    End If
    
    sFullPath = Space$(MAX_PATH)
    
    lPathLen = GetFullPathName(txtPath.Text & "\" & CStr(m_lImgID) & ".png", Len(sFullPath) + 1, sFullPath, ByVal NULL_PTR)
    
    If lPathLen = 0 Then
        Exit Function
    Else
        sFullPath = Left$(sFullPath, lPathLen)
    End If
    
    If SHCreateStreamOnFileEx(sFullPath, STGM_CREATE Or STGM_READWRITE, FILE_ATTRIBUTE_NORMAL, 1, Nothing, cFileStm) < 0 Then
        Exit Function
    End If
    
    If GdipSaveImageToStream(m_hGPBitmap, cFileStm, tPNGCodec, ByVal NULL_PTR) <> Ok Then
        Exit Function
    End If
    
    m_lImgID = m_lImgID + 1
    
    SaveCurrentImage = True
    
End Function