📄 frm0304.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form frm0304
BorderStyle = 1 'Fixed Single
Caption = "数据管理"
ClientHeight = 3765
ClientLeft = 45
ClientTop = 330
ClientWidth = 6495
Icon = "frm0304.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3765
ScaleWidth = 6495
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5880
Top = 3240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "All File (*.*)|*.*|Data File (*.mdb)|*.mdb|Back File (*.bak)|*.bak"
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消"
Height = 435
Left = 3600
TabIndex = 21
Top = 3240
Width = 1575
End
Begin VB.CommandButton cmdOK
Caption = "确定"
Height = 435
Left = 1320
TabIndex = 20
Top = 3240
Width = 1575
End
Begin VB.Frame fraDataRestore
Caption = "数据恢复"
Height = 1155
Left = 120
TabIndex = 16
Top = 1440
Width = 6255
Begin VB.CommandButton cmdDataRestore
Caption = "..."
Height = 375
Left = 5700
TabIndex = 19
Top = 600
Width = 375
End
Begin VB.TextBox txDataRestore
BackColor = &H00FFFFC0&
Height = 375
Left = 120
TabIndex = 18
Top = 600
Width = 5475
End
Begin VB.Label lbDataRestore
AutoSize = -1 'True
Caption = "请选择数据文件路径:"
Height = 195
Left = 120
TabIndex = 17
Top = 300
Width = 1665
End
End
Begin VB.Frame fraDataBackUp
Caption = "数据备份"
Height = 1155
Left = 120
TabIndex = 12
Top = 1440
Width = 6255
Begin VB.CommandButton cmdDataBack
Caption = "..."
Height = 375
Left = 5700
TabIndex = 15
Top = 600
Width = 375
End
Begin VB.TextBox txDataBack
BackColor = &H00FFFFC0&
Height = 375
Left = 120
TabIndex = 13
Top = 600
Width = 5475
End
Begin VB.Label lbDataBack
AutoSize = -1 'True
Caption = "这是默认备份路径,您也可以更改:"
Height = 195
Left = 120
TabIndex = 14
Top = 300
Width = 2610
End
End
Begin VB.Frame fraDataClean
Caption = "过时数据清理"
Height = 1695
Left = 120
TabIndex = 4
Top = 1440
Width = 6255
Begin MSComCtl2.DTPicker dtpDataClean
Height = 315
Index = 0
Left = 2040
TabIndex = 8
Top = 300
Width = 1875
_ExtentX = 3307
_ExtentY = 556
_Version = 393216
Format = 23789569
CurrentDate = 38019
End
Begin VB.OptionButton opDataClean
Caption = "之间"
Height = 315
Index = 2
Left = 180
TabIndex = 7
Top = 1140
Width = 1815
End
Begin VB.OptionButton opDataClean
Caption = "之后"
Height = 315
Index = 1
Left = 180
TabIndex = 6
Top = 720
Width = 1815
End
Begin VB.OptionButton opDataClean
Caption = "之前"
Height = 315
Index = 0
Left = 180
TabIndex = 5
Top = 300
Value = -1 'True
Width = 1815
End
Begin MSComCtl2.DTPicker dtpDataClean
Height = 315
Index = 1
Left = 2040
TabIndex = 9
Top = 720
Width = 1875
_ExtentX = 3307
_ExtentY = 556
_Version = 393216
Format = 23789569
CurrentDate = 38019
End
Begin MSComCtl2.DTPicker dtpDataClean
Height = 315
Index = 2
Left = 2040
TabIndex = 10
Top = 1140
Width = 1875
_ExtentX = 3307
_ExtentY = 556
_Version = 393216
Format = 23789569
CurrentDate = 38019
End
Begin MSComCtl2.DTPicker dtpDataClean
Height = 315
Index = 3
Left = 4200
TabIndex = 11
Top = 1140
Width = 1875
_ExtentX = 3307
_ExtentY = 556
_Version = 393216
Format = 23789569
CurrentDate = 38019
End
Begin VB.Line Line1
X1 = 3960
X2 = 4140
Y1 = 1260
Y2 = 1260
End
End
Begin VB.Frame fraOP
Caption = "操作选项"
Height = 1215
Left = 120
TabIndex = 0
Top = 120
Width = 6255
Begin VB.OptionButton opOP
Caption = "数据恢复"
Height = 315
Index = 2
Left = 180
TabIndex = 3
Top = 840
Width = 2535
End
Begin VB.OptionButton opOP
Caption = "数据备份"
Height = 315
Index = 1
Left = 180
TabIndex = 2
Top = 540
Width = 2535
End
Begin VB.OptionButton opOP
Caption = "过时数据清理"
Height = 315
Index = 0
Left = 180
TabIndex = 1
Top = 240
Width = 2535
End
End
End
Attribute VB_Name = "frm0304"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim opFlag1 As Integer
Dim opflag2 As Integer
Private Sub LoadFormLang()
Me.Caption = getFormCaptionResource("0304")
Me.fraOp.Caption = getResource("resOption")
Me.opOP(0).Caption = getResource("resLabF0304001")
Me.opOP(1).Caption = getResource("resLabF0304002")
Me.opOP(2).Caption = getResource("resLabF0304003")
Me.fraDataClean.Caption = getResource("resLabF0304001")
Me.opDataClean(0).Caption = getResource("resLabF0304004") & " ( <= )"
Me.opDataClean(1).Caption = getResource("resLabF0304005") & " ( >= )"
Me.opDataClean(2).Caption = getResource("resLabF0304006") & " ( >= - <= )"
Me.fraDataBackUp.Caption = getResource("resLabF0304002")
Me.lbDataBack.Caption = getResource("resLabF0304008")
Me.fraDataRestore.Caption = getResource("resLabF0304003")
Me.lbDataRestore.Caption = getResource("resLabF0304007")
Me.cmdOK.Caption = getResource("resOK")
Me.cmdCancel.Caption = getResource("resCancel")
End Sub
Private Sub cmdDataBack_Click()
Me.CommonDialog1.ShowSave
Me.txDataBack.Text = Me.CommonDialog1.FileName
End Sub
Private Sub cmdDataRestore_Click()
Me.CommonDialog1.ShowOpen
Me.txDataRestore.Text = Me.CommonDialog1.FileName
End Sub
Private Sub cmdOK_Click()
Dim result As Long, fileop As SHFILEOPSTRUCT '文件拷贝用
Dim sqlD As String
sqlD = ""
Select Case opFlag1
Case 1:
If MsgBox(getResource("resMsgF0304001"), vbExclamation + vbYesNo) = vbNo Then
Exit Sub
End If
Select Case opflag2
Case 1:
sqlD = "DELETE FROM ImExPort WHERE flag=1 AND opDate <= #" & Me.dtpDataClean(0).Value & " 23:59:59#"
Case 2:
sqlD = "DELETE FROM ImExPort WHERE flag=1 AND opDate >= #" & Me.dtpDataClean(1).Value & " 0:0:0#"
Case 3:
sqlD = "DELETE FROM ImExPort WHERE flag=1 AND opDate >= #" & Me.dtpDataClean(2).Value & " 0:0:0# AND opDate <= #" & Me.dtpDataClean(3).Value & " 23:59:59#"
End Select
Call RunSql(sqlD)
Case 2:
If TestText(Me.txDataBack.Text) Then
Me.cmdOK.Enabled = False
Me.cmdCancel.Enabled = False
With fileop
.hwnd = Me.hwnd
.wFunc = FO_COPY
.pFrom = App.Path & "\data.mdb" & vbNullChar & vbNullChar
.pTo = Trim$(Me.txDataBack.Text) & vbNullChar & vbNullChar
.fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
End With
result = SHFileOperation(fileop)
If result <> 0 Then
' Operation failed
'MsgBox Err.LastDllError
MsgBox "Operation Failed!", vbInformation + vbOKOnly
ElseIf fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed!", vbInformation + vbOKOnly
Else
MsgBox "Operation Successful!", vbInformation + vbOKOnly
End If
Else
MsgBox getResource("resLabF0304008"), vbExclamation + vbOKOnly
End If
Me.cmdOK.Enabled = True
Me.cmdCancel.Enabled = True
Case 3:
If TestText(Me.txDataRestore.Text) Then
Me.cmdOK.Enabled = False
Me.cmdCancel.Enabled = False
Call closeDataBase
With fileop
.hwnd = Me.hwnd
.wFunc = FO_COPY
.pFrom = Trim$(Me.txDataBack.Text) & vbNullChar & vbNullChar
.pTo = App.Path & "\data.mdb" & vbNullChar & vbNullChar
.fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
End With
result = SHFileOperation(fileop)
If result <> 0 Then
' Operation failed
'MsgBox Err.LastDllError
MsgBox "Operation Failed!", vbInformation + vbOKOnly
ElseIf fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed!", vbInformation + vbOKOnly
Else
MsgBox "Operation Successfull!", vbInformation + vbOKOnly
End If
MsgBox "System must to restart!!!", vbInformation + vbOKOnly
Call ShutDownSystem(False)
Me.cmdOK.Enabled = True
Me.cmdCancel.Enabled = True
Else
MsgBox getResource("resLabF0304008"), vbExclamation + vbYes
End If
End Select
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
opFlag1 = 0
opflag2 = 0
Call LoadFormLang
Me.dtpDataClean(0).Value = Date
Me.dtpDataClean(1).Value = Date
Me.dtpDataClean(2).Value = Date
Me.dtpDataClean(3).Value = Date
Call opOP_Click(0)
Call opDataClean_Click(0)
End Sub
Private Sub opDataClean_Click(Index As Integer)
Select Case Index
Case 0:
Me.dtpDataClean(0).Enabled = True
Me.dtpDataClean(1).Enabled = False
Me.dtpDataClean(2).Enabled = False
Me.dtpDataClean(3).Enabled = False
opflag2 = 1
Case 1:
Me.dtpDataClean(0).Enabled = False
Me.dtpDataClean(1).Enabled = True
Me.dtpDataClean(2).Enabled = False
Me.dtpDataClean(3).Enabled = False
opflag2 = 2
Case 2:
Me.dtpDataClean(0).Enabled = False
Me.dtpDataClean(1).Enabled = False
Me.dtpDataClean(2).Enabled = True
Me.dtpDataClean(3).Enabled = True
opflag2 = 3
End Select
End Sub
Private Sub opOP_Click(Index As Integer)
Select Case Index
Case 0:
Me.fraDataClean.Visible = True
Me.fraDataBackUp.Visible = False
Me.fraDataRestore.Visible = False
opFlag1 = 1
Case 1:
Me.fraDataClean.Visible = False
Me.fraDataBackUp.Visible = True
Me.fraDataRestore.Visible = False
Me.txDataBack.Text = App.Path & "\DataBack\DataBack" & Format$(Now(), "mmddyyyy") & ".bak"
opFlag1 = 2
Case 2:
Me.fraDataClean.Visible = False
Me.fraDataBackUp.Visible = False
Me.fraDataRestore.Visible = True
opFlag1 = 3
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -