バイト配列のチャンクをファイル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ユーザーコントロール、名前ChunkWriterことになるだろう。これは、DoEvents関数の危険（）を呼び出すことなく、あなたの進行状況イベントを取得

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 

：次にtmrChunk（Enabled = FalseとInterval = 1）という名前のTimerコントロールと次のコードを追加します。これは、文字列を受け入れ、そのデータをUnicodeで、またはANSI変換後に書き込むように簡単に変更できます：WriteChunks（）への2行の変更。

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