|
2G以上の大きなファイルを比較するサンプル(VB6)

|
<このサンプルの概要>
2G以上の大きなファイルを比較するサンプルを作ってみました。
VB6のフォームにCommandButtonを1つ貼り付けてお試しください。
CheckFileSameとCheckBigFileSameの2つの関数がありますが、
2G以上に対応しているのがCheckBigFileSameです。
本サンプルのキーワードは以下のAPIです。
(1)CreateFile
(2)CloseHandle
(3)ReadFile
★フォームモジュール(Form1.frm)
Private Enum ACC_Mode
ACC_READ = 0
ACC_WRITE = 1
ACC_READWRITE = 2
End Enum
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 Sub Command1_Click()
MsgBox CheckBigFileSame(G_FilePath0, _FilePath1)
End Sub
' 関数名 : CheckFileSame
' 返り値 : 一致/不一致(True:一致、False:不一致)
' 引き数 : 無し
' 機能説明 : ファイル内容が一致しているかチェック
' 備考 :
Private Function CheckFileSame(ByVal file0 As String, _
ByVal file1 As String) As Boolean
On Error GoTo ErrHandler
Dim bytCode0() As Byte
Dim bytCode1() As Byte
Dim i As Long
Dim intFileNo As Integer
CheckFileSame = False
If Len(Dir(file0)) = 0 Or Len(Dir(file1)) = 0 Then
Exit Function
End If
If FileLen(file0) <> FileLen(file1) Then
Exit Function
End If
If FileLen(file0) - 1 < 0 Then
ReDim bytCode0(-1 To -1) As Byte
Else
ReDim bytCode0(FileLen(file0) - 1) As Byte
intFileNo = FreeFile
Open file0 For Binary As intFileNo
Get intFileNo, , bytCode0
Close
End If
If FileLen(file1) - 1 < 0 Then
ReDim bytCode1(-1 To -1) As Byte
Else
ReDim bytCode1(FileLen(file1) - 1) As Byte
intFileNo = FreeFile
Open file1 For Binary As intFileNo
Get intFileNo, , bytCode1
Close
End If
For i = 0 To UBound(bytCode0)
If i > UBound(bytCode1) Then
Exit Function
End If
If bytCode0(i) <> bytCode1(i) Then
Exit Function
End If
Next i
CheckFileSame = True
Exit Function
ErrHandler:
Close
Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
Exit Function
End Function
' 関数名 : CheckBigFileSame
' 返り値 : 一致/不一致(True:一致、False:不一致)
' 引き数 : 無し
' 機能説明 : ファイル内容が一致しているかチェック
' 備考 : 2G以上のファイル対応
Private Function CheckBigFileSame(ByVal file0 As String, _
ByVal file1 As String) As Boolean
On Error GoTo ErrHandler
CheckBigFileSame = False
Dim hFile0 As Long: hFile0 = -1
Dim hFile1 As Long: hFile1 = -1
Dim bytCode0(0 To ((1024# * 100#) - 1#)) As Byte
Dim bytCode1(0 To ((1024# * 100#) - 1#)) As Byte
Dim lngBytes0 As Long
Dim lngBytes1 As Long
Dim i As Long
hFile0 = OpenFile(file0, ACC_READ)
hFile1 = OpenFile(file1, ACC_READ)
Do
lngBytes0 = ReadBytes(hFile0, bytCode0, UBound(bytCode0) + 1)
lngBytes1 = ReadBytes(hFile1, bytCode1, UBound(bytCode1) + 1)
If lngBytes0 <> lngBytes1 Then
CloseFile hFile0
CloseFile hFile1
Exit Function
End If
For i = 0 To UBound(bytCode0)
If i > UBound(bytCode1) Then
CloseFile hFile0
CloseFile hFile1
Exit Function
End If
If bytCode0(i) <> bytCode1(i) Then
CloseFile hFile0
CloseFile hFile1
Exit Function
End If
Next i
DoEvents
Loop While lngBytes0 > 0
CloseFile hFile0
CloseFile hFile1
CheckBigFileSame = True
Exit Function
ErrHandler:
CloseFile hFile0
CloseFile hFile1
Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
Exit Function
End Function
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