Accueil > > > COMPARISON OF FILES
 COMPARISON OF FILES
 Information sur la source
 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
- 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
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.
 Sources du même auteur
 Sources de la même categorie
 Commentaires et avis
 Discussions en rapport avec ce code source dans le forum
recherhce de fichier [ par dsigmoun ]
Mon logiciel recherche les éléments présents dans un dossier avec ce code :Dim typerecherche As StringDim files() As System.IO.FileInfo = dirInfo.GetF
[Catégorie modifiée .Net --> VBA] Macro comparaison entre deux classeurs et mise a jour [ par pluschaud ]
Bonjour, je ne m'y connais pas en VB et les syntaxes m'echappent encore. J'ai quelques notion en programmation C. J'ai deux fichiers excel à ma dispos
URGENT : Comparaison de 2 fichier txt [ par Koundelitch ]
Debutant en VBA je souhaiterais comparer 2 fichiers pour voir si ils comportentdes differences et notifier ces differences ds un troisieme fichier txt
comparaison de fichier texte [ par VBteur ]
Bonjour a tous !!!Pourriez vous m'aider concernant la comparaison de fichiers .txt. J'aimerais comparer le contenu de 2 fichiers. Cette comparaison au
Comparaison de données [ par Gendarmette ]
J'ai inséré 2 bases de données dans VB. Un même fichier peut se trouver dans les 2 bd, l'un étant en fait une modification de l'autre. Je souhaite tro
comparaison fichier [ par damd ]
salut a tousj'aimerai faire un prpgramme qui me dise si deux fichier sont identiques.si quelqu'un a une ideemerci
filelistbox (comparaison?) [ par CCJ ]
slt!comment fait on pour enregistrer le contenu d'un filelistbox dans un fichier texte et par la suite pour comparer le contenu du fichier text avec m
Comparaison de 2 fichiers texte [ par juliocasa ]
Bonjour a tous,Je dispose d´un fichier texte A qui comporte des lignes de la formeX1;Y1;Z1X2;Y2;Z2...X1000;Y1000;Z1000J´ai egalement un se
lecture d'un fichier et comparaison [ par alex102 ]
bonjour a tous et a touteJ'ai un petit problèmeJ'ai un fichier csv et une base de donnéesdans mon fichier csv le premier mot est une clef primaireJe v
Binary files [ par S16 ]
Bonjour,Quand on crée une form, on peut voir un fichier de type "Visual Basic Form File". Mais dans certain cas, il y a aussi un fichier de type "Visu
|
Derniers Blogs
 [HTML5] SLIDES ET DéMOS : AUTOUR DU W3C , NOUVEAUX STANDARDS ET WEB MOBILE (LILLE)[HTML5] SLIDES ET DéMOS : AUTOUR DU W3C , NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio
Très bonne après-midi passée lors cette conférence avec le W3C, organisée par L' Inria sur les nouveaux standards, ce Mardi 14 Février, on sent vraiment que çà bosse chez eux, et l'avenir est très très prometteur pour le HTML5, notammen...
Cliquez pour lire la suite de l'article par Gio GESTION D'EXCEPTION AVEC LES TASKSGESTION D'EXCEPTION AVEC LES TASKS par richardc
Nous avons vu dans un précédent article comment utiliser Task pour effectuer des opérations dans un autre thread.
Malheureusement, comme tout le monde n'est pas parfait, il se peut que cette exécution se passe mal et qu'une exception se produise.
La...
Cliquez pour lire la suite de l'article par richardc DéMARRONS AVEC LES TASKSDéMARRONS AVEC LES TASKS par richardc
Que vous le vouliez ou non, le développement multi-tâche est maintenant une obligation pour toute nouvelle application. Il est donc vital d'en comprendre les mécanismes et de s'y mettre le plus tôt possible.
En attendant le .NET Framework 4.5 avec le...
Cliquez pour lire la suite de l'article par richardc SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPSSLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko
Retrouvez les slides et les démo de ma session Fast & Furious XAML Apps. A ceux qui se posent la question : "est-ce que le code de la DataGrid est disponible?", je vous répondrais "pas encore". Je vais mettre en place un projet codeplex pour part...
Cliquez pour lire la suite de l'article par Vko XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc
Forum
 RE : VITESSERE : VITESSE par Renfield
Cliquez pour lire la suite par Renfield RE : VITESSERE : VITESSE par ucfoutu
Cliquez pour lire la suite par ucfoutu MACRO VBA EXCELMACRO VBA EXCEL par sigma17
Cliquez pour lire la suite par sigma17
Logiciels
 DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|