将字节数组块写入文件 VB6

Question

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

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

Answer 2

我会做一个小的InvisibleAtRuntime = True UserControl，命名为ChunkWriter。然后添加一个名为tmrChunk（Enabled = False和Interval = 1）的Timer控件和如下代码：

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() 进行两行更改。

Answer 3

稍微短一点：

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