📄 restore.frm
字号:
VERSION 5.00
Begin VB.Form RESTORE
Caption = "数据恢复"
ClientHeight = 4035
ClientLeft = 60
ClientTop = 345
ClientWidth = 6720
Icon = "RESTORE.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4035
ScaleWidth = 6720
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton Command2
Caption = "取 消"
Height = 375
Left = 5520
TabIndex = 8
Top = 960
Width = 975
End
Begin VB.CommandButton Command1
Caption = "恢 复"
Height = 375
Left = 5520
TabIndex = 7
Top = 360
Width = 975
End
Begin VB.FileListBox File1
Height = 2610
Left = 2880
Pattern = "*.HR_"
TabIndex = 2
Top = 1080
Width = 2295
End
Begin VB.DirListBox Dir1
Height = 2610
Left = 240
TabIndex = 1
Top = 1080
Width = 2295
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 1200
TabIndex = 0
Top = 480
Width = 4095
End
Begin VB.Frame Frame1
Caption = "文件夹"
Height = 3015
Left = 120
TabIndex = 4
Top = 840
Width = 2535
End
Begin VB.Frame Frame2
Caption = "文件列表"
Height = 3015
Left = 2760
TabIndex = 5
Top = 840
Width = 2535
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "驱动器："
Height = 255
Left = 240
TabIndex = 6
Top = 540
Width = 855
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "请选择有效数据备份文件："
Height = 255
Left = 240
TabIndex = 3
Top = 120
Width = 2535
End
End
Attribute VB_Name = "RESTORE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public DATBAK As Database
Public RECBACKUP As Recordset
Dim HFFILE As String
Public SHFFILE As String
Public Function BFILEEXISTS(SFILE As String) As Boolean
If Dir$(SFILE) <> "" Then BFILEEXISTS = True Else BFILEEXISTS = False
End Function
Private Sub Command1_Click()
On Error GoTo LOCALERR
If Trim(File1.FileName) = "" Then
MsgBox "请选择有效数据备份文件*.HR_", vbCritical, "提示信息"
Else
RECBACKUP.FindFirst ("ID=10")
If Not RECBACKUP.NoMatch Then
HFFILE = Left(RECBACKUP("FILE"), Len(RECBACKUP("FILE")) - 5)
End If
If UCase(Left(File1.FileName, Len(File1.FileName) - 5)) <> UCase(HFFILE) Then
MsgBox "不是本系统备份数据!", vbCritical, "错误"
Exit Sub
End If
ChDrive Left(App.Path, 2)
ChDir App.Path
If UCase(Left(File1.Path, 1)) <> "A" Then
If BFILEEXISTS("RESTORE.WC_") Then Kill "RESTORE.WC*"
If BFILEEXISTS("RESTORE.BAT") Then Kill "RESTORE.BAT"
NFILE = FreeFile
Open App.Path & "\RESTORE.BAT" For Output As #NFILE
If Right(File1.Path, 1) = "\" Then
Print #NFILE, "EXTRACT /Y /A /E /L BACKUP " & File1.Path & File1.FileName & ">RESTORE.WC1"
Else
Print #NFILE, "EXTRACT /Y /A /E /L BACKUP " & File1.Path & "\" & File1.FileName & ">RESTORE.WC1"
End If
Print #NFILE, "DIR BACKUP>RESTORE.WC_"
Close #NFILE
Shell "RESTORE.BAT", vbHide
Load REJDT1
REJDT1.Show vbModal
If BFILEEXISTS("RESTORE.WC_") Then Kill "RESTORE.WC*"
If BFILEEXISTS("RESTORE.BAT") Then Kill "RESTORE.BAT"
MsgBox "恭喜!您的数据已安全恢复...", vbInformation + vbOKOnly, "提示信息"
Unload Me
Else
If Not BFILEEXISTS("A:\BACKDISK.INF") Then
MsgBox "非本系统备份数据,请换盘再试!", vbCritical, "错误"
Exit Sub
End If
NFILE = FreeFile
Open "A:\BACKDISK.INF" For Input As #NFILE
Line Input #NFILE, STRDISKS
Line Input #NFILE, STRTOTALS
Close #NFILE
INTDISKS = CInt(Right(STRDISKS, Len(STRDISKS) - 6))
INTTOTALS = CInt(Right(STRTOTALS, Len(STRTOTALS) - 12))
DISKS = 1
Do While DISKS <= INTTOTALS
COPY:
NFILE = FreeFile
Open "A:\BACKDISK.INF" For Input As #NFILE
Line Input #NFILE, STRDISKS
Close #NFILE
INTDISKS = CInt(Right(STRDISKS, Len(STRDISKS) - 6))
If INTDISKS <> DISKS Then
SFFP = MsgBox("Please Insert DISK:#" & CStr(DISKS), vbInformation + vbOKCancel, "提示信息")
If SFFP = vbOK Then GoTo COPY Else Exit Sub
End If
If DISKS = 1 Then
SHFFILE = Dir$("A:\*.HR_")
End If
Load REJDT2
REJDT2.Show vbModal
DISKS = DISKS + 1
Loop
If BFILEEXISTS("RESTORE.WC_") Then Kill "RESTORE.WC*"
If BFILEEXISTS("RESTORE.BAT") Then Kill "RESTORE.BAT"
NFILE = FreeFile
Open App.Path & "\RESTORE.BAT" For Output As #NFILE
Print #NFILE, "EXTRACT /Y /A /E /L BACKUP " & App.Path & "\" & SHFFILE & ">RESTORE.WC1"
Print #NFILE, "DIR BACKUP>RESTORE.WC_"
Close #NFILE
Shell "RESTORE.BAT", vbHide
Load REJDT1
REJDT1.Show vbModal
If BFILEEXISTS("RESTORE.WC_") Then Kill "RESTORE.WC*"
If BFILEEXISTS("RESTORE.BAT") Then Kill "RESTORE.BAT"
If BFILEEXISTS(App.Path & "\*.HR_") Then Kill "*.HR_"
If BFILEEXISTS(App.Path & "\BACKUP\*.HR_") Then Kill App.Path & "\BACKUP\*.HR_"
MsgBox "恭喜!您的数据已安全恢复...", vbInformation + vbOKOnly, "提示信息"
Unload Me
End If
End If
GoTo LOCALEXIT
LOCALERR:
strmsg = CStr(Err.Number) & "-" & Err.Description
SFXX = MsgBox(strmsg, vbCritical + vbRetryCancel, "错误")
If SFXX = vbRetry Then
Resume
Else
Unload RESTORE
End If
LOCALEXIT:
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Dir1_Change()
On Error GoTo LOCALERR
File1.Path = Dir1.Path
GoTo LOCALEXIT
LOCALERR:
If Err.Number = 68 Then
MsgBox "磁盘驱动器设备不能用,请换盘再试", vbCritical, "错误"
Resume
End If
strmsg = CStr(Err.Number) & "-" & Err.Description
SFXX = MsgBox(strmsg, vbCritical + vbAbortRetryIgnore, "错误")
If SFXX = vbRetry Then
Resume
Else
Unload RESTORE
End If
LOCALEXIT:
End Sub
Private Sub Drive1_Change()
On Error GoTo LOCALERR
Dir1.Path = Drive1.Drive
File1.Path = Dir1.Path
GoTo LOCALEXIT
LOCALERR:
If Err.Number = 68 Then
MsgBox "磁盘驱动器设备不能用,请换盘再试", vbCritical, "错误"
Resume
End If
strmsg = CStr(Err.Number) & "-" & Err.Description
SFXX = MsgBox(strmsg, vbCritical + vbAbortRetryIgnore, "错误")
If SFXX = vbRetry Then
Resume
Else
Unload RESTORE
End If
LOCALEXIT:
End Sub
Private Sub Form_Load()
Set DATBAK = OpenDatabase(App.Path & "\BACKUP.MDB")
Set RECBACKUP = DATBAK.OpenRecordset("BACKUP", dbOpenDynaset)
End Sub
Private Sub Form_Unload(Cancel As Integer)
DATBAK.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -