NonSoft

2G以上の大きなファイルをコピーするサンプル(VB6)


 サンプル(ソース/コード)
<このサンプルの概要>
2G以上の大きなファイルをコピーするサンプルを作ってみました。
ファイルの属性や作成日時、更新日時等もコピーします。
VB6のフォームにCommandButtonを1つ貼り付けてお試しください。

本サンプルのキーワードは以下のAPIです。
(1)CreateFile
(2)CloseHandle
(3)ReadFile
(4)WriteFile
(5)GetFileAttributes
(6)SetFileAttributes
(7)GetFileTime
(8)SetFileTime
(9)FileTimeToLocalFileTime
(10)LocalFileTimeToFileTime
(11)FileTimeToSystemTime
(12)SystemTimeToFileTime

関連情報:
アイドル☆バックアップ
通常作業のバックグラウンドで密かにバックアップ/フォルダ同期するツールです。

★フォームモジュール(Form1.frm)
Private Enum ACC_Mode
    ACC_READ = 0
    ACC_WRITE = 1
    ACC_READWRITE = 2
End Enum
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const TRUNCATE_EXSTING = 5
Private Declare Function ReadFile Lib "KERNEL32" _
    (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
     lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "KERNEL32" _
    (ByVal hObject As Long) As Long
Private Declare Function WriteFile Lib "KERNEL32" _
    (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
     lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFile Lib "KERNEL32" Alias "CreateFileA" _
    (ByVal lpFileName As String, 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 FileTimeToLocalFileTime Lib "KERNEL32" _
    (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function LocalFileTimeToFileTime Lib "KERNEL32" _
    (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "KERNEL32" _
    (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function SystemTimeToFileTime Lib "KERNEL32" _
    (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function GetFileTime Lib "KERNEL32" _
    (ByVal hFile As Long, lpCreationTime As FILETIME, _
     lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SetFileTime Lib "KERNEL32" _
    (ByVal hFile As Long, lpCreationTime As FILETIME, _
     lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function GetFileAttributes Lib "KERNEL32" Alias "GetFileAttributesA" _
    (ByVal lpFileName$) As Long
Private Declare Function SetFileAttributes Lib "KERNEL32" Alias "SetFileAttributesA" _
    (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long

Private Sub Command1_Click()
    Call CopyFile(G_File0, G_File1)
End Sub

Private Sub CopyFile( _
    ByVal file0 As String, ByVal file1 As String)
    On Error GoTo ErrHandler
    
    Dim hFile0 As Long: hFile0 = -1
    Dim hFile1 As Long: hFile1 = -1
    Dim bytCode(0 To ((1024# * 100#) - 1#)) As Byte
    Dim lngBytes As Long
    Dim dCrTime As Date
    Dim dAcTime As Date
    Dim dWrTime As Date
    Dim dblTotal As Double
    dblTotal = 0
    
    hFile0 = OpenFile(file0, ACC_READ)
    hFile1 = OpenFile(file1, ACC_WRITE)
    Do
        lngBytes = ReadBytes(hFile0, bytCode, UBound(bytCode) + 1)
        dblTotal = dblTotal + lngBytes
        If lngBytes > 0 Then
            lngBytes = WriteBytes(hFile1, bytCode, lngBytes)
        End If
        DoEvents
    Loop While lngBytes > 0
    
    SetAttributes file0, GetAttributes(file1)
    GetTimes hFile0, dCrTime, dAcTime, dWrTime
    SetTimes hFile1, dCrTime, dAcTime, dWrTime
    
    CloseFile hFile0
    CloseFile hFile1
    Exit Sub
ErrHandler:
    CloseFile hFile0
    CloseFile hFile1
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
    Exit Sub
End Sub

Private Function OpenFile( _
    ByVal sFileName As String, ByVal iMode As ACC_Mode) As Long
    Dim AccessMode As Long
    Dim ShareMode As Long
    Dim CreationMode As Long
    If iMode = 0 Then
        AccessMode = GENERIC_READ
        ShareMode = FILE_SHARE_READ Or FILE_SHARE_WRITE
        CreationMode = OPEN_EXISTING
    ElseIf iMode = 1 Then
        AccessMode = GENERIC_WRITE
        ShareMode = FILE_SHARE_READ Or FILE_SHARE_WRITE
        CreationMode = CREATE_ALWAYS
    ElseIf iMode = 2 Then
        AccessMode = GENERIC_WRITE Or GENERIC_READ
        ShareMode = FILE_SHARE_READ Or FILE_SHARE_WRITE
        CreationMode = OPEN_ALWAYS
    Else
        AccessMode = GENERIC_READ
        ShareMode = FILE_SHARE_READ Or FILE_SHARE_WRITE
        CreationMode = OPEN_EXISTING
    End If
    OpenFile = CreateFile(sFileName, AccessMode, ShareMode, _
                       0, CreationMode, FILE_ATTRIBUTE_NORMAL, 0)
End Function

Private Sub CloseFile( _
    ByVal hFile As Long)
    If hFile >= 0 Then
        CloseHandle hFile
    End If
End Sub

Public Function ReadBytes( _
    ByVal hFile As Long, ByRef Bytes() As Byte, ByVal ByteCount As Long) As Long
    Dim BytesRead As Long
    BytesRead = 0
    ReadFile hFile, Bytes(0), ByteCount, BytesRead, 0
    ReadBytes = BytesRead
End Function

Private Function WriteBytes( _
    ByVal hFile As Long, DataBytes() As Byte, ByVal ByteCount As Long) As Long
    Dim BytesWritten As Long
    BytesWritten = 0
    WriteFile hFile, DataBytes(LBound(DataBytes)), ByteCount, BytesWritten, 0
    WriteBytes = BytesWritten
End Function

Public Sub GetTimes( _
    ByVal hFile As Long, ByRef dCrTime As Date, _
    ByRef dAcTime As Date, ByRef dWrTime As Date)
    Dim rCrTime As FILETIME
    Dim rAcTime As FILETIME
    Dim rWrTime As FILETIME
    Dim rLoTime As FILETIME
    Dim rSyTime As SYSTEMTIME
    
    GetFileTime hFile, rCrTime, rAcTime, rWrTime
    
    FileTimeToLocalFileTime rCrTime, rLoTime
    FileTimeToSystemTime rLoTime, rSyTime
    dCrTime = Format(rSyTime.wYear, "0000") & "/" & _
              Format(rSyTime.wMonth, "00") & "/" & _
              Format(rSyTime.wDay, "00") & " " & _
              Format(rSyTime.wHour, "00") & ":" & _
              Format(rSyTime.wMinute, "00") & ":" & _
              Format(rSyTime.wSecond, "00")
              
    FileTimeToLocalFileTime rAcTime, rLoTime
    FileTimeToSystemTime rLoTime, rSyTime
    dAcTime = Format(rSyTime.wYear, "0000") & "/" & _
              Format(rSyTime.wMonth, "00") & "/" & _
              Format(rSyTime.wDay, "00") & " " & _
              Format(rSyTime.wHour, "00") & ":" & _
              Format(rSyTime.wMinute, "00") & ":" & _
              Format(rSyTime.wSecond, "00")
    
    FileTimeToLocalFileTime rWrTime, rLoTime
    FileTimeToSystemTime rLoTime, rSyTime
    dWrTime = Format(rSyTime.wYear, "0000") & "/" & _
              Format(rSyTime.wMonth, "00") & "/" & _
              Format(rSyTime.wDay, "00") & " " & _
              Format(rSyTime.wHour, "00") & ":" & _
              Format(rSyTime.wMinute, "00") & ":" & _
              Format(rSyTime.wSecond, "00")
End Sub
         
Public Sub SetTimes( _
    ByVal hFile As Long, ByVal dCrTime As Date, _
    ByVal dAcTime As Date, ByVal dWrTime As Date)
    Dim rCrTime As FILETIME
    Dim rAcTime As FILETIME
    Dim rWrTime As FILETIME
    Dim rLoTime As FILETIME
    Dim rSyTime As SYSTEMTIME
    
    rSyTime.wYear = Year(dCrTime)
    rSyTime.wMonth = Month(dCrTime)
    rSyTime.wDay = Day(dCrTime)
    rSyTime.wHour = Hour(dCrTime)
    rSyTime.wMinute = Minute(dCrTime)
    rSyTime.wSecond = Second(dCrTime)
    SystemTimeToFileTime rSyTime, rLoTime
    LocalFileTimeToFileTime rLoTime, rCrTime
    
    rSyTime.wYear = Year(dAcTime)
    rSyTime.wMonth = Month(dAcTime)
    rSyTime.wDay = Day(dAcTime)
    rSyTime.wHour = Hour(dAcTime)
    rSyTime.wMinute = Minute(dAcTime)
    rSyTime.wSecond = Second(dAcTime)
    SystemTimeToFileTime rSyTime, rLoTime
    LocalFileTimeToFileTime rLoTime, rAcTime
    
    rSyTime.wYear = Year(dWrTime)
    rSyTime.wMonth = Month(dWrTime)
    rSyTime.wDay = Day(dWrTime)
    rSyTime.wHour = Hour(dWrTime)
    rSyTime.wMinute = Minute(dWrTime)
    rSyTime.wSecond = Second(dWrTime)
    SystemTimeToFileTime rSyTime, rLoTime
    LocalFileTimeToFileTime rLoTime, rWrTime
    
    SetFileTime hFile, rCrTime, rAcTime, rWrTime
End Sub

Public Function GetAttributes( _
    ByVal sFName As String) As Long
    GetAttributes = GetFileAttributes(sFName)
End Function

Public Sub SetAttributes( _
    ByVal sFName As String, ByVal attr As Long)
    SetFileAttributes sFName, attr
End Sub