Comparison of files

Soyez le premier à donner votre avis sur cette source.

Vue 4 306 fois - Téléchargée 316 fois

Description

C'est un petit programme qui comme son nom l'indique compare deux fichiers à l'octet et que j'ai fait il y a plus d'un an.

Toutes les fonctions sont basic car je n'en étais qu'a mes débuts dans Visual Basic et donc je ne vois pas la nécessité de commenter le code.

Toutefois s'il vous faut un renseignement ou autre je suis là.

Source / Exemple :


Option Explicit
Dim i, j As Integer
Dim Val, Val1, Val2, N1, a, b, c, d, e As String
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Const MF_REMOVE = &H1000&

Private Sub Form_Load()
Label9.Enabled = False
Label13.Visible = False
List1.Visible = True
List2.Visible = False
List3.Visible = False
List4.Visible = False
List5.Visible = False
End Sub

Private Sub Label10_Click()
MsgBox "© Nicolas H.", vbInformation, "About..."
End Sub

Private Sub Label11_Click()
If List2.Visible = True Then
List1.Visible = True
List2.Visible = False
List3.Visible = False
List4.Visible = False
List5.Visible = False
Label12.Enabled = True
Label11.Enabled = False
End If
If List3.Visible = True Then
List1.Visible = False
List2.Visible = True
List3.Visible = False
List4.Visible = False
List5.Visible = False
Label12.Enabled = True
End If
If List4.Visible = True Then
List1.Visible = False
List2.Visible = False
List3.Visible = True
List4.Visible = False
List5.Visible = False
Label12.Enabled = True
End If
If List5.Visible = True Then
List1.Visible = False
List2.Visible = False
List3.Visible = False
List4.Visible = True
List5.Visible = False
Label12.Enabled = True
End If
End Sub

Private Sub Label12_Click()
If List4.Visible = True Then
List1.Visible = False
List2.Visible = False
List3.Visible = False
List4.Visible = False
List5.Visible = True
Label11.Enabled = True
Label12.Enabled = False
End If
If List3.Visible = True Then
List1.Visible = False
List2.Visible = False
List3.Visible = False
List4.Visible = True
List5.Visible = False
Label11.Enabled = True
If List5.ListCount = "0" Then
Label12.Enabled = False
Else
Label12.Enabled = True
End If
End If
If List2.Visible = True Then
List1.Visible = False
List2.Visible = False
List3.Visible = True
List4.Visible = False
List5.Visible = False
Label11.Enabled = True
If List4.ListCount = "0" Then
Label12.Enabled = False
Else
Label12.Enabled = True
End If
End If
If List1.Visible = True Then
List1.Visible = False
List2.Visible = True
List3.Visible = False
List4.Visible = False
List5.Visible = False
Label11.Enabled = True
If List3.ListCount = "0" Then
Label12.Enabled = False
Else
Label12.Enabled = True
End If
End If
End Sub

Private Sub Label2_Click()
MsgBox "It Is Recommended To Choose The Original File", vbInformation, "Advice"
CMD.DialogTitle = "Select File One"
CMD.CancelError = True
CMD.Filter = "All Files|*.*"
CMD.FilterIndex = 1
CMD.InitDir = "C:\"
CMD.FileName = ""
On Error GoTo Annuler
CMD.ShowOpen
Text1.Text = CMD.FileName
Annuler:
Exit Sub
End Sub

Private Sub Label4_Click()
MsgBox "It Is Recommended To Choose The Patched File", vbInformation, "Advice"
CMD.DialogTitle = "Select File Two"
CMD.CancelError = True
CMD.Filter = "All Files|*.*"
CMD.FilterIndex = 1
CMD.InitDir = "C:\"
CMD.FileName = ""
On Error GoTo Annuler
CMD.ShowOpen
Text2.Text = CMD.FileName
Annuler:
Exit Sub
End Sub

Private Sub Label5_Click()
If Text1.Text = "" Then
MsgBox "Please To Select The File One", vbInformation, "Error"
Exit Sub
Else
If Text2.Text = "" Then
MsgBox "Please To Select The File Two", vbInformation, "Error"
Exit Sub
End If
End If
If FileLen(Text1.Text) = FileLen(Text2.Text) Then
Val = FileLen(Text1.Text)
If Val = "0" Then
MsgBox "Your Files Size Equal Zero", vbCritical, "Error"
Exit Sub
End If
Else
MsgBox "Your Files Size Are Not Identical", vbCritical, "Error"
Exit Sub
End If
d = InputBox("To Enter The Name And The Version Of The Program As Well As The Name Of The File." & vbCrLf & vbCrLf & "Example :   ACDSee 3.0 Eng. Build 1209 - ACDSee.exe", "Title")
If d = "" Then Exit Sub
If List1.ListCount = "0" Then
List1.AddItem d
List1.AddItem "========================================"
List1.AddItem ""
ElseIf List1.ListCount <= "31995" Then
List1.AddItem ""
List1.AddItem ""
List1.AddItem d
List1.AddItem "========================================"
List1.AddItem ""
ElseIf List1.ListCount <= "31996" Then
List1.AddItem ""
List1.AddItem ""
List1.AddItem d
List1.AddItem "========================================"
List2.AddItem ""
ElseIf List1.ListCount <= "31997" Then
List1.AddItem ""
List1.AddItem ""
List1.AddItem d
List2.AddItem "========================================"
List2.AddItem ""
ElseIf List1.ListCount <= "31998" Then
List1.AddItem ""
List1.AddItem ""
List2.AddItem d
List2.AddItem "========================================"
List2.AddItem ""
ElseIf List1.ListCount <= "31999" Then
List1.AddItem ""
List2.AddItem ""
List2.AddItem d
List2.AddItem "========================================"
List2.AddItem ""
ElseIf List2.ListCount <= "31995" Then
List2.AddItem ""
List2.AddItem ""
List2.AddItem d
List2.AddItem "========================================"
List2.AddItem ""
ElseIf List2.ListCount <= "31996" Then
List2.AddItem ""
List2.AddItem ""
List2.AddItem d
List2.AddItem "========================================"
List3.AddItem ""
ElseIf List2.ListCount <= "31997" Then
List2.AddItem ""
List2.AddItem ""
List2.AddItem d
List3.AddItem "========================================"
List3.AddItem ""
ElseIf List2.ListCount <= "31998" Then
List2.AddItem ""
List2.AddItem ""
List3.AddItem d
List3.AddItem "========================================"
List3.AddItem ""
ElseIf List2.ListCount <= "31999" Then
List2.AddItem ""
List3.AddItem ""
List3.AddItem d
List3.AddItem "========================================"
List3.AddItem ""
ElseIf List3.ListCount <= "31995" Then
List3.AddItem ""
List3.AddItem ""
List3.AddItem d
List3.AddItem "========================================"
List3.AddItem ""
ElseIf List3.ListCount <= "31996" Then
List3.AddItem ""
List3.AddItem ""
List3.AddItem d
List3.AddItem "========================================"
List4.AddItem ""
ElseIf List3.ListCount <= "31997" Then
List3.AddItem ""
List3.AddItem ""
List3.AddItem d
List4.AddItem "========================================"
List4.AddItem ""
ElseIf List3.ListCount <= "31998" Then
List3.AddItem ""
List3.AddItem ""
List4.AddItem d
List4.AddItem "========================================"
List4.AddItem ""
ElseIf List3.ListCount <= "31999" Then
List3.AddItem ""
List4.AddItem ""
List4.AddItem d
List4.AddItem "========================================"
List4.AddItem ""
ElseIf List4.ListCount <= "31995" Then
List4.AddItem ""
List4.AddItem ""
List4.AddItem d
List4.AddItem "========================================"
List4.AddItem ""
ElseIf List4.ListCount <= "31996" Then
List4.AddItem ""
List4.AddItem ""
List4.AddItem d
List4.AddItem "========================================"
List5.AddItem ""
ElseIf List4.ListCount <= "31997" Then
List4.AddItem ""
List4.AddItem ""
List4.AddItem d
List5.AddItem "========================================"
List5.AddItem ""
ElseIf List4.ListCount <= "31998" Then
List4.AddItem ""
List4.AddItem ""
List5.AddItem d
List5.AddItem "========================================"
List5.AddItem ""
ElseIf List4.ListCount <= "31999" Then
List4.AddItem ""
List5.AddItem ""
List5.AddItem d
List5.AddItem "========================================"
List5.AddItem ""
ElseIf List4.ListCount <= "31995" Then
List5.AddItem ""
List5.AddItem ""
List5.AddItem d
List5.AddItem "========================================"
List5.AddItem ""
Else
MsgBox "You Have Reached The Limit Of 160000 Difference"
Call Label9_Click
End If
ProgressBar1.Max = Val
Timer1.Interval = 1
a = 0
Open Text1.Text For Binary As #1
Open Text2.Text For Binary As #2
Label2.Enabled = False
Label4.Enabled = False
Label5.Enabled = False
Label7.Enabled = False
Label8.Enabled = False
Label10.Enabled = False
Call UnActiveX
Label9.Enabled = True
End Sub

Private Sub Label7_Click()
CMD.DialogTitle = "Save As..."
CMD.CancelError = True
CMD.Filter = "Text Files|*.txt"
CMD.FilterIndex = 1
CMD.InitDir = "C:\"
CMD.FileName = ""
On Error GoTo Annuler
CMD.ShowSave
Call SaveLst(List1, List2)
Annuler:
Exit Sub
End Sub

Private Sub Label8_Click()
List1.Clear
List2.Clear
List3.Clear
List4.Clear
List5.Clear
Label11.Enabled = False
Label12.Enabled = False
List1.Visible = True
List2.Visible = False
List3.Visible = False
List4.Visible = False
List5.Visible = False
End Sub

Private Sub SaveLst(Lst1 As ListBox, Lst2 As ListBox)
List5.Visible = False
List4.Visible = False
List3.Visible = False
List2.Visible = False
List1.Visible = False
Label13.Visible = True
Open CMD.FileName For Output As #1
For i = 0 To List1.ListCount - 1
Lst1.ListIndex = i
Print #1, Lst1.Text
Next i
For j = 0 To List2.ListCount - 1
Lst2.ListIndex = j
Print #1, Lst2.Text
Next j
Close #1
Label13.Visible = False
List1.Visible = True
List1.ListIndex = 0
MsgBox "Whole Has Well Been Safeguarded", vbInformation, "Result"
End Sub

Private Sub Label9_Click()
Timer1.Interval = "0"
Close #1
Close #2
ProgressBar1.Value = ProgressBar1.Min
Label2.Enabled = True
Label4.Enabled = True
Label5.Enabled = True
Label7.Enabled = True
Label8.Enabled = True
Label10.Enabled = True
If List1.ListCount = "32000" Then
If List2.ListCount = "0" Then
Else
Label12.Enabled = True
End If
End If
Call ActiveX
Label9.Enabled = False
End Sub

Private Sub Timer1_Timer()
On Error GoTo Finish
b = a + 1
c = a + 30000
For a = b To c
If a = Val + 1 Then
Timer1.Interval = "0"
Close #1
Close #2
ProgressBar1.Value = ProgressBar1.Min
Label2.Enabled = True
Label4.Enabled = True
Label5.Enabled = True
Label7.Enabled = True
Label8.Enabled = True
Label10.Enabled = True
Call ActiveX
Label9.Enabled = False
If List1.ListCount = "32000" Then
If List2.ListCount = "0" Then
Else
Label12.Enabled = True
End If
End If
Exit Sub
End If
ProgressBar1.Value = a
Seek #1, a
Val1 = Hex(Asc(Input(1, #1)))
Seek #2, a
Val2 = Hex(Asc(Input(1, #2)))
If Val1 = Val2 Then
Else
e = Hex(a)
If Len(e) = "1" Then
e = "0000000" & e
ElseIf Len(e) = "2" Then
e = "000000" & e
ElseIf Len(e) = "3" Then
e = "00000" & e
ElseIf Len(e) = "4" Then
e = "0000" & e
ElseIf Len(e) = "5" Then
e = "000" & e
ElseIf Len(e) = "6" Then
e = "00" & e
ElseIf Len(e) = "7" Then
e = "0" & e
End If
If Len(Val1) = "1" Then Val1 = "0" & Val1
If Len(Val2) = "1" Then Val2 = "0" & Val2
If List1.ListCount = "32000" Then
If List2.ListCount = "32000" Then
If List3.ListCount = "32000" Then
If List4.ListCount = "32000" Then
If List5.ListCount = "32000" Then
MsgBox "You Have Reached The Limit Of 160000 Difference"
Call Label9_Click
Else
List5.AddItem "Offset :  " & e & "     File One :  " & Val1 & "     File Two :  " & Val2
End If
Else
List4.AddItem "Offset :  " & e & "     File One :  " & Val1 & "     File Two :  " & Val2
End If
Else
List3.AddItem "Offset :  " & e & "     File One :  " & Val1 & "     File Two :  " & Val2
End If
Else
List2.AddItem "Offset :  " & e & "     File One :  " & Val1 & "     File Two :  " & Val2
End If
Else
List1.AddItem "Offset :  " & e & "     File One :  " & Val1 & "     File Two :  " & Val2
End If
End If
Next a
a = c
Finish:
ProgressBar1.Value = ProgressBar1.Min
Exit Sub
End Sub

Private Sub UnActiveX()
Dim hMenu As Long
Dim nCount As Long
hMenu = GetSystemMenu(Me.hwnd, 0)
nCount = GetMenuItemCount(hMenu)
Call RemoveMenu(hMenu, nCount - 1, MF_REMOVE Or MF_BYPOSITION)
Call RemoveMenu(hMenu, nCount - 2, MF_REMOVE Or MF_BYPOSITION)
DrawMenuBar Me.hwnd
End Sub

Private Sub ActiveX()
Dim hMenu As Long
Dim nCount As Long
hMenu = GetSystemMenu(Me.hwnd, 1)
nCount = GetMenuItemCount(hMenu)
Call RemoveMenu(hMenu, nCount - 1, MF_REMOVE Or MF_BYPOSITION)
Call RemoveMenu(hMenu, nCount - 2, MF_REMOVE Or MF_BYPOSITION)
DrawMenuBar Me.hwnd
End Sub

Conclusion :


Ce programme est loin d'être parfait, je m'en rend bien compte mais il ne tient qu'a vous de l'améliorer.

Le système pour enregistrer une ListBox vient de ce site ainsi que le système pour désactiver la croix du formulaire.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Je me disais bien... Certaines tournures ne font pas très "anglaises"... :)
Oui pour avoir la traduction de certain mot car mon anglais n'est pas terrible.
Tu as utilisé un traducteur auto ?
Oui s'est moi qui ait fait ca.
Je l'ai fait en anglais car au départ il n'était par pour se site mais pour le mien. Et comme tout les programmes de se genre sont en anglais j'ai fait mon programme en anglais.

PSC = ? stp
ca sent le PSC ?
Afficher les 6 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.