📄 frm_备份与恢复.frm
字号:
VERSION 5.00
Object = "{1666F204-B71B-4E6D-AA21-DCE71B94F422}#7.0#0"; "OfficXP风格菜单按钮控件.ocx"
Begin VB.Form Frm_备份与恢复
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "数据备份与恢复"
ClientHeight = 4065
ClientLeft = 60
ClientTop = 345
ClientWidth = 6750
LinkTopic = "Form1"
ScaleHeight = 4065
ScaleWidth = 6750
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "选择路径"
ForeColor = &H80000008&
Height = 2715
Left = 15
TabIndex = 1
Top = 1350
Width = 6705
Begin SmartXpButton.SmartNetXpButton SNXpCancel
Height = 480
Left = 4440
TabIndex = 7
Top = 1395
Width = 1815
_ExtentX = 3201
_ExtentY = 847
BackColor = -2147483628
CaptionAreaLayout= 1
Caption = "取消操作"
ShowCaption = -1 'True
PictureLayout = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CaptionAreaPercent= 50
End
Begin SmartXpButton.SmartNetXpButton SNXpOK
Height = 480
Left = 4440
TabIndex = 6
Top = 600
Width = 1815
_ExtentX = 3201
_ExtentY = 847
BackColor = -2147483628
CaptionAreaLayout= 1
Caption = "确认操作"
ShowCaption = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CaptionAreaPercent= 50
End
Begin VB.DirListBox Dir1
Height = 1560
Left = 525
TabIndex = 4
Top = 705
Width = 2925
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 540
TabIndex = 3
Top = 285
Width = 2910
End
Begin VB.Label Label2
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "存储"
ForeColor = &H80000008&
Height = 180
Left = 525
TabIndex = 5
Top = 2385
Width = 360
End
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1425
Left = 15
TabIndex = 0
Top = -75
Width = 6705
Begin SmartXpButton.SmartNetXpButton SNXpRestore
Height = 465
Left = 4410
TabIndex = 9
Top = 795
Width = 1815
_ExtentX = 3201
_ExtentY = 820
BackColor = -2147483628
CaptionAreaLayout= 1
Caption = "数据恢复"
ShowCaption = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "Frm_备份与恢复.frx":0000
CaptionAreaPercent= 50
End
Begin SmartXpButton.SmartNetXpButton SNXpBackUP
Height = 465
Left = 4410
TabIndex = 8
Top = 240
Width = 1815
_ExtentX = 3201
_ExtentY = 820
BackColor = -2147483628
CaptionAreaLayout= 1
Caption = "数据备份"
ShowCaption = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "Frm_备份与恢复.frx":031A
CaptionAreaPercent= 50
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "提示：点击开始备份按钮选择路径进行数据的备份；点击恢复数据按纽把备份后的数据恢复到应用程序的data文件夹下。 "
ForeColor = &H000000C0&
Height = 765
Left = 180
TabIndex = 2
Top = 285
Width = 2685
End
End
End
Attribute VB_Name = "Frm_备份与恢复"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim dirs As String
Dim obj As Object
Dim cst As String
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub SNXpBACKUP_Click()
cz = False
Me.Height = 5160
Frame2.Visible = True
Frame2.Caption = "请选择数据备份路径："
If Right(Trim(Dir1.Path), 1) = "\" Then
dirs = Dir1.Path
Else
dirs = Dir1.Path + "\"
End If
Label2.Caption = "数据备份路径：" + dirs + "数据备份.mdb"
'On Error GoTo err:
'cd.Action = 2
'
'pgb.Visible = True
'
'''Dim je As New JetEngine
'
'''conn.Close
'If conn.State = 1 Then conn.Close
'
'Dim dsSource As New DAO.DBEngine
'If Dir(App.Path + "\data\temp.mdb") <> "" Then Kill (App.Path + "\data\temp.mdb")
'dsSource.CompactDatabase App.Path + "\data\wsjyxt.mdb", App.Path + "\data\temp.mdb"
'
'Set fsosjsb = CreateObject("Scripting.FileSystemObject")
'If cd.FileName = "" Then Exit Sub
'pgb.Value = 1
'fsosjsb.copyfile App.Path + "\data\wsjyxt.mdb", cd.FileName, True
'
'If Dir(App.Path + "\data\temp.mdb") <> "" Then Kill (App.Path + "\data\temp.mdb")
'pgb.Value = 100
'''pgb.Visible = False
'cd.FileName = ""
'MsgBox "备份完成！！", vbInformation, App.Title
'pgb.Value = 0
'If conn.State = 0 Then conn.Open
'Exit Sub
'err:
'MsgBox "系统错误：" + err.Description, vbCritical, App.Title
End Sub
Private Sub SNXpRESTORE_Click()
cz = True
Me.Height = 5160
Frame2.Visible = True
Frame2.Caption = "请选择数据备份时路径："
If Right(Trim(Dir1.Path), 1) = "\" Then
dirs = Dir1.Path
Else
dirs = Dir1.Path + "\"
End If
Label2.Caption = "数据恢复路径：" + dirs
'On Error GoTo err:
' cd.Action = 1
'
' pgb.Visible = True
'
'''' Dim je As New JRO.JetEngine
' If Trim(cd.FileName) <> "" Then
' Set fsosjsb = CreateObject("Scripting.FileSystemObject")
' pgb.Value = 1
' fsosjsb.copyfile cd.FileName, App.Path + "\data\wsjyxt.mdb", True
' pgb.Value = 100
' pgb.Visible = False
' MsgBox "恢复完成！！", vbInformation, App.Title
' cd.FileName = ""
' Else
' Exit Sub
' End If
' Exit Sub
'err:
' MsgBox "系统错误：" + err.Description, vbCritical, App.Title
End Sub
Private Sub SNXpOK_Click()
If cz = False Then '备份
If obj.FileExists(dirs & "\数据备份.mdb") = False Then
Frame2.Visible = False
Me.Height = 2250
'' pgb.Visible = True
'' pgb.Value = 1
obj.copyfile App.Path + "\data\mems.mdb", dirs & "\数据备份.mdb"
'' pgb.Value = 100
Else
If MsgBox("所选择的路径已经存有原先备份的数据，是否将原有备份数据覆盖？", vbYesNo + vbDefaultButton2, "覆盖或者更改备份路径") = vbYes Then
Frame2.Visible = False
Me.Height = 2250
' pgb.Visible = True
' pgb.Value = 1
obj.DeleteFile dirs & "\数据备份.mdb", True
obj.copyfile App.Path + "\data\mems.mdb", dirs & "\数据备份.mdb"
' pgb.Value = 100
Else
Exit Sub
End If
End If
MsgBox "数据备份完成，请妥善保管！", vbInformation, "提示"
' pgb.Visible = False
Else '恢复
If obj.FileExists(dirs & "\数据备份.mdb") = False Then
MsgBox "所选择路径没有找到备份文件，请选择正确路径！", vbCritical, "数据恢复"
Exit Sub
Else
If MsgBox("是否用备份文件的数据恢复到本系统内，注意：恢复后将丢失自备份数据以来的所有更改！", vbYesNo + vbDefaultButton2, "覆盖或者更改备份路径") = vbYes Then
Frame2.Visible = False
Me.Height = 2250
pgb.Visible = True
pgb.Value = 1
If conn.State = 1 Then conn.Close
If obj.FileExists(App.Path + "\data\temp" & Trim(CStr(Date)) & ".mdb") = True Then obj.DeleteFile App.Path + "\data\temp" & Trim(CStr(Date)) & ".mdb", True
obj.copyfile App.Path + "\data\mems.mdb", App.Path + "\data\temp" & Trim(CStr(Date)) & ".mdb"
obj.DeleteFile App.Path + "\data\wsjyxt.mdb", True
obj.copyfile dirs & "\数据备份.mdb", App.Path + "\data\mems.mdb"
' pgb.Value = 100
If conn.State = 0 Then conn.Open cst
Else
Exit Sub
End If
End If
MsgBox "数据恢复完成！", vbInformation, "提示"
pgb.Visible = False
End If
End Sub
Private Sub SNXpCancel_Click()
Frame2.Visible = False
Me.Height = 1815
' pgb.Visible = False
End Sub
Private Sub Dir1_Change()
If Right(Trim(Dir1.Path), 1) = "\" Then
dirs = Dir1.Path
Else
dirs = Dir1.Path + "\"
End If
If cz = False Then
Label2.Caption = "数据备份路径：" + dirs + "数据备份.mdb"
Else
Label2.Caption = "数据恢复路径：" + dirs
End If
End Sub
Private Sub Form_Load()
On Error GoTo ERR
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) * (1 - 0.618)
Set obj = CreateObject("Scripting.FileSystemObject")
cst = conn.ConnectionString
Frame2.Visible = False
Me.Height = 1815
' pgb.Visible = False
Exit Sub
ERR:
If IsNull(obj) = True Then
MsgBox "文件系统错误！", vbInformation, "学生收费管理——错误信息"
Unload Me
Exit Sub
End If
Exit Sub
''' Dim str As String
''' str = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\data\Wsjyxt.mdb;Persist Security Info=False"
''' conn.ConnectionString = str
''' If conn.State = 1 Then conn.Close
''' conn.Open str
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -