VB6: Slow Binary Write? - vb6

Question

Wondering why a particular binary write operation in VB is so slow. The function reads a Byte array from memory and dumps it into a file like this:
Open Destination For Binary Access Write As #1
Dim startP, endP As Long
startP = BinaryStart
endP = UBound(ReadBuf) - 1
Dim i as Integer
For i = startP To endP
DoEvents
Put #1, (i - BinaryStart) + 1, ReadBuf(i)
Next
Close #1
For two megabytes on a slower system, this can take up to a minute. Can anyone tell me why this is so slow?
Edit: The reason for choosing VB6 is that it runs on 100% of our target platforms as a single EXE, without any separate dependencies (except VBRUN, which is on pretty much everything).

Answer 1

Well, are you reading and writing each byte 1 by one? In that case you are iterating through 2 million elements instead of just taking a chunk of data at a time and write it to the stream.

Answer 2

Take out the DoEvents call. If you're writing two megabytes of data one byte at a time, that loop has 2097152 DoEvents calls. That will really really slow down the process.

Answer 3

Dim startP, endP As Long -- here you declare startP as Variant and endP as Long.
DoEvents -- yields control to the OS, calling on each iteration makes virtually any loop endless.
And then, if you want to save a piece of an array to a file, that should be...
Hmm... What should it be then?
Option 1.
Declare another array to hold the piece, CopyMemory the data into it and put it into a file using a single Put:
Put #1, , arrName
That, however, may be not wise memory-wise.
Hence, Option 2.
Create an array that refers to the data in the big array. This way nothing will be allocated twice:
Dim bigArray(1 To 1000) As Byte
Dim chunk() As Byte
Dim i As Long
'Filling the array for test purposes
For i = LBound(bigArray) To UBound(bigArray)
bigArray(i) = Rnd * 254
Next
'Create an array that refers to 100 bytes from bigArray, starting from 500th
CreateSAFEARRAY ArrPtr(chunk), 1, VarPtr(bigArray(500)), 1, 100
Open "c:\1.txt" For Binary Access Write As #1
Put #1, , chunk
Close #1
'Always destroy it manually!
DestroySAFEARRAY ArrPtr(chunk)
This code requires the following helper functions (put in a separate module):
Option Explicit
Private Declare Function SafeArrayAllocDescriptor Lib "oleaut32" (ByVal cDims As Long, ppsaOut As Any) As Long
Private Declare Function SafeArrayDestroyDescriptor Lib "oleaut32" (psa As Any) As Long
Public Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Public Declare Function PutMem4 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long
Public Declare Function PutMem8 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValueLow As Long, ByVal NewValueHigh As Long) As Long
Private Const S_OK As Long = 0
Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
Public Function CreateSAFEARRAY(ByVal ppBlankArr As Long, ByVal ElemSize As Long, ByVal pData As Long, ParamArray Bounds()) As Long
Dim i As Long
If (UBound(Bounds) - LBound(Bounds) + 1) Mod 2 Then Err.Raise 5, "SafeArray", "Bounds must contain even number of entries."
If SafeArrayAllocDescriptor((UBound(Bounds) - LBound(Bounds) + 1) / 2, ByVal ppBlankArr) <> S_OK Then Err.Raise 5
GetMem4 ppBlankArr, VarPtr(CreateSAFEARRAY)
PutMem4 CreateSAFEARRAY + 4, ElemSize
PutMem4 CreateSAFEARRAY + 12, pData
For i = LBound(Bounds) To UBound(Bounds) - 1 Step 2
If Bounds(i + 1) - Bounds(i) + 1 > 0 Then
PutMem8 CreateSAFEARRAY + 16 + (UBound(Bounds) - i - 1) * 4, Bounds(i + 1) - Bounds(i) + 1, Bounds(i)
Else
SafeArrayDestroyDescriptor ByVal CreateSAFEARRAY
CreateSAFEARRAY = 0
PutMem4 ppBlankArr, 0
Err.Raise 5, , "Each dimension must contain at least 1 element"
End If
Next
End Function
Public Function DestroySAFEARRAY(ByVal ppArray As Long) As Long
GetMem4 ppArray, VarPtr(DestroySAFEARRAY)
If SafeArrayDestroyDescriptor(ByVal DestroySAFEARRAY) <> S_OK Then Err.Raise 5
PutMem4 ppArray, 0
DestroySAFEARRAY = 0
End Function