Question

想知道为什么VB中的特定二进制写操作太慢了。该函数从内存中读取一个Byte数组，并将其转储到如下文件中：

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

对于较慢系统上的两兆字节，这可能需要一分钟。谁能告诉我为什么这么慢？

编辑：选择VB6的原因是它作为单个EXE在100％的目标平台上运行，没有任何单独的依赖项（VBRUN除外，几乎所有内容都是如此）。

Answer 1

那么，你是在逐个读写每个字节吗？在这种情况下，您将迭代200万个元素，而不是一次只获取一大块数据并将其写入流中。

Answer 2

取出DoEvents电话。如果您一次一个字节地写入两兆字节的数据，则该循环具有2097152个DoEvents调用。这真的会减慢这个过程。

Answer 3

Dim startP, endP As Long - 在此，您将startP声明为Variant，将endP声明为Long。

DoEvents - 控制操作系统，调用每次迭代几乎可以使任何循环无限。

然后，如果你想将一个数组保存到一个文件，那应该是......

嗯......那应该是什么？

选项1。

声明另一个数组，将数据CopyMemory保存到其中，然后使用单个Put将其放入文件中：

Put #1, , arrName

然而，这可能不是明智的记忆。

因此，选项2 。

创建一个引用大数组中数据的数组。这样就不会分配任何东西两次：

  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)

此代码需要以下辅助函数（放在单独的模块中）：

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

VB6：慢二进制写？

3 个答案: