此文件比对基于二进制,最大特点,使用了Long型数组,采用32系统最擅长的数据类型进行比对,速度明显快于Byte数组。
Option Explicit
Private CencelCopy As Boolean
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Sub Command1_Click()
Dim Pos As Long
Command1.Enabled = False
Command2.Enabled = True
Pos = CompFile(Text1.Text, Text2.Text)
Command1.Enabled = True
Command2.Enabled = False
Select Case Pos
Case -2
MsgBox "File not Exist"
Case -1
MsgBox "User Cancel"
Case 1
MsgBox "Len Error"
Case 0
MsgBox "Compare OK"
Case Else
MsgBox "Compare Fail in " & Pos
End Select
End Sub
Private Function CompFile(File1 As String, File2 As String) As Long
Dim i As Long, k As Long
Dim Pos As Long, EventsNum As Long
Dim FileNo As Integer, FileNo1 As Integer, FileLast() As Byte, FileLast1() As Byte
Dim AllLen As Long, OneLen As Integer, BufLen As Long
'Long型比对
Dim Buf() As Long, Buf1() As Long
BufLen = 8192
OneLen = 4
'Byte型比对
'Dim Buf() As Byte, Buf1() As Byte
'BufLen = 25600
'Onelen = 1
Dim t As Single
t = Timer - 0.1 '减 0.1 是防止测速运算的除零错误,同时也能消除点缓存对测速的影响
If Dir(File1) = "" Or Dir(File2) = "" Or File1 = "" Or File2 = "" Then CompFile = -2: Exit Function
CencelCopy = False
FileNo = FreeFile
Open File1 For Binary Access Read As #FileNo
AllLen = LOF(FileNo)
Pos = 1
EventsNum = 1
FileNo1 = FreeFile
Open File2 For Binary Access Read As #FileNo1
If LOF(FileNo1) <> AllLen Then CompFile = 1: GoTo ext
ReDim Buf(BufLen - 1)
ReDim Buf1(BufLen - 1)
Do While Pos + BufLen * OneLen - 1 <= AllLen
Get #FileNo, , Buf
Get #FileNo1, , Buf1
For k = 0 To UBound(Buf)
If Buf(k) <> Buf1(k) Then
CompFile = Pos + k * OneLen
' ReDim FileLast(3) '若想精确定位不同处在哪个字节,可加上这段
' ReDim FileLast1(3)
' CopyMemory FileLast(0), Buf(k), 4
' CopyMemory FileLast1(0), Buf1(k), 4
' For i = 0 To 3
' If FileLast(i) <> FileLast1(i) Then Exit For
' Next
' CompFile = CompFile + i
GoTo ext
End If
Next
If EventsNum Mod 10 = 0 Then
Cls
Print Pos, Round(Timer - t, 2), Round((Pos / (Timer - t)) / 1024, 2) & "KB/S"
DoEvents
If CencelCopy Then CompFile = -1: GoTo ext
End If
EventsNum = EventsNum + 1
Pos = Pos + BufLen * OneLen
Loop
ReDim FileLast(AllLen - Pos)
ReDim FileLast1(AllLen - Pos)
Get #FileNo, , FileLast
Get #FileNo1, , FileLast1
For k = 0 To UBound(FileLast)
If FileLast(k) <> FileLast1(k) Then CompFile = Pos + k: GoTo ext
Next
Pos = AllLen
ext:
Close #FileNo1
Close #FileNo
CencelCopy = True
Cls
Print Pos, Round(Timer - t, 2), Round((Pos / (Timer - t)) / 1024, 2) & "KB/S"
End Function
Private Sub Command2_Click()
CencelCopy = True
End Sub
Private Sub Form_Load()
CencelCopy = True
Command1.Enabled = True
Command2.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If CencelCopy = False Then
CencelCopy = True
Cancel = 1
End If
End Sub