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