File compare Utility

VERSION 5.00
Begin VB.Form frmFileCmp
Caption = "File Diff"
ClientHeight = 7440
ClientLeft = 60
ClientTop = 360
ClientWidth = 12045
Icon = "frmFileCmp.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 7440
ScaleWidth = 12045
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdCopyToClip
Caption = "C&opy Result To Clipboard"
Height = 495
Left = 9360
TabIndex = 12
Top = 5400
Width = 2295
End
Begin VB.ListBox lstLog
Height = 2595
Left = 120
TabIndex = 11
Top = 4800
Width = 9135
End
Begin VB.CommandButton cmdCmpFiles
Caption = "&Compare Files"
Height = 495
Left = 9360
TabIndex = 8
Top = 4800
Width = 2295
End
Begin VB.Frame Frame2
Caption = "Destination File Settings"
Height = 4455
Left = 6120
TabIndex = 4
Top = 0
Width = 5895
Begin VB.FileListBox fList1
Height = 3405
Left = 2880
TabIndex = 10
Top = 840
Width = 2775
End
Begin VB.DriveListBox drvSelect1
Height = 315
Left = 120
TabIndex = 6
Top = 480
Width = 2535
End
Begin VB.DirListBox dirList1
Height = 3465
Left = 120
TabIndex = 5
Top = 840
Width = 2535
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "Destination File(s)"
Height = 195
Left = 2880
TabIndex = 14
Top = 600
Width = 1245
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "Drive / Path:"
Height = 195
Left = 120
TabIndex = 7
Top = 240
Width = 915
End
End
Begin VB.Frame Frame1
Caption = "Source File Settings"
Height = 4455
Left = 0
TabIndex = 0
Top = 0
Width = 6015
Begin VB.FileListBox fList
Height = 3405
Left = 2880
TabIndex = 9
Top = 960
Width = 2775
End
Begin VB.DirListBox dirList
Height = 3465
Left = 120
TabIndex = 2
Top = 840
Width = 2535
End
Begin VB.DriveListBox drvList
Height = 315
Left = 120
TabIndex = 1
Top = 480
Width = 2535
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Source File(s)"
Height = 195
Left = 2880
TabIndex = 13
Top = 600
Width = 960
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Drive / Path:"
Height = 195
Left = 120
TabIndex = 3
Top = 240
Width = 915
End
End
Begin VB.Label Label7
Caption = "Comparison Result:"
Height = 255
Left = 120
TabIndex = 15
Top = 4560
Width = 3135
End
End
Attribute VB_Name = "frmFileCmp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmbPattern_Click()
Dim pos1 As Integer
Dim pos2 As Integer
Dim txt As String

txt = cmbPattern.Text
pos1 = InStrRev(txt, "(")
pos2 = InStrRev(txt, ")")
fList.Pattern = Mid$(txt, pos1 + 1, pos2 - pos1 - 1)

End Sub

Private Sub cmdCmpFiles_Click()
Me.MousePointer = vbHourglass
lstLog.Clear
Dim i As Integer, j As Integer
Dim bFound As Boolean
Dim aCmpReply As String
For i = 0 To fList.ListCount - 1
If (fList.List(i) = fList1.List(i)) Then
aCmpReply = FileCompare(dirList.Path & "\" & fList.List(i), dirList1.Path & "\" & fList1.List(i))
If (InStr(aCmpReply, "%")) Then
lstLog.AddItem "File " & fList.List(i) & " is " & aCmpReply & " equal"
Else
lstLog.AddItem ">>>>>>> File " & fList.List(i) & " has diffrent file size. <<<<<<"
End If
Else
bFound = False
'check file name in dest and compare
For j = 0 To fList1.ListCount - 1
If fList.List(i) = fList1.List(j) Then
aCmpReply = FileCompare(dirList.Path & "\" & fList.List(i), dirList1.Path & "\" & fList1.List(j))
If (InStr(aCmpReply, "%")) Then
lstLog.AddItem "File " & fList.List(i) & " is " & aCmpReply & " equal"
Else
lstLog.AddItem ">>>>>>> File " & fList.List(i) & " has diffrent file size. <<<<<<"
End If
bFound = True
End If
Next
If bFound = False Then
lstLog.AddItem "File Name not found for comparision - " & fList.List(i)
End If
End If
DoEvents
Next i

Me.MousePointer = vbDefault
End Sub

Private Sub cmdCopyToClip_Click()
Dim tmpMsg As String
Clipboard.Clear
For i = 0 To lstLog.ListCount - 1
tmpMsg = tmpMsg & vbCrLf & lstLog.List(i)
Next i
Clipboard.SetText tmpMsg
End Sub

Private Sub dirList_Change()
fList.Path = dirList.Path
End Sub

Private Sub fList_PatternChange()
fileList.Clear

Dim i As Integer
For i = 0 To fList.ListCount - 1
fileList.AddItem fList.List(i)
Next
End Sub

Private Sub drvSelect_Change()
'On Error GoTo DriveError
dirList.Path = drvList.Drive
Exit Sub

DriveError:
drvList.Drive = dirList.Path
Exit Sub

End Sub
'Private Sub cmdSelList_Click()
' Dim i As Integer
' If cmdSelList.Caption = "&Select All" Then
' cmdSelList.Caption = "&Deselect All"
' For i = 0 To fileList.ListCount - 1
' fileList.Selected(i) = True
' Next i
'
' Else
' cmdSelList.Caption = "&Select All"
' For i = 0 To fileList.ListCount - 1
' fileList.Selected(i) = False
' Next i
'
' End If
'
'End Sub

Public Function FileCompare(File1 As String, File2 As String) As String
Dim f1() As Byte ' our array For the first file
Dim f2() As Byte ' our array For the second file
Dim Alike As Long
Alike& = 0 'needed For the percent part
filelen1 = FileLen(File1$) 'file length of first file
FileLen2 = FileLen(File2$) 'file length of second file
If filelen1 <> FileLen2 Then FileCompare$ = "Different file size": Exit Function
'if file sizes are different, then they
' are not the same
ReDim f1(1 To filelen1) 'since we now have the file length, lets activate the arrays
ReDim f2(1 To FileLen2)
Open File1 For Binary Access Read As #1
Open File2 For Binary Access Read As #2
Get #1, 1, f1()
Get #2, 1, f2()
Close #2
Close #1
'this opens up the files, gets all the d
' ata and stores them in our arrays


For i = 1 To filelen1 Step 6
If f1(i) = f2(i) Then Alike = Alike + 1
'if they are the same, add 1 to alike co
' unter
If i + 1 > filelen1 Then GoTo skipout
'if we exceed the length of the file, th
' en leave the for,next statement IMMEDIAT
' ELY
If f1(i + 1) = f2(i + 1) Then Alike = Alike + 1
If i + 2 > filelen1 Then GoTo skipout
If f1(i + 2) = f2(i + 2) Then Alike = Alike + 1
If i + 3 > filelen1 Then GoTo skipout
If f1(i + 3) = f2(i + 3) Then Alike = Alike + 1
If i + 4 > filelen1 Then GoTo skipout
If f1(i + 4) = f2(i + 4) Then Alike = Alike + 1
If i + 5 > filelen1 Then GoTo skipout
If f1(i + 5) = f2(i + 5) Then Alike = Alike + 1


Next i
skipout:
Dim res As Double
res = Alike / filelen1 * 100
FileCompare$ = CStr(Format(res, "###.####")) & "%" 'FormatPercent(Alike / filelen1, 5))
'divide alike from filelength and format
' it into a percent
End Function



Private Sub dirList1_Change()
fList1.Path = dirList1.Path
End Sub

Private Sub fList1_PatternChange()
fileList.Clear

Dim i As Integer
For i = 0 To fList.ListCount - 1
fileList.AddItem fList.List(i)
Next
End Sub

Private Sub drvSelect1_Change()
'On Error GoTo DriveError
dirList.Path = drvList.Drive
Exit Sub

DriveError:
drvList.Drive = dirList.Path
Exit Sub

End Sub