How to work with IStream in VB6?

[HackerVlad]

I'm new to this field so I have some simple questions. I am opening a new IStream using the SHCreateMemStream function.

1. How do I open this stream for reading?
2. How do I read/write byte by byte?
Analog of the read code With C++ (HRESULT hr = ((IStream*)hf)->Read(memory, cb, &ul)
and the write code (HRESULT hr = ((IStream*)hf)->Write(memory, cb, &ul)

3. How to position the pointer? (Seek)
4. How do I close the IStream descriptor opened via SHCreateMemStream?

[-Franky-]

SHCreateMemStream creates an interface IStream. When created, this can already contain data, depending on the parameters of SHCreateMemStream, or it can be empty. When you no longer need the interface IStream, you release it with IStream::Release. You can find everything else in the MS documentation: https://learn.microsoft.com/en-us/wi...quentialstream and https://learn.microsoft.com/en-us/wi...objidl-istream

[HackerVlad]

SHCreateMemStream creates an interface IStream. When created, this can already contain data, depending on the parameters of SHCreateMemStream, or it can be empty. When you no longer need the interface IStream, you release it with IStream::Release. You can find everything else in the MS documentation: https://learn.microsoft.com/en-us/wi...quentialstream and https://learn.microsoft.com/en-us/wi...objidl-istream

You know perfectly well that there is no such code in VB6 "IStream::Release." How to implement this on VB6 help!!!!!!!!!!!!!!!

[VanGoghGaming]

The easiest way is to use a TypeLib that implements the desired interface (IStream in your case). You won't find a better one than fafalone's OLEEXP so grab it if you don't already have it. Then you can call all the IStream methods directly, Read, Write, Seek, etc.

[xiaoyao]

ado 2.6
adodb.stream
You can use this.

[fafalone]

Lots IStream related APIs, e.g. theres also SHCreateStreamOnFileEx so you don't need to read it yourself first. So really you need to be more specific... use it for *what*. On the examples list for oleexp there's a few listing IStream, check those out for some of the many ways.

There is a Release but its hidden by VB and 99% of the time you should use Set var = Nothing which calls Release for you.

[VanGoghGaming]

There's also:

Public Declare Sub IUnknown_AtomicRelease Lib "shlwapi" (ppUnk As Any)

which comes in handy when working with "DispCallFunc" pointers where you can't use the "Set var = Nothing" syntax.

[-Franky-]

You know perfectly well that there is no such code in VB6 "IStream::Release." How to implement this on VB6 help!!!!!!!!!!!!!!!

You don't always need the IStream interface directly via TLB. A pointer to the interface is also sufficient. You can either use DispCallFunc and a VTable to use the corresponding IStream functions or you can also use the corresponding APIs from the Shlwapi.dll such as IStream_Read, IStream_Write etc. with the pointer.

[HackerVlad]

I found a useful module for these purposes on GitHub: https://gist.github.com/xxdoc/92fcbb...0e3c6ffd7f733d

This is a module from wqweto by the way...

[wqweto]

I found a useful module for these purposes on GitHub: https://gist.github.com/xxdoc/92fcbb...0e3c6ffd7f733d

This is a module from wqweto by the way...

Btw, I'm using this module for all my file related needs as this supports large files (2GB+), Unicode and long filenames (with or without \\?\ prefix) -- all of these lacking in built-in Open/Get/Put/Close statements.

cgeers,
</wqw>

[xiaoyao]

There's also:

Public Declare Sub IUnknown_AtomicRelease Lib "shlwapi" (ppUnk As Any)

which comes in handy when working with "DispCallFunc" pointers where you can't use the "Set var = Nothing" syntax.

in form1.frm:
dim a as new class1
need set a=nothing

how can i clear a on class1?
IUnknown_AtomicRelease objptr(a)??

[xiaoyao]

Property Position As ADO_LONGPTR
ADODB.Stream
does it support more than 2gb,5gb? MAYBE ADODB.STREAM IS CALL IStream API?

VB6 ADODB.Stream has no SEEK attribute, the pointer is moved forward 100 bytes, to break the 2GB limit of data read
The ADODB.Stream object is used in VB6 to handle binary data and text streams. It does not have an attribute named SEEK
, but its Position property can be used to move the pointer in the stream
. You can move to a specific Position in the stream by setting the Position property, and then use the Read or Write methods to read

In VB6, when the Position attribute of the ADODB.Stream object is used, the data type of the attribute is ADO_LONGPTR
. ADO_LONGPTR is designed to provide compatibility between 32-bit and 64-bit systems
. On 32-bit systems, ADO_LONGPTR is treated as a Long type, and on 64-bit systems, it is treated as a LongLong type
.

For 32-bit systems, the maximum value of type Long is 2^ 31-1 (about 210 million), which means that on 32-bit systems, the Position attribute of ADODB.Stream may not support files larger than 2GB. However, on 64-bit systems, since ADO_LONGPTR can be considered a LongLong type, it is capable of supporting much larger values, theoretically supporting files over 2GB or even 5GB

[xiaoyao]

edanmo olelib IStream quesiton
https://microsoft.public.vb.ole.nark...tream-quesiton

Zip file: VBSTRM Type Library.zip
http://www.vbaccelerator.com/home/VB...e_Library.html

Dim oStrm As olelib.IStream
Set oStrm = CreateStreamOnHGlobal(0, True)

oStrm.Stat Stat
Bytes = Stat.cbSize * 10000
If Bytes > 0 Then
ReDim B(0 To Bytes - 1)
oStrm.Seek 0, 0
oStrm.Read B(0), Bytes

Sub Seek(dlibMove As Currency, dwOrigin As STREAM_SEEK, plibNewPosition As Long)
Member of VBStrm.IStream
support more than 2GB,5GB

[VanGoghGaming]

in form1.frm:
dim a as new class1
need set a=nothing

how can i clear a on class1?
IUnknown_AtomicRelease objptr(a)??

Dim obj As Class1
Set obj = New Class1
IUnknown_AtomicRelease obj

[xiaoyao]

Public Function StreamReadBytes(ByVal pUnk As stdole.IUnknown, Optional ByVal Size As Long = -1) As Byte()
Dim baData() As Byte
StreamReadBytes = baData
End Function

Does this approach involve multiple variable assignments and finally copying the entire array of code execution? If you put the binary array variables in the parameters to pass the address, there is no need to reassign the variables and copy everything, right? The simplest return string function, but also through a copy of it, a few MB, hundreds of MB string, should not be placed in the parameter return?

[VanGoghGaming]

It doesn't copy the local array into the function result, it just moves the array pointer!

[xiaoyao]

It doesn't copy the local array into the function result, it just moves the array pointer!

Private Sub Form_Load()
    Dim S2 As String
    S2 = GetStr
    Debug.Print "StrPtr(S2)=" & StrPtr(S2)
End Sub
Function GetStr() As String
    Dim s1 As String
    s1 = "abc"
    Debug.Print "StrPtr(S1)=" & StrPtr(s1)
    GetStr = s1
End Function

'function returns: UsedTime1=0.0427 Ms
'Returns: UsedTime2=0.0179 Ms

'But the array is addressed, but allocating a new array is indispensable, but also cleaning, CPU computing time will increase a lot
The normal data type returned in the 'function is the copy value

Dim Buffer2() As Byte
Dim Buffer1() As Byte

        QueryPerformanceCounter CPUv1
Buffer1 = GetByteArr
        QueryPerformanceCounter CPUv2
        UsedTime1 = (CPUv2 - CPUv1) / MsCount
        Debug.Print "UsedTime1=" & UsedTime1 & " Ms"
        
        QueryPerformanceCounter CPUv1
GetByteArr2 Buffer2
        QueryPerformanceCounter CPUv2
        UsedTime2 = (CPUv2 - CPUv1) / MsCount
        Debug.Print "UsedTime2=" & UsedTime2 & " Ms"

Function GetByteArr() As Byte()
    Dim Buffer() As Byte
    ReDim Buffer(20000)
    Buffer(0) = 11
    Buffer(1) = 12
    'Debug.Print "VarPtr(Buffer(1))=" & VarPtr(Buffer(1))
    GetByteArr = Buffer
End Function

Sub GetByteArr2(Buffer() As Byte)
    ReDim Buffer(20000)
    Buffer(0) = 11
    Buffer(1) = 12
End Sub

[VanGoghGaming]

Only works with arrays, not with strings.

[xiaoyao]

Only works with arrays, not with strings.

you can try twinbasic,maybe same?

[HackerVlad]

I have concluded for myself that it is easiest to use the usual API functions. But they need to be called by numbers for compatibility with XP. Here is a useful code:

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" 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)

Private Enum Stream_Seek
    STREAM_SEEK_SET
    STREAM_SEEK_CUR
    STREAM_SEEK_END
End Enum

Dim hStream As Long

Private Function DispCallByVtbl(ByVal 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

Unfortunately, I had to write the IStream_Seek function myself, since I do not know how to call it from the API or if it exists at all. Maybe there is a number, but we don't know that.

[HackerVlad]

And of course the most important thing, considering that my code works on Long variables, it works the same way with strings, not only with byte-arrays. To work with strings, you need to write StrPtr.

Here is an example of how to work with a String:

Private Sub Command1_Click()
    Dim str As String
    Dim s1 As Currency
    
    str = "str12345" 
    
    Me.Cls
    Print IStream_Write(hStream, StrPtr(str), LenB(str))
    
    IStream_Size hStream, s1
    MsgBox s1 * 10000@, vbInformation
End Sub

[fafalone]

There's certainly reasons to *prefer* DispCallFunc, but saying it's easier than just using a typelib-defined IStream is like saying doing it by inline assembly is also easier


And yes there is no helper API for IStream.Seek

[HackerVlad]

I think that maybe there is such a function there, but no one just knows about it. There are also a lot of unnamed functions that just go by the numbers. And who knows what these functions do... They are not described anywhere, not in any documentation...

[fafalone]

I think that maybe there is such a function there, but no one just knows about it. There are also a lot of unnamed functions that just go by the numbers. And who knows what these functions do... They are not described anywhere, not in any documentation...

Well we know for a fact there's not one as of Windows XP/Server 2003, since the source of shlwapi.dll is included in the source leak, and I very strongly doubt they've added one since.

e.g.

STDAPI IStream_Read(IStream *pstm, void *pv, ULONG cb)
{
    ASSERT(pstm);
    ULONG cbRead;
    HRESULT hr = pstm->Read(pv, cb, &cbRead);
    if (SUCCEEDED(hr) && cbRead != cb) 
    {
        hr = E_FAIL;
    }
    return hr;
}

[-Franky-]

You rarely need IStream::Seek. Only if you want to jump to certain positions in the stream without reading or writing data. In the shlwapi there are also IStream_Reset and IStream_Size. Both APIs are a replacement for IStream::Seek with the parameters 0, STREAM_SEEK_SET and 0, STREAM_SEEK_END.

[HackerVlad]

Well we know for a fact there's not one as of Windows XP/Server 2003, since the source of shlwapi.dll is included in the source leak, and I very strongly doubt they've added one since.

e.g.

STDAPI IStream_Read(IStream *pstm, void *pv, ULONG cb)
{
    ASSERT(pstm);
    ULONG cbRead;
    HRESULT hr = pstm->Read(pv, cb, &cbRead);
    if (SUCCEEDED(hr) && cbRead != cb) 
    {
        hr = E_FAIL;
    }
    return hr;
}

Have you studied the entire source code of the library shlwapi.dll to be sure for sure that there is no such function? And have you looked at/read all the unnamed functions that go by numbers?

[HackerVlad]

I am currently programming a buffer swap script and recording a stream with arbitrary positioning. Therefore, it is very important for Seek to be set arbitrarily. Of course, it's a big shame for Microsoft that they didn't make such an API.

But thanks for saying that Size causes Seek, I didn't know that.

[HackerVlad]

By the way, I looked at the ReactOS source code there, I think it will be about the same as in the Windows source code itself, so in the Sekk function there, in my opinion, it refers to the SetFilePointer function for some reason. Although the stream is not a file. Strange.

[fafalone]

Have you studied the entire source code of the library shlwapi.dll to be sure for sure that there is no such function? And have you looked at/read all the unnamed functions that go by numbers?

You can search files for strings. I looked at all instances of IStream_

No functions go by numbers in the source code. That's only a result of not defining an export symbol for the compiled DLL. So for functions in XP SP2/Server 2003 and earlier, if you know the ordinal, you can look up the actual name.

For example, ordinal-only exports 17-24 are these functions:

        SHWriteDataBlockList               @17    NONAME  PRIVATE
        SHReadDataBlockList                @18    NONAME  PRIVATE
        SHFreeDataBlockList                @19    NONAME  PRIVATE
        SHAddDataBlock                     @20    NONAME  PRIVATE
        SHRemoveDataBlock                  @21    NONAME  PRIVATE
        SHFindDataBlock                    @22    NONAME  PRIVATE

        SHStringFromGUIDA                  @23    NONAME  PRIVATE
        SHStringFromGUIDW                  @24    NONAME  PRIVATE

...there's further ways to find names and prototypes from compiled DLLs. For shlwapi, Geoff Chappell has done that work:

https://www.geoffchappell.com/studie.../api/index.htm

His site is invaluable if you're interested in Windows internals. Sadly he passed away earlier this year, so no more will be added.

[HackerVlad]

Thanks for the information, I didn't know that, I thought there were unnamed functions in libraries that don't have a name, but only a number

[HackerVlad]

I wrote the code I needed to work with IStream for myself. Please help me write a function that will call the IUnknown::Release method.

Private Function DispCallByVtbl(ByVal 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_Read(ByVal ptrIStream As Long, ByVal pv As Long, ByVal BytesRead As Long) As Long
    Dim BytesReaded As Long
    
    DispCallByVtbl ptrIStream, 3, pv, BytesRead, VarPtr(BytesReaded)
    IStream_Read = BytesReaded
End Function

Private Function IStream_Write(ByVal ptrIStream As Long, ByVal pv As Long, ByVal BytesWrite As Long) As Long
    Dim BytesWritten As Long
    
    DispCallByVtbl ptrIStream, 4, pv, BytesWrite, VarPtr(BytesWritten)
    IStream_Write = BytesWritten
End Function

Private Function IStream_Seek(ByVal ptrIStream As Long, ByVal Offset As Currency, ByVal Origin As Stream_Seek) As Long
    Dim NewPosition As Currency
    
    DispCallByVtbl ptrIStream, 5, Offset, Origin, VarPtr(NewPosition)
    IStream_Seek = NewPosition * 10000@
End Function

[VanGoghGaming]

Release is at position 2 in the VTable so just call it with your DispCallByVtbl function like you did for the other methods. Alternatively you can use the function from post #7 above for the same result.

Yet another way is to create a function with a local variable that will get released automatically when it goes out of scope:

Private Declare Sub PutMem4 Lib "msvbvm60" Alias "#307" (Ptr As Any, ByVal NewVal As Long)

Public Sub ReleasePtr(lpInterface As Long)
Dim Interface As IUnknown
    If lpInterface Then PutMem4 Interface, lpInterface: lpInterface = 0
End Sub

[fafalone]

I wrote the code I needed to work with IStream for myself. Please help me write a function that will call the IUnknown::Release method.

Private Function DispCallByVtbl(ByVal 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_Read(ByVal ptrIStream As Long, ByVal pv As Long, ByVal BytesRead As Long) As Long
    Dim BytesReaded As Long
    
    DispCallByVtbl ptrIStream, 3, pv, BytesRead, VarPtr(BytesReaded)
    IStream_Read = BytesReaded
End Function

Private Function IStream_Write(ByVal ptrIStream As Long, ByVal pv As Long, ByVal BytesWrite As Long) As Long
    Dim BytesWritten As Long
    
    DispCallByVtbl ptrIStream, 4, pv, BytesWrite, VarPtr(BytesWritten)
    IStream_Write = BytesWritten
End Function

Private Function IStream_Seek(ByVal ptrIStream As Long, ByVal Offset As Currency, ByVal Origin As Stream_Seek) As Long
    Dim NewPosition As Currency
    
    DispCallByVtbl ptrIStream, 5, Offset, Origin, VarPtr(NewPosition)
    IStream_Seek = NewPosition * 10000@
End Function

...why have conditional PTR_SIZE if you're not going to use LongPtr? Your code would crash in x64 because you're using 4-byte Long for 8-byte pointers.

[HackerVlad]

Well, I don't need 64 compatibility. But I thought you could help me write the IStream_Release function

[xiaoyao]

Function SetStreamByByteArr(ByteArr() As Byte) As Boolean
    '?????????????????
    Dim pIStream As oleexp.IStream, CreateStreamOK As Boolean
    Set pDecoder = Nothing
    'CreateStreamOK=ByteArrToIStream( ByteArr(), pIStream)
    If CreateStreamOnHGlobal(VarPtr(ByteArr(0)), 0&, pIStream) = 0& Then
            CreateStreamOK = True
    End If
    If pFact Is Nothing Then Set pFact = New WICImagingFactory
    Set pDecoder = pFact.CreateDecoderFromStream(pIStream, UUID_NULL, WICDecodeMetadataCacheOnDemand)
    SetStreamByByteArr = Not pDecoder Is Nothing
End Function

[xiaoyao]

Well, I don't need 64 compatibility. But I thought you could help me write the IStream_Release function

Public Declare Sub IUnknown_AtomicRelease Lib "shlwapi" (ppUnk As Any)
Private Declare Sub IUnknown_AtomicRelease Lib "shlwapi" Alias "#169" (ppUnk As Any)

IUnknown_AtomicRelease PUNK

[HackerVlad]

Public Declare Sub IUnknown_AtomicRelease Lib "shlwapi" (ppUnk As Any)
Private Declare Sub IUnknown_AtomicRelease Lib "shlwapi" Alias "#169" (ppUnk As Any)

IUnknown_AtomicRelease PUNK

I don't want to use IUnknown_AtomicRelease. I want a function via DispCallByVtbl.

[fafalone]

Well, I don't need 64 compatibility. But I thought you could help me write the IStream_Release function

Just the #If Win64 Then suggests it is supposed to support x64. All you need to do is change the interface pointers to LongPtr.

VanGoghGaming gave you two ways to call Release. DispCallByVtbl with lIndex = 2 since it's 3rd inthe vtable. No arguments, Long return.

[HackerVlad]

Just the #If Win64 Then suggests it is supposed to support x64. All you need to do is change the interface pointers to LongPtr.

VanGoghGaming gave you two ways to call Release. DispCallByVtbl with lIndex = 2 since it's 3rd inthe vtable. No arguments, Long return.

Good thanks.

[The trick]

vbaObjSet[AddRef] with zero calls IUnknown::Release.