📄 menu43.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form winmenu43
BorderStyle = 1 'Fixed Single
Caption = "数据恢复模块"
ClientHeight = 7155
ClientLeft = 45
ClientTop = 330
ClientWidth = 9180
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 7155
ScaleWidth = 9180
Begin VB.Frame hf
BorderStyle = 0 'None
Height = 2415
Left = 1080
TabIndex = 6
Top = 3945
Width = 4695
Begin MSComCtl2.MonthView hfdate
Height = 2220
Left = 360
TabIndex = 7
Top = 240
Width = 4065
_ExtentX = 7170
_ExtentY = 3916
_Version = 393216
ForeColor = -2147483630
BackColor = -2147483633
Appearance = 1
StartOfWeek = 25559041
CurrentDate = 37156
End
Begin VB.Label Label7
Caption = "请选择恢复数据的日期， 即备份时的日期"
BeginProperty Font
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 8
Top = 0
Width = 4095
End
End
Begin VB.Frame Frame1
BorderStyle = 0 'None
Height = 3060
Left = 480
TabIndex = 0
Top = 480
Width = 6015
Begin VB.DriveListBox Drive1
Height = 300
Left = 720
TabIndex = 3
Top = 2440
Width = 1575
End
Begin VB.CommandButton Command4
Caption = "确 认"
Height = 375
Left = 3000
TabIndex = 2
Top = 2400
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "退 出"
Height = 375
Left = 4320
TabIndex = 1
Top = 2400
Width = 1215
End
Begin VB.Label Label1
Caption = $"menu43.frx":0000
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1455
Left = 360
TabIndex = 5
Top = 720
Width = 5415
End
Begin VB.Label Label2
Caption = "数 据 恢 复 模 块"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 495
Left = 960
TabIndex = 4
Top = 120
Width = 4335
End
End
Begin VB.Line Line2
BorderColor = &H80000005&
BorderWidth = 3
X1 = 360
X2 = 360
Y1 = 360
Y2 = 3600
End
Begin VB.Line Line3
BorderColor = &H80000006&
BorderWidth = 3
X1 = 360
X2 = 6600
Y1 = 3600
Y2 = 3600
End
Begin VB.Line Line4
BorderColor = &H80000006&
BorderWidth = 3
X1 = 6615
X2 = 6615
Y1 = 360
Y2 = 3600
End
Begin VB.Line Line1
BorderColor = &H80000005&
BorderWidth = 3
X1 = 360
X2 = 6580
Y1 = 360
Y2 = 360
End
Begin VB.Shape Shape2
BorderColor = &H80000003&
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 255
Left = 600
Top = 3615
Width = 6255
End
Begin VB.Shape Shape1
BorderColor = &H00C0C0C0&
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 3135
Left = 6630
Top = 720
Width = 255
End
End
Attribute VB_Name = "winmenu43"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim bdkk As Database
Dim bdktab As Recordset
Dim bf As Database
Dim bfdate As String
Dim lsls As String
Private Sub mkfile()
End Sub
Private Sub Command4_Click()
On Error GoTo bb:
lsls = Mid(Drive1.Drive, 1, 2)
ff = bfdate
'fdate = LTrim(RTrim(Str$(Year(ff)))) + LTrim(RTrim(Str$(Month(ff)))) + LTrim(RTrim(Str$(Day(ff))))
bb = "\" + ff + ".mdb"
If Dir$(lsls + "\数据备份" + bb) = "" Then
MsgBox "对不起，此处无备份文件，无法恢复，请您重新选择。"
Exit Sub
Else
Set bf = OpenDatabase(App.Path + "\bdk.mdb")
Set bdkk = OpenDatabase(lsls + "\数据备份" + bb)
Set bdktab = bdkk.OpenRecordset("select * from gcd order by val(lsh)")
bf.Execute "delete * from gcd"
bf.Execute "delete * from chb"
Do While Not bdktab.EOF
zh1 = bdktab("cx")
If bdktab("hzdw") <> Empty Then zh2 = bdktab("hzdw") Else zh2 = " "
If bdktab("hzname") <> Empty Then zh3 = bdktab("hzname") Else zh3 = " "
If bdktab("ch") <> Empty Then zh4 = bdktab("ch") Else zh4 = " "
If bdktab("wzname") <> Empty Then zh5 = bdktab("wzname") Else zh5 = " "
If bdktab("mz") <> Empty Then zh6 = bdktab("mz") Else zh6 = " "
If bdktab("pz") <> Empty Then zh7 = bdktab("pz") Else zh7 = " "
If bdktab("zj") <> Empty Then zh8 = bdktab("zj") Else zh8 = " "
If bdktab("sby") <> Empty Then zh9 = bdktab("sby") Else zh9 = " "
If bdktab("modi") <> Empty Then zh10 = bdktab("modi") Else zh10 = " "
If bdktab("lsh") <> Empty Then zh11 = bdktab("lsh") Else zh11 = " "
If bdktab("rq") <> Empty Then zh12 = bdktab("rq") Else zh12 = " "
If bdktab("ttime") <> Empty Then zh13 = bdktab("ttime") Else zh13 = " "
If bdktab("fhname") <> Empty Then zh14 = bdktab("fhname") Else zh14 = " "
If bdktab("bz") <> Empty Then zh15 = bdktab("bz") Else zh15 = " "
bf.Execute "insert into gcd (cx,hzdw,hzname,ch,wzname,mz,pz,zj,sby,modi,lsh,rq,ttime,fhname,bz) values ('" + zh1 + "','" + zh2 + "','" + zh3 + "','" + zh4 + "','" + zh5 + "','" + zh6 + "','" + zh7 + "','" + zh8 + "','" + zh9 + "','" + zh10 + "','" + zh11 + "','" + zh12 + "','" + zh13 + "','" + zh14 + "','" + zh15 + "')"
bdktab.MoveNext
Loop
Set bdktab = bdkk.OpenRecordset("select * from chb")
Do While Not bdktab.EOF
zh1 = bdktab("ch")
bf.Execute "insert into chb (ch) values ('" + zh1 + "') "
bdktab.MoveNext
Loop
MsgBox "数据恢复已经完成！"
Set bdkk = Nothing
Set bf = Nothing
Exit Sub
bb:
MsgBox "磁盘发生读写错误,请更换！", vbCritical + vbExclamation, "土豆图书管理系统"
End If
Set bdkk = Nothing
Set bf = Nothing
End Sub
Private Sub Command3_Click()
mainboot.Picture1.Visible = True
mainboot.menunum = "nothing"
Unload Me
End Sub
Private Sub Command5_Click()
winmenu43.Height = 3685
Shape5.Height = 3264
bfdate = ""
bfdate = bfdate + LTrim(RTrim(Str$(Year(hfdate.Value))))
bfdate = bfdate + LTrim(RTrim(Str$(Month(hfdate.Value))))
bfdate = bfdate + LTrim(RTrim(Str$(Day(hfdate.Value))))
Frame2.Visible = True
Frame2.Left = 600
Frame2.Top = 180
Frame2.Width = 4855
Shape2.Top = 30
Shape2.Left = 30
Shape2.Width = 4785
Shape2.Height = 2715
Shape4.Top = 0
Shape4.Left = 0
Shape4.Width = 4835
Shape4.Height = 2775
hf.Visible = False
End Sub
Private Sub Command1_Click()
End Sub
Private Sub Form_Load()
hfdate.Value = Date
hfdate.Refresh
hf.Left = 1080
hf.Top = 1060
winmenu43.Left = 1800
winmenu43.Top = 1500
winmenu43.Width = 7335
winmenu43.Height = 4545
hf.Visible = True
Label1.Visible = False
Command3.Visible = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
mainboot.menunum = "nothing"
mainboot.Picture1.Visible = True
End Sub
Private Sub hfdate_DateClick(ByVal DateClicked As Date)
'winmenu43.Height = 3685
'Shape5.Height = 3264
bfdate = ""
bfdate = bfdate + LTrim(RTrim(Str$(Year(hfdate.Value))))
bfdate = bfdate + LTrim(RTrim(Str$(Month(hfdate.Value))))
bfdate = bfdate + LTrim(RTrim(Str$(Day(hfdate.Value))))
hf.Visible = False
Command3.Visible = True
Label1.Visible = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -