VB6: Slow Binary Write?

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