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

Option Explicit
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
Private Declare Function SHCreateMemStream Lib "shlwapi" Alias "#12" (ByRef pInit As Any, ByVal cbInit As Long) As Long
Private Declare Function IStream_Write Lib "shlwapi" (ByVal ptrIStream As Long, ByVal pv As Long, ByVal cb As Long) As Long
Private Declare Function IStream_Read Lib "shlwapi" (ByVal ptrIStream As Long, ByVal pv As Long, ByVal cb As Long) As Long
Private Declare Function IStream_Size Lib "shlwapi" (ByVal ptrIStream As Long, ULARGE_INTEGER As Currency) As Long
Private Declare Sub IUnknown_AtomicRelease Lib "shlwapi" (ppUnk As Any)
 
Private Enum Stream_Seek
    STREAM_SEEK_SET
    STREAM_SEEK_CUR
    STREAM_SEEK_END
End Enum
 
Dim hStream As Long
 
Private Function DispCallByVtbl(pUnk As Long, ByVal lIndex As Long, ParamArray A() As Variant) As Variant
    Const CC_STDCALL    As Long = 4
#If Win64 Then
    Const PTR_SIZE      As Long = 8
#Else
    Const PTR_SIZE      As Long = 4
#End If
    Dim lIdx            As Long
    Dim vParam()        As Variant
    Dim vType(0 To 63)  As Integer
    Dim vPtr(0 To 63)   As Long
    Dim hResult         As Long
    
    vParam = A
    For lIdx = 0 To UBound(vParam)
        vType(lIdx) = VarType(vParam(lIdx))
        vPtr(lIdx) = VarPtr(vParam(lIdx))
    Next
    hResult = DispCallFunc(pUnk, lIndex * PTR_SIZE, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
    If hResult < 0 Then
        Err.Raise hResult, "DispCallFunc"
    End If
End Function
 
Private Function IStream_Seek(ByVal ptrIStream As Long, ByVal Offset As Currency, ByVal Origin As Stream_Seek)
    IStream_Seek = DispCallByVtbl(ptrIStream, 5, Offset, Origin, 0)
End Function
 
Private Sub Command1_Click()
    hStream = SHCreateMemStream(ByVal 0&, 0)
    
    Me.Cls
    Print "hStream: " & hStream
End Sub
 
Private Sub Command2_Click()
    Dim str As String
    Dim s1 As Currency
    
    str = "str12345" ' 8 символов это 16 байтов
    
    Me.Cls
    Print IStream_Write(hStream, StrPtr(str), LenB(str))
    
    IStream_Size hStream, s1
    MsgBox s1 * 10000@, vbInformation
End Sub
 
Private Sub Command3_Click()
    Dim strRead As String
    
    strRead = String(16, "X")
    
    Me.Cls
    Print IStream_Read(hStream, StrPtr(strRead), 16) & ", strRead: " & Chr(34) & strRead & Chr(34)
End Sub
 
Private Sub Command4_Click()
    Me.Cls
    Print IStream_Seek(hStream, 6 / 10000@, STREAM_SEEK_SET)
End Sub
 
Private Sub Command5_Click()
    Dim cbSize As Currency
    
    Me.Cls
    IStream_Size hStream, cbSize
    Print "Size: " & cbSize * 10000@ & " bytes"
End Sub
 
Private Sub Command6_Click()
    Dim FileNo As Integer
    Dim fLen As Long
    Dim lng As Long
    Dim s1 As Currency
    Dim buf() As Byte
    
    ' Инициализировать счётчик
    FileNo = FreeFile
    
    ' Открыть файл
    Open App.Path + "\test.txt" For Binary As FileNo
        fLen = LOF(FileNo)
        ReDim buf(fLen - 1)
        Get #FileNo, , buf
    Close FileNo
    
    IStream_Write hStream, VarPtr(buf(0)), UBound(buf) + 1
    IStream_Size hStream, s1
    
    MsgBox s1 * 10000@, vbInformation
End Sub
 
Private Sub Command7_Click()
    IUnknown_AtomicRelease hStream
End Sub

Private Function CloneStream( _
                 ByVal cStm As IStream) As IStream
    Dim cRet        As IStream
    Dim cSize       As Currency
    Dim lSize       As Long
    Dim bData()     As Byte
 
    cSize = cStm.Seek(0, STREAM_SEEK_END)
    cStm.Seek 0, STREAM_SEEK_SET
    
    If cSize <= 0 Or cSize > 10000 Then Exit Function
    
    GetMem4 cSize, lSize
 
    Set cRet = SHCreateMemStream(ByVal 0&, 0)
    If cRet Is Nothing Then Exit Function
    
    ReDim bData(lSize - 1)
    
    If cStm.Read(bData(0), lSize) <> lSize Then Exit Function
    
    If cRet.Write(bData(0), lSize) <> lSize Then Exit Function
    
    cRet.Seek 0, STREAM_SEEK_SET
    
    Set CloneStream = cRet
    
End Function

Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetProcAddressNumber Lib "kernel32" Alias "GetProcAddress" (ByVal hModule As Long, ByVal lpProcName As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
 
Private Sub Command1_Click()
    Dim handle As Long, address As Long ' Переменные с результатами функций
    Dim IsDLLFunction As Boolean
    Dim address2 As Long
    
    handle = LoadLibrary(Text1.Text) ' Загружаем библиотеку
    
    If handle <> 0 Then ' Успешная загрузка
        address = GetProcAddress(handle, Text2.Text) ' Получаем адрес функции по её названию
        
        If address <> 0 Then ' Успешное получение адреса
            Dim i As Long
            
            IsDLLFunction = False
            
            For i = 1 To Text3.Text ' Перебирать циклом от 1 до 1000 например
                address2 = GetProcAddressNumber(handle, i) ' Получаем адрес функции по номеру
                
                If address2 = address Then
                    IsDLLFunction = True
                    Exit For
                End If
            Next
            
            If IsDLLFunction = True Then
                MsgBox "Успешно найден номер функции. Номер: " & i, vbInformation
            End If
        End If
    End If
    
    FreeLibrary handle ' Высвобождаем библиотеку из памяти
End Sub

Private Declare Function SHCreateMemStream Lib "shlwapi" Alias "#12" (ByRef pInit As Any, ByVal cbInit As Long) As Long
Private Declare Function IStream_Write Lib "shlwapi" Alias "#212" (ByVal ptrIStream As Long, ByVal pv As Long, ByVal cb As Long) As Long
Private Declare Function IStream_Read Lib "shlwapi" Alias "#184" (ByVal ptrIStream As Long, ByVal pv As Long, ByVal cb As Long) As Long
Private Declare Function IStream_Size Lib "shlwapi" Alias "#214" (ByVal ptrIStream As Long, ULARGE_INTEGER As Currency) As Long
Private Declare Sub IUnknown_AtomicRelease Lib "shlwapi" Alias "#169" (ppUnk As Any)