用Long型数组进行文件比对

此文件比对基于二进制，最大特点，使用了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

本文地址：http://com.8s8s.com/it/it41243.htm