📄 backup.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "comctl32.ocx"
Begin VB.Form BackUp
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "备份大师"
ClientHeight = 4410
ClientLeft = 45
ClientTop = 330
ClientWidth = 6090
Icon = "BackUp.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4410
ScaleWidth = 6090
ShowInTaskbar = 0 'False
Begin VB.PictureBox ProcessP
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 3525
Left = 2220
ScaleHeight = 3525
ScaleWidth = 3630
TabIndex = 10
Top = 240
Visible = 0 'False
Width = 3630
Begin VB.CommandButton Command3
Caption = "完成(&E)"
Enabled = 0 'False
Height = 360
Left = 2265
TabIndex = 1
Top = 2850
Width = 1170
End
Begin VB.PictureBox Picture4
AutoRedraw = -1 'True
Height = 1230
Left = 285
ScaleHeight = 1170
ScaleWidth = 3075
TabIndex = 13
Top = 1410
Width = 3135
Begin VB.Label FileM
AutoSize = -1 'True
Caption = "199-2-9"
ForeColor = &H000000C0&
Height = 180
Left = 990
TabIndex = 19
Top = 870
Width = 630
End
Begin VB.Label FileS
AutoSize = -1 'True
Caption = "32KB"
ForeColor = &H000000C0&
Height = 180
Left = 990
TabIndex = 18
Top = 525
Width = 360
End
Begin VB.Label FileN
AutoSize = -1 'True
Caption = "Fair.mdb"
ForeColor = &H000000C0&
Height = 180
Left = 990
TabIndex = 17
Top = 195
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "最后修改："
ForeColor = &H00004000&
Height = 180
Left = 105
TabIndex = 16
Top = 870
Width = 900
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "文件大小："
ForeColor = &H00004000&
Height = 180
Left = 105
TabIndex = 15
Top = 525
Width = 900
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "文件名称："
ForeColor = &H00004000&
Height = 180
Left = 105
TabIndex = 14
Top = 195
Width = 900
End
End
Begin ComctlLib.ProgressBar Bar
Height = 180
Left = 285
TabIndex = 12
Top = 720
Width = 3150
_ExtentX = 5556
_ExtentY = 318
_Version = 327682
Appearance = 0
End
Begin VB.Label DisplayStatus
AutoSize = -1 'True
Caption = "正在备份数据文件...."
Height = 180
Left = 285
TabIndex = 11
Top = 210
Width = 1800
End
End
Begin VB.Frame Frame2
Height = 2055
Left = 2400
TabIndex = 8
Top = 165
Width = 3360
Begin VB.Label Label2
Caption = " 备份系统将帮助您更好地管 理好展会数据库。 请在下面文 本框中输入正确的磁盘及路径，如果不清楚路径，请按浏览按钮，选择合适的路径。"
Height = 1125
Left = 240
TabIndex = 9
Top = 390
Width = 2925
End
End
Begin VB.CommandButton Command2
Caption = "下一步(&>)"
Default = -1 'True
Enabled = 0 'False
Height = 420
Left = 3480
TabIndex = 2
Top = 3135
Width = 1080
End
Begin VB.CommandButton Command1
Caption = "浏览(&B)"
Height = 420
Left = 4665
TabIndex = 3
Top = 3135
Width = 1080
End
Begin VB.Frame Frame1
Height = 660
Left = 2385
TabIndex = 6
Top = 2250
Width = 3360
Begin VB.TextBox Text1
BeginProperty Font
Name = "@System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 330
Left = 120
TabIndex = 0
Top = 210
Width = 3135
End
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H00808000&
Height = 3510
Left = 255
ScaleHeight = 3450
ScaleWidth = 1830
TabIndex = 4
Top = 270
Width = 1890
Begin VB.PictureBox Picture2
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 3210
Left = -15
ScaleHeight = 3210
ScaleWidth = 1785
TabIndex = 7
Top = 150
Width = 1785
End
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "警告：本备份系统只适用于展会处理系统!"
Height = 180
Left = 285
TabIndex = 5
Top = 4035
Width = 3330
End
End
Attribute VB_Name = "BackUp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ProcessB As Boolean
Private Sub Command1_Click()
BackUp.MousePointer = 11
Load SelectPath
SelectPath.Show 1
BackUp.MousePointer = 0
If BackUp.Command2.Enabled = True Then
BackUp.Command2.SetFocus
End If
End Sub
Private Sub Command2_Click()
On Error Resume Next
If Dir(Trim(Text1.Text), vbDirectory) = "" Then
MsgBox "请检查路径是否正确，或者按浏览按钮。", vbOKOnly + 32, "路径错误..."
Exit Sub
End If
On Error GoTo 0
Dim TempFile As String, ObjectFile As String
TempFile = Browser + "Fair.mdb"
'Test resource file exsit
If Dir(TempFile) = "" Then
MsgBox "数据文件遭破坏，不能备份，请于管理员联系！", vbOKOnly + 16, "警告..."
Text1.Enabled = False
Command2.Enabled = False
Command1.Enabled = False
Exit Sub
End If
'Test object file exsit
ObjectFile = Trim(Text1.Text)
If Right(ObjectFile, 1) <> "\" Then
ObjectFile = ObjectFile + "\"
End If
ObjectFile = ObjectFile + "Fair.mdb"
If Dir(ObjectFile) <> "" Then
If UCase(ObjectFile) = UCase(TempFile) Then
MsgBox "备份目录不能与源目录相同！", vbOKOnly + 32, "不能备份在同一目录下..."
Exit Sub
End If
Dim YN As Integer
YN = MsgBox("该目录下已经存在备份文件，要覆盖吗？(Y/N)", vbYesNo + 16, "警告...")
If YN = 6 Then
Kill ObjectFile
Else
Exit Sub
End If
End If
BackUp.MousePointer = 11
Text1.Enabled = False
Command2.Enabled = False
Command1.Enabled = False
Command3.Default = True
ProcessB = True
ProcessP.Visible = True
ProcessP.Refresh
'Starting Copy file
On Error GoTo ProtectON
FileCopy TempFile, ObjectFile
GoTo Ex
ProtectON:
MsgBox "磁盘写保护或者写到只读的磁盘。", vbOKOnly + vbCritical, "写保护..."
FileS.Caption = "备份错误"
FileN.Caption = "备份错误"
FileM.Caption = "备份错误"
ProcessB = False
Command3.Enabled = True
Command3.Caption = "关闭"
BackUp.MousePointer = 0
DisplayStatus.Caption = "对不起:备份工作没有完成!"
Exit Sub
Ex:
'操作代码
FileS.Caption = FileLen(TempFile) / 1024
FileS.Caption = FileS.Caption + "KB"
FileN.Caption = TempFile
FileM.Caption = FileDateTime(TempFile)
Dim FS As Long, X As Long
FS = FileLen(TempFile)
Bar.Max = FS
Bar.Min = 1
For X = 1 To FS
Bar.Value = X
Next
ProcessB = False
Command3.Enabled = True
BackUp.MousePointer = 0
DisplayStatus.Caption = "恭喜:备份工作已经顺利完成。"
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
'temp
'Browser = "f:\vb-nt\fair\"
BackUp.Left = Menu.Width
BackUp.Top = 0
Picture2.Picture = LoadPicture(Browser + "backup.bmp")
ProcessB = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If ProcessB = True Then
Cancel = -1
MsgBox "正在备份数据文件,不能关闭!", vbOKOnly + 48, "备份之中..."
Exit Sub
Else
Cancel = 0
End If
End Sub
Private Sub Text1_Change()
If Trim(Text1.Text) = "" Then
Command2.Enabled = False
Else
Command2.Enabled = True
End If
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -