NonSoft

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