Function IsDuplicateFile(ByVal strFullNameFile_1 As String, ByVal strFullNameFile_2 As String, _
Optional blCheckBy_MD5andHA1 As Boolean = False) As Boolean
Dim strFileKind_1 As String, strSize_1 As String, strExtension_1 As String, strDateModified_1 As String
Dim strFileKind_2 As String, strSize_2 As String, strExtension_2 As String, strDateModified_2 As String
Dim strMD5_1 As String, strHA1_1 As String, strMD5_2 As String, strHA1_2 As String
Dim blCheck As Boolean
strFileKind_1 = GetInfoFile(strFullNameFile_1, 11): strFileKind_2 = GetInfoFile(strFullNameFile_2, 11)
strDateModified_1 = GetInfoFile(strFullNameFile_1, 3): strDateModified_2 = GetInfoFile(strFullNameFile_2, 3)
With CreateObject("Scripting.FileSystemObject")
strSize_1 = .GetFile(strFullNameFile_1).Size: strSize_2 = .GetFile(strFullNameFile_2).Size
strExtension_1 = .GetExtensionName(strFullNameFile_1): strExtension_2 = .GetExtensionName(strFullNameFile_2)
End With
strMD5_1 = FileToMD5Hex(strFullNameFile_1): strMD5_2 = FileToMD5Hex(strFullNameFile_2)
strHA1_1 = FileToSHA1Hex(strFullNameFile_1): strHA1_2 = FileToSHA1Hex(strFullNameFile_2)
blCheck = strFileKind_1 = strFileKind_2 And strExtension_1 = strExtension_2 And strSize_1 = strSize_2
If blCheckBy_MD5andHA1 Then
blCheck = blCheck And strMD5_1 = strMD5_2 And strHA1_1 = strHA1_1
Else
blCheck = blCheck And strDateModified_1 = strDateModified_2
End If
If blCheck Then IsDuplicateFile = True Else IsDuplicateFile = False
End Function
Function GetInfoFile(ByVal strFullNameFile As String, ByVal iIndex As Integer) As String
Dim fldName As String, fleName As String, strResult As String, vSpecialChar
'On Error Resume Next
With CreateObject("Scripting.FileSystemObject")
fldName = .GetFile(strFullNameFile).ParentFolder.path
fleName = .GetFile(strFullNameFile).Name
End With
With CreateObject("Shell.Application")
With .Namespace("" & fldName & "")
strResult = .Getdetailsof(.ParseName("" & fleName & ""), iIndex)
For Each vSpecialChar In Array(ChrW(8206), ChrW(8207), ChrW(8234), ChrW(8236))
strResult = Replace(strResult, vSpecialChar, "")
Next vSpecialChar
End With
End With
On Error GoTo 0
GetInfoFile = strResult
End Function
Function FileToMD5Hex(sFileName As String) As String
Dim enc
Dim bytes
Dim outstr As String
Dim pos As Integer
Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
'Convert the string to a byte array and hash it
bytes = GetFileBytes(sFileName)
bytes = enc.ComputeHash_2((bytes))
'Convert the byte array to a hex string
For pos = 1 To LenB(bytes)
outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
Next
FileToMD5Hex = outstr
Set enc = Nothing
End Function
Function FileToSHA1Hex(sFileName As String) As String
Dim enc
Dim bytes
Dim outstr As String
Dim pos As Integer
Set enc = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
'Convert the string to a byte array and hash it
bytes = GetFileBytes(sFileName)
bytes = enc.ComputeHash_2((bytes))
'Convert the byte array to a hex string
For pos = 1 To LenB(bytes)
outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
Next
FileToSHA1Hex = outstr 'Returns a 40 byte/character hex string
Set enc = Nothing
End Function
Function GetFileBytes(ByVal path As String) As Byte()
Dim lngFileNum As Long
Dim bytRtnVal() As Byte
lngFileNum = FreeFile
If LenB(Dir(path)) Then ''// Does file exist?
Open path For Binary Access Read As lngFileNum
ReDim bytRtnVal(LOF(lngFileNum) - 1&) As Byte
Get lngFileNum, , bytRtnVal
Close lngFileNum
Else
Err.Raise 53
End If
GetFileBytes = bytRtnVal
Erase bytRtnVal
End Function
Vì chả biết liệt kê các file như thế nào nên tôi giả sử có dữ liệu đầu vô là danh sách files, danh sách độ dài tương ứng và sai số của file size, thư mục chứa file. Và dưới đây là code hoạt động của tôi
