📄 frmdeldata.frm
字号:
VERSION 5.00
Begin VB.Form frmDelData
BorderStyle = 1 'Fixed Single
Caption = "维护数据"
ClientHeight = 3195
ClientLeft = 45
ClientTop = 330
ClientWidth = 4410
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3195
ScaleWidth = 4410
Begin VB.CommandButton cmdCancel
Caption = "返回 "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3120
TabIndex = 6
Top = 2400
Width = 1095
End
Begin VB.CommandButton cmdDel
Caption = "清除 "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3120
TabIndex = 5
Top = 1320
Width = 1095
End
Begin VB.CommandButton cmdOutport
Caption = "导出"
Height = 375
Left = 3120
TabIndex = 4
Top = 840
Width = 1095
End
Begin VB.CommandButton cmdInport
Caption = "导入"
Height = 375
Left = 3120
TabIndex = 3
Top = 360
Width = 1095
End
Begin VB.CheckBox chkAll
Caption = "全选"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 2
Top = 2640
Width = 855
End
Begin VB.ListBox lstData
Columns = 2
Height = 2220
Left = 120
MultiSelect = 2 'Extended
TabIndex = 1
Top = 360
Width = 2775
End
Begin VB.CheckBox chkDelAfter
Caption = "导出后删除"
Height = 255
Left = 1320
TabIndex = 0
Top = 2640
Width = 1575
End
Begin VB.Label Label1
Caption = "现存数据:"
Height = 255
Left = 240
TabIndex = 7
Top = 120
Width = 1695
End
End
Attribute VB_Name = "frmDelData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/09
'描 述：CBB三表户外计量系统 Ver 5.2
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Sub loadLstData()
Dim rcData As Recordset
lstData.Clear
SQL = "select distinct Date from UserData"
Set rcData = dbCbb.OpenRecordset(SQL)
If rcData.EOF Then
lstData.Clear
Exit Sub
End If
Do While Not rcData.EOF
lstData.AddItem Format(rcData!Date, "yyyy-mm-dd")
rcData.MoveNext
Loop
rcData.Close
Set rcData = Nothing
End Sub
Private Sub chkAll_Click()
If chkAll.Value = 1 Then
For i = 0 To lstData.ListCount - 1
lstData.Selected(i) = True
Next i
End If
End Sub
Private Sub cmdCancel_Click()
Unload frmDelData
End Sub
Private Sub cmdDel_Click()
Dim i As Integer
Dim selDate() As Date
Dim selStr As String
If MsgBox("确定要清除指定的用户数据吗?", 48 + 1, "清除数据") = 2 Then
Exit Sub
End If
If chkAll.Value = 1 Then
SQL = "delete * from userdata"
dbCbb.Execute SQL
SQL = "delete * from userdata2"
dbCbb.Execute SQL
End If
If lstData.SelCount > 0 Then
SQL = "delete * from UserData "
selStr = ""
For i = 0 To lstData.ListCount - 1
If lstData.Selected(i) Then
If IsDate(lstData.List(i)) Then
selStr = selStr + "#" + Trim(lstData.List(i)) + "#,"
'status
AppendStatusInfo "清除日期" & Trim(lstData.List(i)) & "数据", icoBLUE
SaveLog "清除日期" & Trim(lstData.List(i)) & "数据", 0
End If
End If
Next i
If selStr <> "" Then
selStr = Left(selStr, Len(selStr) - 1)
Else
Exit Sub
End If
SQL = SQL + "where Date in (" + selStr + ")"
dbCbb.Execute SQL
SQL = "delete * from UserData2 "
SQL = SQL + "where Date in (" + selStr + ")"
dbCbb.Execute SQL
Else
Exit Sub
End If
loadLstData
lstData.Refresh
End Sub
Sub BackupData(v_Date As Date)
Dim rcBakData As Recordset
Dim temBakStr As String
Dim hFile As Integer
Dim temFileName As String
SQL = "select * from UserData where format(Date,""yyyy-mm-dd"")=""" & Format(v_Date, "yyyy-mm-dd") & """"
Set rcBakData = dbCbb.OpenRecordset(SQL, dbOpenSnapshot)
If rcBakData.RecordCount > 0 Then
temFileName = Format(v_Date, "yyyymmdd") & ".dat"
hFile = FreeFile
Open App.Path & "\bak\" & temFileName For Output As #hFile
Do Until rcBakData.EOF
temBakStr = ""
For i = 1 To rcBakData.Fields.Count
temBakStr = temBakStr & Trim(CStr(rcBakData.Fields(i - 1))) & ";"
Next i
If Len(temBakStr) > 0 Then
temBakStr = Left(temBakStr, Len(temBakStr) - 1)
End If
Print #hFile, temBakStr
rcBakData.MoveNext
Loop
Close #hFile
End If
'status
AppendStatusInfo "备份日期" & v_Date & "数据", icoBLUE
SaveLog "备份日期" & v_Date & "数据", 0
If chkDelAfter.Value = 1 Then
SQL = "delete * from UserData where format(Date,""yyyy-mm-dd"")=""" & Format(v_Date, "yyyy-mm-dd") & """"
dbCbb.Execute SQL
SQL = "delete * from UserData2 where format(Date,""yyyy-mm-dd"")=""" & Format(v_Date, "yyyy-mm-dd") & """"
dbCbb.Execute SQL
'status
AppendStatusInfo "删除日期" & v_Date & "数据", icoBLUE
SaveLog "删除日期" & v_Date & "数据", 0
End If
End Sub
Private Sub cmdInport_Click()
frmInport.Show 1
loadLstData
End Sub
Private Sub cmdOutport_Click()
Dim temFileName As String
If lstData.SelCount > 0 Then
Me.MousePointer = 11
For i = 0 To lstData.ListCount - 1
If lstData.Selected(i) Then
temFileName = Format(CDate(lstData.List(i)), "yyyymmdd") & ".dat"
If Dir("bak\" & temFileName) = "" Then
BackupData CDate(lstData.List(i))
Else
If MsgBox("日期" & lstData.List(i) & _
"的数据已经有备份存在" & Chr(13) & _
"确定是否要覆盖?", vbYesNo + vbQuestion, Me.Caption) = vbYes Then
BackupData CDate(lstData.List(i))
'status
AppendStatusInfo "备份日期" & CDate(lstData.List(i)) & "备份数据", icoBLUE
SaveLog "备份日期" & CDate(lstData.List(i)) & "备份数据", 0
End If
End If
End If
Next i
Me.MousePointer = 0
MsgBox "数据导出完毕", , Me.Caption
loadLstData
End If
End Sub
Private Sub Form_Load()
frmDelData.Width = 4500
frmDelData.Height = 3420
frmDelData.Left = 2190
frmDelData.Top = 100
loadLstData
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -