将字节数组的块写入文件 VB6

Question

我正在寻找一种在VB6中将字节数组分割成“块”，并将每个“块”写入文件的有效/高效方法。这样做的原因是，当每个“块”被写入时，我可以调用RaiseEvent WriteProgress(BytesDone, BytesTotal)来更新其他地方的进度条。非常感谢有关循环结构等的任何建议。

- GRush

Answer 1

CopyMemory 是一种快速提取数组块的方法；

Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal length As Long) As Long

Const CHUNKSIZE = 3&

Dim offset As Long
Dim total  As Long
Dim copied As Long
Dim copy   As Long

Dim testBuff() As Byte: testBuff = StrConv("Klaatubaradanikto", vbFromUnicode)

total = 1 + UBound(testBuff)

'//write buffer
ReDim buff(CHUNKSIZE - 1) As Byte

Open "out.bin" For Binary Access Write As #1

For offset = 0 To -Int(-total / CHUNKSIZE) - 1 '//ghetto round-up
    If (copied + CHUNKSIZE) > total Then
        copy = total - copied
        ReDim buff(copy - 1)
    Else
        copy = CHUNKSIZE
    End If
    '//copy array segment to buffer
    CopyMemory buff(0), testBuff(offset * CHUNKSIZE), copy 
    '//write buffer
    Put #1, , buff

    copied = copied + copy
    Debug.Print offset, "copied:", copied, "of", total
    Next
Close #1

- Alex K.

---

同样的过程可以用于字符串吗？使用mid$会更容易吗？字节数据最初作为字符串传递给我，然后我将其转换为字节数组。在我看来，它的类型并不重要。 - GRush

Answer 2

稍微简短一点：

Event WriteProgress(ByVal BytesDone As Long, ByVal BytesTotal As Long)

Public Function WriteChunked(sFileName As String, baData() As Byte, Optional ByVal lChunkSize As Long = 64 * 1024&) As Boolean
    Dim nFile           As Integer
    Dim baChunk()       As Byte

    With CreateObject("ADODB.Stream")
        .Type = 1 ' adTypeBinary
        .Open
        .Write baData
        .Position = 0
        nFile = FreeFile
        Open sFileName For Binary As nFile
        Do While .Position < .Size
            baChunk = .Read(lChunkSize)
            Put nFile, , baChunk
            RaiseEvent WriteProgress(.Position, .Size)
        Loop
        Close nFile
    End With
End Function

- wqw

---

你选择默认块大小为64 *1024有什么原因吗？ - GRush

@GRush：比如说这个链接http://louwrentius.blogspot.com/2010/05/raid-level-and-chunk-size-benchmarks.html - wqw

Answer 3

我会创建一个小的InvisibleAtRuntime = True UserControl，命名为ChunkWriter。然后添加一个计时器控件，命名为tmrChunk (Enabled = False and Interval = 1)，并添加以下代码：

Option Explicit

Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
Private Const CREATE_ALWAYS As Long = 2
Private Const INVALID_HANDLE_VALUE As Long = -1

Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" ( _
    ByVal lpFileName As Long, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

Private Declare Function FlushFileBuffers Lib "kernel32" ( _
    ByVal hFile As Long) As Long

Private Declare Function WriteFile Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByVal lpBuffer As Long, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As Long) As Long

Private hFile As Long
Private bytCopy() As Byte
Private lngSize As Long
Private lngLB As Long
Private lngChunkSize As Long
Private lngNext As Long
Private lngChunks As Long
Private lngRemainder As Long

Public Event WriteProgress(ByVal BytesWritten As Long, _
                           ByVal BytesTotal As Long, _
                           ByVal Complete As Boolean)

Public Sub WriteChunks( _
    ByVal FileName As String, _
    ByRef Bytes() As Byte, _
    Optional ByVal ChunkSize As Long = 32768)

    If hFile <> INVALID_HANDLE_VALUE Then
        Err.Raise &H8004C700, TypeName(Me), "Already in use"
    End If
    hFile = CreateFile(StrPtr(FileName), GENERIC_WRITE, 0, 0, _
                       CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile = INVALID_HANDLE_VALUE Then
        Err.Raise &H8004C702, TypeName(Me), _
                  "Open failed, sys err " & CStr(Err.LastDllError)
    End If
    bytCopy = Bytes 'If Bytes is a String then bytCopy = Bytes, for ANSI use StrConv().
    lngLB = LBound(bytCopy)
    lngSize = UBound(bytCopy) - lngLB + 1
    lngChunkSize = ChunkSize
    lngNext = 0
    lngChunks = lngSize \ lngChunkSize
    lngRemainder = lngSize - (lngChunks * lngChunkSize)
    tmrChunk.Enabled = True
End Sub

Private Sub tmrChunk_Timer()
    Dim lngLen As Long
    Dim lngTemp As Long

    tmrChunk.Enabled = False
    If lngChunks > 0 Then
        lngLen = lngChunkSize
        lngChunks = lngChunks - 1
    Else
        lngLen = lngRemainder
    End If
    If WriteFile(hFile, VarPtr(bytCopy(lngLB + lngNext)), lngLen, _
                 lngTemp, 0) = 0 Then
        lngTemp = Err.LastDllError
        CloseHandle hFile
        hFile = INVALID_HANDLE_VALUE
        Err.Raise &H8004C702, TypeName(Me), _
                  "Write failed, sys err " & CStr(lngTemp)
    End If
    lngNext = lngNext + lngLen

    If lngNext < lngSize Then
        RaiseEvent WriteProgress(lngNext, lngSize, False)
        tmrChunk.Enabled = True
    Else
        FlushFileBuffers hFile
        CloseHandle hFile
        hFile = INVALID_HANDLE_VALUE
        Erase bytCopy
        RaiseEvent WriteProgress(lngNext, lngSize, True)
    End If
End Sub

Private Sub UserControl_Initialize()
    hFile = INVALID_HANDLE_VALUE
End Sub

Private Sub UserControl_Paint()
    Width = 570
    Height = 360
End Sub

这可以让您获得进度事件，而不会出现 DoEvents() 调用的风险。它很容易更改为接受一个字符串，并将其数据作为 Unicode 或经过 ANSI 转换后写入：只需对 WriteChunks() 进行两行更改即可。

- Bob77