|
2G以上の大きなファイルをコピーするサンプル(VB6)
|
＜このサンプルの概要＞
2G以上の大きなファイルをコピーするサンプルを作ってみました。
ファイルの属性や作成日時、更新日時等もコピーします。
VB6のフォームにCommandButtonを１つ貼り付けてお試しください。
本サンプルのキーワードは以下の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