by Prabir Kumar Das (7 Submissions)
Category: Windows System Services
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 4th November 2006
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
The code keeps backup of files from three different locations to three different locations simultaneously.Also works if the machine is in
API Declarations
'DEVELOPED AND DISIGNED BY:PRABIR DAS
'CONTACT ME AT:[email protected]
'For this Application you need:
'1. 3 Check Boxes.
'2. 6 text Boxes.
'3. 5 Command Buttons.
'4. 3 Combo Boxes.
'5. 6 Progressbar Controls.
'6. 3 File List Box Controls.
'7. 1 ImageList control.
'8. 3 Timer Controls
'N.B:(Controls that are directly involved with the code is mentioned above.)
Dim fln, root, fld, val, val1, val2 As String
VBcoders
On Error GoTo err:
If Check1.Value = 1 Then
Text1.Enabled = True
Text4.Enabled = True
Text1.SetFocus
Else
Text1.Enabled = False
Text4.Enabled = False
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Check2_Click()
On Error GoTo err:
If Check2.Value = 1 Then
Text2.Enabled = True
Text5.Enabled = True
Text2.SetFocus
Else
Text2.Enabled = False
Text5.Enabled = False
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Check3_Click()
On Error GoTo err:
If Check3.Value = 1 Then
Text3.Enabled = True
Text6.Enabled = True
Text3.SetFocus
Else
Text3.Enabled = False
Text6.Enabled = False
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Command1_Click()
On Error GoTo err:
File1.path = Text1.Text
MkDir Text4.Text
Label6.Caption = File1.path & " (" & File1.ListCount & ") files."
val = 60 * Combo1.Text
Pr4.Max = val
Exit Sub
err:
MsgBox "Directory Already created", vbExclamation
End Sub
Private Sub Command2_Click()
On Error GoTo err:
File2.path = Text2.Text
MkDir Text5.Text
Label7.Caption = File2.path & " (" & File2.ListCount & ") files."
val1 = 60 * Combo2.Text
Pr5.Max = val1
Exit Sub
err:
MsgBox "Directory Already created", vbExclamation
End Sub
Private Sub Command3_Click()
On Error GoTo err:
File3.path = Text3.Text
MkDir Text6.Text
Label8.Caption = File3.path & " (" & File3.ListCount & ") files."
val2 = 60 * Combo2.Text
Pr6.Max = val2
Exit Sub
err:
MsgBox "Directory Already created", vbExclamation
End Sub
Private Sub Command4_Click()
On Error GoTo err:
If Len(Text4.Text) > 0 Then
Timer1.Enabled = True
Else
Timer1.Enabled = False
End If
If Len(Text5.Text) > 0 Then
Timer2.Enabled = True
Else
Timer2.Enabled = False
End If
If Len(Text6.Text) > 0 Then
Timer3.Enabled = True
Else
Timer3.Enabled = False
End If
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub Command5_Click()
On Error GoTo err:
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub ex_Click()
On Error GoTo err:
Dim i As Integer
i = MsgBox("Before Quiting make sure that all Backup Processes are stopped" & vbCrLf & "Are sure to quit?", vbYesNo + vbQuestion)
If i = vbYes Then
Unload Me
Else
End If
Exit Sub
err: MsgBox err.Description
End Sub
Private Sub File1_Click()
On Error GoTo err:
fld = File1.path
fln = File1.FileName
root = fld & "\" & fln
FileCopy root, Text4.Text & "\" & fln
Pr1.Value = Pr1.Value + 1
If Pr1.Value >= Pr1.Max Then
Pr1.Value = 0
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub File2_Click()
On Error GoTo err:
fld = File2.path
fln = File2.FileName
root = fld & "\" & fln
FileCopy root, Text5.Text & "\" & fln
Pr2.Value = Pr2.Value + 1
If Pr2.Value >= Pr2.Max Then
Pr2.Value = 0
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub File3_Click()
On Error GoTo err:
fld = File3.path
fln = File3.FileName
root = fld & "\" & fln
FileCopy root, Text6.Text & "\" & fln
Pr3.Value = Pr3.Value + 1
If Pr3.Value >= Pr3.Max Then
Pr3.Value = 0
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Form_Load()
On Error GoTo err:
Dim i As Integer
For i = 0 To 120 Step 2
Combo1.AddItem i
Combo2.AddItem i
Combo3.AddItem i
Next i
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
Text5.Enabled = False
Text6.Enabled = False
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo err:
Dim i As Integer
i = MsgBox("Before Quiting make sure that all Backup Processes are stopped" & vbCrLf & "Are sure to quit?", vbYesNo + vbQuestion)
If i = vbYes Then
Cancel = 0
Else
Cancel = 1
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub hlp_Click()
MsgBox "Change Mode: F1" & vbCrLf & "NetDel: F2" & vbCrLf & "Refresh: F5" & vbCrLf & "Restore: F6", vbInformation, "DelMas: Help"
End Sub
Private Sub Text4_Change()
On Error GoTo err:
If Len(Text4.Text) >= 0 Then
Command1.Enabled = True
Command4.Enabled = True
Else
Command1.Enabled = False
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Text5_Change()
On Error GoTo err:
If Len(Text5.Text) >= 0 Then
Command2.Enabled = True
Else
Command2.Enabled = False
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Text6_Change()
On Error GoTo err:
If Len(Text6.Text) >= 0 Then
Command3.Enabled = True
Else
Command3.Enabled = False
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub selectAll1()
On Error GoTo err:
Dim i As Integer
For i = 0 To Me.File1.ListCount - 1
Me.File1.Selected(i) = True
Next i
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub selectAll2()
On Error GoTo err:
Dim i As Integer
For i = 0 To Me.File2.ListCount - 1
Me.File2.Selected(i) = True
Next i
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub selectAll3()
On Error GoTo err:
Dim i As Integer
For i = 0 To Me.File3.ListCount - 1
Me.File3.Selected(i) = True
Next i
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Timer1_Timer()
On Error GoTo err:
Pr1.Max = File1.ListCount
Label6.Caption = File1.path & " (" & File1.ListCount & ") files."
Pr4.Value = Pr4.Value + 1
Label9.Caption = "Backing up after " & Pr4.Value & " seconds..."
If Pr4.Value >= Pr4.Max Then
selectAll1
Pr4.Value = 0
End If
File1.Refresh
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Timer2_Timer()
On Error GoTo err:
Pr2.Max = File2.ListCount
Label7.Caption = File2.path & " (" & File2.ListCount & ") files."
Pr5.Value = Pr5.Value + 1
Label10.Caption = "Backing up after " & Pr5.Value & " seconds..."
If Pr5.Value >= Pr5.Max Then
selectAll2
Pr5.Value = 0
File2.Refresh
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Timer3_Timer()
On Error GoTo err:
Pr3.Max = File3.ListCount
Label8.Caption = File3.path & " (" & File3.ListCount & ") files."
Pr6.Value = Pr6.Value + 1
Label11.Caption = "Backing up after " & Pr6.Value & " seconds..."
If Pr6.Value >= Pr6.Max Then
selectAll3
Pr6.Value = 0
End If
File3.Refresh
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo err:
If Button.Index = 1 Then
If Len(Text4.Text) > 0 Then
Timer1.Enabled = True
Else
Timer1.Enabled = False
End If
If Len(Text5.Text) > 0 Then
Timer2.Enabled = True
Else
Timer2.Enabled = False
End If
If Len(Text6.Text) > 0 Then
Timer3.Enabled = True
Else
Timer3.Enabled = False
End If
ElseIf Button.Index = 2 Then
PopupMenu stp
ElseIf Button.Index = 3 Then
PopupMenu pbp
ElseIf Button.Index = 4 Then
Unload Me
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Toolbar1_ButtonMenuClick(ByVal Button As MSComctlLib.ButtonMenu)
On Error GoTo err:
If Button.Index = 1 Then
Timer1.Enabled = True
ElseIf Button.Index = 2 Then
Timer2.Enabled = True
ElseIf Button.Index = 3 Then
Timer3.Enabled = True
End If
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub t1_Click()
On Error GoTo err:
Timer1.Enabled = False
Pr4.Value = 0
Label9.Caption = ""
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub t2_Click()
On Error GoTo err:
Timer2.Enabled = False
Pr5.Value = 0
Label10.Caption = ""
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub t3_Click()
On Error GoTo err:
Timer3.Enabled = False
Pr6.Value = 0
Label11.Caption = ""
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub Tsk1_Click()
On Error GoTo err:
Timer1.Enabled = False
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub tsk2_Click()
On Error GoTo err:
Timer2.Enabled = False
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
Private Sub tsk3_Click()
On Error GoTo err:
Timer3.Enabled = False
Exit Sub
err: MsgBox err.Description, vbCritical
End Sub
No comments have been posted about The code keeps backup of files from three different locations to three different locations simultan. Why not be the first to post a comment about The code keeps backup of files from three different locations to three different locations simultan.