VB6: медленная двоичная запись? - PullRequest
Новая
       15

VB6: медленная двоичная запись?

1 голос
/ 27 апреля 2010

Хотите знать, почему конкретная двоичная операция записи в VB такая медленная? Функция считывает байтовый массив из памяти и выгружает его в файл, подобный этому: 

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 состоит в том, что он работает на 100% наших целевых платформ как один EXE-файл без каких-либо отдельных зависимостей (кроме VBRUN, который присутствует практически во всем).

Ответы [ 3 ]

3 голосов
/ 27 апреля 2010

Уберите вызов DoEvents. Если вы записываете два мегабайта данных по одному байту за раз, этот цикл содержит 2097152 вызовов DoEvents. Это действительно очень замедлит процесс.

3 голосов
/ 27 апреля 2010

Ну, вы читаете и пишете каждый байт 1 по одному?В этом случае вы перебираете 2 миллиона элементов, а не просто берете кусок данных за раз и записываете их в поток.

1 голос
/ 27 апреля 2010

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
...