📄 databackup.ctl
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.UserControl DataBackup
ClientHeight = 3315
ClientLeft = 0
ClientTop = 0
ClientWidth = 6015
LockControls = -1 'True
ScaleHeight = 3315
ScaleWidth = 6015
ToolboxBitmap = "DataBackup.ctx":0000
Begin MSComDlg.CommonDialog dlgBrowser
Left = 105
Top = -345
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame1
BackColor = &H00C0C0C0&
ForeColor = &H00FF0000&
Height = 3360
Left = 0
TabIndex = 8
Top = -60
Width = 5985
Begin VB.PictureBox picStatus
BackColor = &H00FF0000&
Height = 165
Left = 255
ScaleHeight = 105
ScaleWidth = 5445
TabIndex = 15
Top = 1695
Visible = 0 'False
Width = 5505
Begin VB.Label lbStatus
Height = 165
Left = 0
TabIndex = 16
Top = 0
Width = 5505
End
End
Begin VB.CommandButton cmdRestore
Caption = "开始恢复"
Height = 900
Left = 4770
Picture = "DataBackup.ctx":0312
Style = 1 'Graphical
TabIndex = 14
Top = 2205
Width = 990
End
Begin VB.CommandButton cmdBackup
Caption = "开始备份"
Height = 915
Left = 4755
Picture = "DataBackup.ctx":0BDC
Style = 1 'Graphical
TabIndex = 13
Top = 630
Width = 990
End
Begin VB.CommandButton cmdSelect4
Caption = ".."
Height = 240
Left = 4380
TabIndex = 7
Top = 2835
Width = 315
End
Begin VB.CommandButton cmdSelect2
Caption = ".."
Height = 240
Left = 4380
TabIndex = 5
Top = 1290
Width = 315
End
Begin VB.TextBox txtBackupFileTo
Height = 285
Left = 255
TabIndex = 1
Top = 1260
Width = 4455
End
Begin VB.CommandButton cmdSelect3
Caption = ".."
Height = 240
Left = 4380
TabIndex = 6
Top = 2250
Width = 315
End
Begin VB.TextBox txtRestoreFileFrom
Height = 285
Left = 240
TabIndex = 2
Top = 2220
Width = 4470
End
Begin VB.CommandButton cmdSelect1
Caption = ".."
Height = 240
Left = 4380
TabIndex = 4
Top = 675
Width = 315
End
Begin VB.TextBox txtBackupFileFrom
Height = 285
Left = 255
TabIndex = 0
Top = 645
Width = 4455
End
Begin VB.TextBox txtRestoreFileTo
Height = 285
Left = 240
TabIndex = 3
Top = 2805
Width = 4470
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请选择需要《恢复》到的目录："
ForeColor = &H000040C0&
Height = 180
Index = 1
Left = 285
TabIndex = 12
Top = 2580
Width = 2520
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请选择需要《备份》到的目录："
ForeColor = &H000040C0&
Height = 180
Index = 1
Left = 270
TabIndex = 11
Top = 1020
Width = 2520
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 1
X1 = 255
X2 = 5745
Y1 = 1770
Y2 = 1770
End
Begin VB.Line Line1
Index = 0
X1 = 270
X2 = 5730
Y1 = 1755
Y2 = 1755
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请选择需要《恢复》的文件："
ForeColor = &H00008000&
Height = 180
Index = 0
Left = 285
TabIndex = 10
Top = 1980
Width = 2340
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请选择需要《备份》的文件："
ForeColor = &H00800000&
Height = 180
Index = 0
Left = 255
TabIndex = 9
Top = 405
Width = 2340
End
End
End
Attribute VB_Name = "DataBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Sub cmdBackup_Click()
On Error GoTo BackupErr
'检测备份路径与其它是否为空
If Trim(txtBackupFileFrom.Text) = "" Then
MsgBox "对不起，请输入要备份的文件后，才能备份！ ", vbInformation
txtBackupFileFrom.SetFocus
Exit Sub
End If
If Dir(Trim(txtBackupFileFrom.Text), vbNormal) = "" Then
MsgBox "Sorry，输入备份的文件不存在或不能访问？ ", vbInformation
txtBackupFileFrom.SetFocus
Exit Sub
End If
If Trim(txtBackupFileTo.Text) = "" Then
MsgBox "对不起，请输入备份路径，才能备份！ ", vbInformation
txtBackupFileTo.SetFocus
Exit Sub
End If
If Dir(Trim(txtBackupFileTo.Text), vbDirectory) = "" Then
MsgBox "Sorry，输入备份的路径不存在或不能访问？ ", vbInformation
txtBackupFileTo.SetFocus
Exit Sub
End If
'给出备份的文件名
If Right(txtBackupFileTo.Text, 1) <> "\" Then
txtBackupFileTo.Text = txtBackupFileTo.Text & GetFileName(txtBackupFileFrom.Text)
Else
txtBackupFileTo.Text = Left(txtBackupFileTo.Text, Len(txtBackupFileTo.Text) - 1) & GetFileName(txtBackupFileFrom.Text)
End If
Screen.MousePointer = 11
StartIt "Backup"
Screen.MousePointer = 0
Exit Sub
BackupErr:
MsgBox "备份文件错误:" & Err.Description, vbCritical
Exit Sub
End Sub
Private Sub cmdRestore_Click()
On Error GoTo BackupErr
'检测备份路径与其它是否为空
If Trim(txtRestoreFileFrom.Text) = "" Then
MsgBox "对不起，请输入要恢复的文件后，才能备份！ ", vbInformation
txtRestoreFileFrom.SetFocus
Exit Sub
End If
If Dir(Trim(txtRestoreFileFrom.Text), vbNormal) = "" Then
MsgBox "Sorry，输入恢复的文件不存在或不能访问？ ", vbInformation
txtRestoreFileFrom.SetFocus
Exit Sub
End If
If Trim(txtRestoreFileTo.Text) = "" Then
MsgBox "对不起，请输入要恢复路径，才能恢复！ ", vbInformation
txtRestoreFileTo.SetFocus
Exit Sub
End If
If Dir(Trim(txtRestoreFileTo.Text), vbDirectory) = "" Then
MsgBox "Sorry，输入恢复的路径不存在或不能访问？ ", vbInformation
txtRestoreFileTo.SetFocus
Exit Sub
End If
Screen.MousePointer = 11
StartIt "Restore"
Screen.MousePointer = 0
Exit Sub
BackupErr:
MsgBox "恢复文件错误:" & Err.Description, vbCritical
Exit Sub
End Sub
Private Sub cmdSelect1_Click()
On Error Resume Next
dlgBrowser.DialogTitle = "请选择需要备份的文件"
dlgBrowser.CancelError = True
dlgBrowser.Filter = "所有文件(*.*)|*.*|Access文件(*.MDB)|*.MDB|VB中国备份文件(*.YVB)|*.YVB"
dlgBrowser.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly + cdlOFNPathMustExist
dlgBrowser.ShowOpen
txtBackupFileFrom = dlgBrowser.FileName
txtBackupFileFrom.SetFocus
If Err.Number = 32755 Then '取消时
Exit Sub
End If
End Sub
Private Sub cmdSelect2_Click()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -