|
|||||
<このサンプルの概要> 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 |