经过一段时间的机房收费系统的进行,摘出其中一部分的功能,其中上下机的代码修改有很多次,其中可能还有缺陷,请大家尽情的指出。
上机:
Private Sub cmdStart_Click() '点击上机按钮
Dim gudingeveryhourcash As Integer
Dim linshieveryhourcash As Integer
If Trim(txtCardID.Text) = "" Then
MsgBox "卡号不能为空", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
txtSQL = "select * from student_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = True And mrc.BOF = True Then '没有数据的情况
MsgBox "此卡号没有注册", vbOKOnly + vbExclamation, "警告"
txtCardID.SetFocus
txtCardID.SelStart = 0
txtCardID.SelLength = Len(txtCardID.Text)
Exit Sub
Else
While mrc.EOF = False
If Trim(txtCardID.Text) = Trim(mrc.Fields(0)) Then
mybookmark = mrc.Bookmark '存储书签
mrc.MoveNext
Else
mrc.MoveNext
End If
Wend
End If
If mybookmark = "" Then
MsgBox "此卡号没有注册", vbOKOnly + vbExclamation, "警告"
txtCardID.SetFocus
txtCardID.SelStart = 0
txtCardID.SelLength = Len(txtCardID.Text)
mrc.Close
Exit Sub
Else
mrc.Bookmark = mybookmark '获得位置
balance = Trim(mrc.Fields(7)) '获得余额
cardid = Trim(mrc.Fields(0)) '获得卡号
If "不使用" = Trim(mrc.Fields(10)) Then
MsgBox "此卡尚未注册", vbOKOnly + vbExclamation, "警告"
txtCardID.SetFocus
txtCardID.SelStart = 0
txtCardID.SelLength = Len(txtCardID.Text)
mybookmark = ""
Else
txtSQL = "select * from basicdata_info"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
mrcc.MoveLast
gudingeveryhourcash = Trim(mrcc.Fields(0))
linshieveryhourcash = Trim(mrcc.Fields(1))
mrcc.Close
If Trim(mrc.Fields(14)) = "固定用户" Then
If Trim(mrc.Fields(7)) <= 1 / 2 * gudingeveryhourcash Then
MsgBox "余额不足,请先充值", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
Else
If Trim(mrc.Fields(7)) <= 1 / 2 * linshieveryhourcash Then
MsgBox "余额不足,请先充值", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
End If
txtSQL = "select * from online_info"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
While mrcc.EOF = False '判断是有正在上机
If Trim(txtCardID.Text) = Trim(mrcc.Fields(0)) Then
MsgBox "此号正在上机", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
mrcc.MoveNext
End If
Wend
'从Studnet表中获得数据
mrc.Bookmark = mybookmark
txtType.Text = mrc.Fields(14)
txtStudentNO.Text = mrc.Fields(1)
txtSex.Text = mrc.Fields(3)
txtName.Text = mrc.Fields(2)
txtDepartment.Text = mrc.Fields(4)
txtStartDate.Text = Format(Date, "yyyy-mm-dd")
txtStartTime.Text = Time
txtBalance.Text = mrc.Fields(7)
labStart.Visible = True
labEnd.Visible = False
labDoubleEnd.Visible = False
txtEndDate.Text = ""
txtEndTime.Text = ""
txtCostTIme.Text = ""
txtCostCash.Text = ""
mybookmark = ""
mrc.Close
If Trim(txtType.Text) = "固定用户" Then
txtSQL = "select * from basicdata_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.MoveLast
perhourrate = Trim(mrc.Fields(0))
canusetime = (balance / perhourrate) * 60
mrc.Close
Else
txtSQL = "select * from basicdata_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.MoveLast
perhourrate = Trim(mrc.Fields(1))
canusetime = (balance / perhourrate) * 60
mrc.Close
End If
labCount.Caption = Int(labCount.Caption) + 1 '上机人数加1
'将数据添加到ONLine表中
txtSQL = "select * from online_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.AddNew
mrc.Fields(0) = Trim(txtCardID.Text)
mrc.Fields(1) = Trim(txtType.Text)
mrc.Fields(2) = Trim(txtStudentNO.Text)
mrc.Fields(3) = Trim(txtName.Text)
mrc.Fields(4) = Trim(txtDepartment.Text)
mrc.Fields(5) = Trim(txtSex.Text)
mrc.Fields(6) = Trim(txtStartDate.Text)
mrc.Fields(7) = Trim(txtStartTime.Text)
mrc.Fields(8) = Environ("username") '获得计算机名
mrc.Fields(9) = canusetime
mrc.Update
mrc.Close
End If
End If
End If
End Sub
下机:
Private Sub cmdEnd_Click() '单机下机按钮
Dim ontime As String
Dim usetime As Single
Dim usetime1 As Single
If Trim(txtCardID.Text) = "" Then '卡号为空,显示“卡号没有上机”
labDoubleEnd.Visible = True
Else
txtSQL = "select * from online_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
While mrc.EOF = False '判断卡号是否上机
If Trim(txtCardID.Text) = Trim(mrc.Fields(0)) Then
mybookmark = mrc.Bookmark
ontime = Trim(mrc.Fields(7)) '有上机,得到刚上机的时间
mrc.MoveNext
Else
mrc.MoveNext
End If
Wend
If mybookmark = "" Then '输入的卡号没有上机
labDoubleEnd.Visible = True
Exit Sub
Else
'有上机,下机显示的内容
txtSQL = "select * from online_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
txtType.Text = Trim(mrcc.Fields(1))
cardtype = Trim(mrcc.Fields(1)) '获得卡的类型
txtStudentNO.Text = Trim(mrcc.Fields(2))
txtName.Text = Trim(mrcc.Fields(3))
txtDepartment.Text = Trim(mrcc.Fields(4))
txtSex.Text = Trim(mrcc.Fields(5))
txtStartDate.Text = Trim(mrcc.Fields(6))
txtStartTime.Text = Trim(mrcc.Fields(7))
mrcc.Close
labEnd.Visible = True '有上机
txtEndDate.Text = Format(Date, "yyyy-mm-dd")
txtEndTime.Text = Time
'计算花费时间
usetime = DateDiff("n", ontime, Time) ' usetime=time-ontime 得到是分钟
usetime = Int(usetime / 60) '得到小时数
usetime1 = usetime Mod 60 '得到余数为分钟数 ,与上面的分钟不同
If usetime1 <= 30 Then '不足30分钟按半小时计算
usetime1 = 0.5
Else
usetime1 = 1 '大于30分钟按一个小时计算
End If
usetime = usetime + usetime1 '得到所上机的小时数
txtCostTIme.Text = usetime
'计算消费金额
If cardtype = "固定用户" Then '是固定用户的基本数据
txtSQL = "select * from basicdata_info"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
mrcc.MoveLast
perhourrate = Int(mrcc.Fields(0))
txtCostCash.Text = usetime * perhourrate
mrcc.Close
Else '临时用户
txtSQL = "select * from basicdata_info"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
mrcc.MoveLast
perhourrate = Int(mrcc.Fields(1))
txtCostCash.Text = usetime * perhourrate
mrcc.Close
End If
'计算余额
txtSQL = "select * from student_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
txtBalance.Text = Trim(mrcc.Fields(7)) - usetime * perhourrate
mrcc.Fields(7) = Trim(txtBalance.Text)
mrcc.Update
mrcc.Close
labCount.Caption = Int(labCount.Caption) - 1 '下机,人数减1
mrc.Close
mybookmark = ""
End If
End If
txtSQL = "select * from online_info where cardno='" & txtCardID.Text & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
txtSQL = "select * from line_info"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
'将上机情况记录到line表中,并将ONline中的上机记录删除
While mrc.EOF = False
If Trim(txtCardID.Text) = Trim(mrc.Fields(0)) Then
mrcc.AddNew
'此处自动添加内容 mrcc.Fields (0)
mrcc.Fields(1) = Trim(mrc.Fields(0))
mrcc.Fields(2) = Trim(mrc.Fields(2))
mrcc.Fields(3) = Trim(mrc.Fields(3))
mrcc.Fields(4) = Trim(mrc.Fields(4))
mrcc.Fields(5) = Trim(mrc.Fields(5))
mrcc.Fields(6) = Trim(mrc.Fields(6))
mrcc.Fields(7) = Trim(mrc.Fields(7))
mrcc.Fields(8) = Format(Date, "yyyy-mm-dd")
mrcc.Fields(9) = Format(Time, "hh:nn")
mrcc.Fields(10) = Trim(txtCostTIme.Text)
mrcc.Fields(11) = Trim(txtCostCash.Text)
mrcc.Fields(12) = Trim(txtBalance.Text)
mrcc.Fields(13) = "正常下机"
mrcc.Fields(14) = Environ("username")
mrcc.Update
mrcc.Close
mrc.Delete
mrc.Update
mrc.MoveNext
Else
mrc.MoveNext
End If
Wend
mrc.Close
'卡号的消费记录
txtSQL = "select * from cost_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.AddNew
mrc.Fields(0) = Trim(txtCardID.Text)
mrc.Fields(1) = usetime * perhourrate
mrc.Fields(2) = Format(Date, "yyyy-mm-dd")
mrc.Fields(3) = Format(Time, "hh:nn")
mrc.Update
mrc.Close
End Sub
Private Sub cmdStart_Click() '点击上机按钮
Dim gudingeveryhourcash As Integer
Dim linshieveryhourcash As Integer
If Trim(txtCardID.Text) = "" Then
MsgBox "卡号不能为空", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
txtSQL = "select * from student_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = True And mrc.BOF = True Then '没有数据的情况
MsgBox "此卡号没有注册", vbOKOnly + vbExclamation, "警告"
txtCardID.SetFocus
txtCardID.SelStart = 0
txtCardID.SelLength = Len(txtCardID.Text)
Exit Sub
Else
While mrc.EOF = False
If Trim(txtCardID.Text) = Trim(mrc.Fields(0)) Then
mybookmark = mrc.Bookmark '存储书签
mrc.MoveNext
Else
mrc.MoveNext
End If
Wend
End If
If mybookmark = "" Then
MsgBox "此卡号没有注册", vbOKOnly + vbExclamation, "警告"
txtCardID.SetFocus
txtCardID.SelStart = 0
txtCardID.SelLength = Len(txtCardID.Text)
mrc.Close
Exit Sub
Else
mrc.Bookmark = mybookmark '获得位置
balance = Trim(mrc.Fields(7)) '获得余额
cardid = Trim(mrc.Fields(0)) '获得卡号
If "不使用" = Trim(mrc.Fields(10)) Then
MsgBox "此卡尚未注册", vbOKOnly + vbExclamation, "警告"
txtCardID.SetFocus
txtCardID.SelStart = 0
txtCardID.SelLength = Len(txtCardID.Text)
mybookmark = ""
Else
txtSQL = "select * from basicdata_info"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
mrcc.MoveLast
gudingeveryhourcash = Trim(mrcc.Fields(0))
linshieveryhourcash = Trim(mrcc.Fields(1))
mrcc.Close
If Trim(mrc.Fields(14)) = "固定用户" Then
If Trim(mrc.Fields(7)) <= 1 / 2 * gudingeveryhourcash Then
MsgBox "余额不足,请先充值", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
Else
If Trim(mrc.Fields(7)) <= 1 / 2 * linshieveryhourcash Then
MsgBox "余额不足,请先充值", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
End If
txtSQL = "select * from online_info"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
While mrcc.EOF = False '判断是有正在上机
If Trim(txtCardID.Text) = Trim(mrcc.Fields(0)) Then
MsgBox "此号正在上机", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
mrcc.MoveNext
End If
Wend
'从Studnet表中获得数据
mrc.Bookmark = mybookmark
txtType.Text = mrc.Fields(14)
txtStudentNO.Text = mrc.Fields(1)
txtSex.Text = mrc.Fields(3)
txtName.Text = mrc.Fields(2)
txtDepartment.Text = mrc.Fields(4)
txtStartDate.Text = Format(Date, "yyyy-mm-dd")
txtStartTime.Text = Time
txtBalance.Text = mrc.Fields(7)
labStart.Visible = True
labEnd.Visible = False
labDoubleEnd.Visible = False
txtEndDate.Text = ""
txtEndTime.Text = ""
txtCostTIme.Text = ""
txtCostCash.Text = ""
mybookmark = ""
mrc.Close
If Trim(txtType.Text) = "固定用户" Then
txtSQL = "select * from basicdata_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.MoveLast
perhourrate = Trim(mrc.Fields(0))
canusetime = (balance / perhourrate) * 60
mrc.Close
Else
txtSQL = "select * from basicdata_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.MoveLast
perhourrate = Trim(mrc.Fields(1))
canusetime = (balance / perhourrate) * 60
mrc.Close
End If
labCount.Caption = Int(labCount.Caption) + 1 '上机人数加1
'将数据添加到ONLine表中
txtSQL = "select * from online_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.AddNew
mrc.Fields(0) = Trim(txtCardID.Text)
mrc.Fields(1) = Trim(txtType.Text)
mrc.Fields(2) = Trim(txtStudentNO.Text)
mrc.Fields(3) = Trim(txtName.Text)
mrc.Fields(4) = Trim(txtDepartment.Text)
mrc.Fields(5) = Trim(txtSex.Text)
mrc.Fields(6) = Trim(txtStartDate.Text)
mrc.Fields(7) = Trim(txtStartTime.Text)
mrc.Fields(8) = Environ("username") '获得计算机名
mrc.Fields(9) = canusetime
mrc.Update
mrc.Close
End If
End If
End If
End Sub
里面来回使用很多张表,在下机代码中,有一部分是关于金额的计算的,我是那样算的,是不是感觉我有点奸商的感觉呢,嘿嘿!
除此以外还多添加了一个Timer控件.
Private Sub Timer2_Timer()
Timer2.Enabled = True
Timer2.Interval = 10000 '一分钟
Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
Dim cardno As String
txtSQL = "select * from online_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
Do While mrc.EOF = False
If mrc.Fields(9) = 30 Then '可使用时间为30分钟
cardno = Trim(mrc.Fields(0))
MsgBox "卡号:" & cardno & "余额不足,请去充值!", vbOKOnly + vbExclamation, "提示"
mrc.MoveNext
Else
mrc.MoveNext
End If
Loop
txtSQL = "select * from online_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
Do While mrc.EOF = False
If mrc.Fields(9) = 0 Then '可使用时间为0
cardno = Trim(mrc.Fields(0))
MsgBox "卡号:" & cardno & "时间到,强制下机!", vbOKOnly + vbExclamation, "提示"
mrc.Delete
mrc.Update
labCount.Caption = labCount.Caption - 1
mrc.MoveNext
Else
mrc.MoveNext
End If
Loop
txtSQL = "select * from online_info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
Do While mrc.EOF = False
mrc.Fields(9) = mrc.Fields(9) - 1 '所有卡的使用时间减1
mrc.MoveNext
Loop
End Sub
在这个Timer控件中,每过一分钟,就会在在可以使用的时间里面减少一分钟,在还剩30分钟的时候会显示余额不足的提示框,在可使用时间还剩0分钟的时候 ,会强制用户下机。
这就是我所写的上下机,希望能给大家带来一些灵感。