【机房收费系统】——上下机
上下机在机房收费系统中处于核心的位置，所有机房中的窗体都是围着上下机展开。注册窗体为上机提供了一个必要的前提，拥有自己的卡号才可以实现上机操作。与下机直接相连的就是对于上机金额的计算。每个人对于金额的计算不同，所使用的公式也不尽相同。
在上机操作中，主要涉及三大方面的内容：查询（student，online）、判断（basicdata）、写入数据（online）。逻辑关系比较清晰，不涉及对于金额的计算，只是简单的判断。下机操作，难点在计算金额是需要判断上机用户的类型。对于固定用户和临时用户所执行的操作是不同的。临时用户下机会执行退卡操作，临时用户和机房仅仅存在一次使用的关系，没有建立长期合作的关系，并不会享有机房的优惠政策。
上机操作代码：
Private Sub Command1_Click()
'注意对应临时用户和固定用户不同的操作。他们的最低消费不同。就是最低金额可以登录时的金额要进行分别的判断。
Dim mrcc As ADODB.Recordset
Dim mrb As ADODB.Recordset
If txtCardno.Text = "" Then '判断是否输入卡号，。
MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
txtCardno.SetFocus
Exit Sub
End If
'学生表中的卡号和文本框中的卡号相连接
txtsql = "select * from student_info where cardno = '" & Trim(txtCardno.Text) & "' And status= '" & "使用" & "'"
Set mrc = ExecuteSQL(txtsql, msgtext) 'mrc用于student表的查询
If mrc.EOF Then '如果不存在该学生卡号
MsgBox "此卡尚未注册！", vbOKOnly + vbExclamation, "警告"
txtCardno.Text = ""
txtCardno.SetFocus
Exit Sub '文本框的内容清空。
txtType.Text = "'"
txtStudentNo.Text = ""
txtStudentName.Text = ""
txtDepartment.Text = ""
txtSex.Text = ""
txtOnDate.Text = ""
txtOnTime.Text = ""
txtOffDate.Text = ""
txtOffTime.Text = ""
txtConsume.Text = ""
txtConsumeTime.Text = ""
txtCash.Text = ""
txtConsume.Text = ""
Else '在学生表中查到了此记录，可以打开online表进行操作了
txtsql = "select * from online_info where cardno = '" & Trim(txtCardno.Text) & "'" '打开online表首先，查是否改号已经上机了
Set mrcc = ExecuteSQL(txtsql, msgtext) 'mrcc游标用于online表的添加
If mrcc.EOF = False Then '判断卡号是否已上机
MsgBox "此卡正在上机！", vbOKOnly + vbExclamation, "警告"
'以上机则去上机表中获得当前的记录。
txtType.Text = mrc.Fields(14)
txtStudentNo.Text = mrc.Fields(1)
txtStudentName.Text = mrc.Fields(2)
txtDepartment.Text = mrc.Fields(4)
txtSex.Text = mrc.Fields(3)
txtOnDate.Text = mrcc.Fields(6)
txtOnTime.Text = mrcc.Fields(7)
txtOffDate.Text = ""
txtOffTime.Text = ""
txtConsume.Text = ""
txtConsumeTime.Text = ""
txtCash.Text = mrc.Fields(7)
txtConsume.Text = ""
Else '证明此卡并未上机，则可以进行上机操作。
txtsql = "select * from basicdata_info "
Set mrb = ExecuteSQL(txtsql, msgtext) '表basicdata的查询，余额不足时进行提示。
If Trim(mrc.Fields(14)) = "临时用户" Then '如果为临时用户则。
If mrc.Fields(7) < mrb.Fields(1) Then
'student表中的余额小于basicdata表中对应临时用户每小时最低消费金额则不可以上机。
MsgBox "余额不足，请充值后在上机！", vbOKOnly + vbExclamation, "警告"
Else '可以上机向online表中添加一条新纪录。
mrcc.AddNew
mrcc.Fields(0) = mrc.Fields(0)
mrcc.Fields(1) = mrc.Fields(14)
mrcc.Fields(2) = mrc.Fields(1)
mrcc.Fields(3) = mrc.Fields(2)
mrcc.Fields(4) = mrc.Fields(4)
mrcc.Fields(5) = mrc.Fields(3)
mrcc.Fields(6) = Format(Now, "yyyy-mm-dd")
mrcc.Fields(7) = Time
mrcc.Fields(8) = VBA.Environ("computername")
mrcc.Update
txtType.Text = mrc.Fields(14)
txtStudentNo.Text = mrc.Fields(1)
txtStudentName.Text = mrc.Fields(2)
txtDepartment.Text = mrc.Fields(4)
txtSex.Text = mrc.Fields(3)
txtOnDate.Text = mrcc.Fields(6)
txtOnTime.Text = mrcc.Fields(7)
txtCash.Text = mrc.Fields(7)
mrcc.Close
MsgBox "您已成功上机！", vbOKOnly + vbExclamation, "提示"
End If
Else '为固定用户、
If mrc.Fields(7) < mrb.Fields(0) Then
'student表中的余额小于basicdata表中对应固定用户每小时最低消费金额则不可以上机。
MsgBox "余额不足，请充值后再上机！", vbOKOnly + vbExclamation, "警告"
Else '可以上机向online表中添加一条新纪录。
mrcc.AddNew
mrcc.Fields(0) = mrc.Fields(0)
mrcc.Fields(1) = mrc.Fields(14)
mrcc.Fields(2) = mrc.Fields(1)
mrcc.Fields(3) = mrc.Fields(2)
mrcc.Fields(4) = mrc.Fields(4)
mrcc.Fields(5) = mrc.Fields(3)
mrcc.Fields(6) = Format(Now, "yyyy-mm-dd")
mrcc.Fields(7) = Time
mrcc.Fields(8) = VBA.Environ("computername")
mrcc.Update
txtType.Text = mrc.Fields(14)
txtStudentNo.Text = mrc.Fields(1)
txtStudentName.Text = mrc.Fields(2)
txtDepartment.Text = mrc.Fields(4)
txtSex.Text = mrc.Fields(3)
txtOnDate.Text = mrcc.Fields(6)
txtOnTime.Text = mrcc.Fields(7)
mrcc.Close
MsgBox "您已成功上机！", vbOKOnly + vbExclamation, "提示"
End If
End If
End If
End If
txtsql = "select count(cardno) from online_Info " '获得当前电脑的上机人数
Set mrc = ExecuteSQL(txtsql, msgtext)
computer.Caption = "当前上机人数为：" & mrc.Fields(0)
End Sub
下机操作代码：
Private Sub downline_Click()
Dim mrcc As ADODB.Recordset '用于line表的查询
Dim mrb As ADODB.Recordset
Dim mrbb As ADODB.Recordset
Dim mr As ADODB.Recordset
If txtCardno.Text = "" Then '首先检查是否输入卡号，卡号是否为空
MsgBox "请输入卡号！再下机。", vbOKOnly + vbExclamation, ""
txtCardno.SetFocus
Exit Sub
End If
txtsql = "select * from online_info where cardno = '" & Trim(txtCardno.Text) & "'" '对于上机表的查看，如果没有上机则进行提示。
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF Then '没有上机的情况，
MsgBox "该号没有上机！", vbOKOnly + vbExclamation, "警告"
txtCardno.Text = ""
txtCardno.SetFocus
Exit Sub
Else '改号以上机不可重复操作，在文本框中显示出上机的情况。
txtsql = "select * from line_info "
Set mrcc = ExecuteSQL(txtsql, msgtext)
mrcc.AddNew
mrcc.Fields(1) = mrc.Fields(0)
mrcc.Fields(2) = mrc.Fields(2)
mrcc.Fields(3) = mrc.Fields(3)
mrcc.Fields(4) = mrc.Fields(4)
mrcc.Fields(5) = mrc.Fields(5)
mrcc.Fields(6) = mrc.Fields(6)
mrcc.Fields(7) = mrc.Fields(7)
mrcc.Fields(8) = Format(Now, "yyyy-mm-dd")
mrcc.Fields(9) = Time
mrcc.Fields(10) = DateDiff("n", mrc.Fields(9), Now) '消费时间的计算。
mrcc.Fields(13) = Trim("正常下机")
mrcc.Fields(14) = VBA.Environ("computername") '电脑号的添加。
txtsql = "select * from student_info where cardno = '" & Trim(txtCardno.Text) & "'" '计算消费金额。
Set mrb = ExecuteSQL(txtsql, msgtext) '临时用户和固定用户的每小时消费金额不同。
txtsql = "select * from basicdata_info " '打开basicdata表
Set mrbb = ExecuteSQL(txtsql, msgtext)
'如果消费的时间在准备时间之内，没有消费金额。即免费。
If mrcc.Fields(10) < mrbb.Fields(4) Then
mrcc.Fields(11) = Val(Trim(0))
mrcc.Fields(12) = Val(mrb.Fields(7))
mrcc.Update
mrc.Delete '删除上机表中的记录
mrc.Update '更新上机表表
MsgBox "下机成功！"
'临时用户下机等于退卡。
If Trim(mrb.Fields(14)) = "临时用户" Then
MsgBox "您是临时用户即将执行退卡操作。", vbOKOnly + vbExclamation, "警告"
Call Add
End If
' 每个文本框获取数据库中的内容?
txtCardno.Text = mrcc.Fields(1)
txtType.Text = mrb.Fields(14)
txtStudentNo.Text = mrcc.Fields(2)
txtStudentName.Text = mrcc.Fields(3)
txtDepartment.Text = mrcc.Fields(4)
txtSex.Text = mrcc.Fields(5)
txtOnDate.Text = mrcc.Fields(6)
txtOnTime.Text = mrcc.Fields(7)
txtOffDate.Text = mrcc.Fields(8)
txtOffTime.Text = mrcc.Fields(9)
txtConsumeTime.Text = mrcc.Fields(10)
txtCash.Text = mrcc.Fields(12)
txtConsume.Text = mrcc.Fields(11) '
'
Else '消费的时间已经超过了准备时间，则不可免费上机。
'用于消费时间是否小于最低时间。打开basicdata表。在最低消费时间以内则扣除固定的金额。
If mrbb.Fields(3) > mrcc.Fields(10) Then
MsgBox "消费时间小于最低消费时间，扣除您一元消费金额。", vbOKOnly + vbExclamation, "警告"
mrcc.Fields(11) = Val(Trim(1))
mrcc.Fields(12) = Val(mrb.Fields(7)) - Val(mrcc.Fields(11)) '余额的计算。
mrb.Fields(7) = mrcc.Fields(12) '学生表中的余额更新。
mrb.Update
mrcc.Update
mrc.Delete '删除上机表中的记录
mrc.Update '更新上机表表
MsgBox "下机成功！"
'临时用户下机等于退卡。
If Trim(mrb.Fields(14)) = "临时用户" Then '临时用户则退卡
MsgBox "您是临时用户即将执行退卡操作。", vbOKOnly + vbExclamation, "警告"
Call Add
End If
'每个文本框获取数据库中的内容。
txtCardno.Text = mrcc.Fields(1)
txtType.Text = mrb.Fields(14)
txtStudentNo.Text = mrcc.Fields(2)
txtStudentName.Text = mrcc.Fields(3)
txtDepartment.Text = mrcc.Fields(4)
txtSex.Text = mrcc.Fields(5)
txtOnDate.Text = mrcc.Fields(6)
txtOnTime.Text = mrcc.Fields(7)
txtOffDate.Text = mrcc.Fields(8)
txtOffTime.Text = mrcc.Fields(9)
txtConsumeTime.Text = mrcc.Fields(10)
txtCash.Text = mrcc.Fields(12)
txtConsume.Text = mrcc.Fields(11)
Else '消费的时间为正常的时间，按照平时情况进行计算。
If Trim(mrb.Fields(14)) = "临时用户" Then '消费金额的计算
'临时用户的计算
mrcc.Fields(11) = (Int(Val(mrcc.Fields(10) - Val(mrbb.Fields(4))) / Val(mrbb.Fields(2))) + 1) * Val(mrbb.Fields(1))
Else
mrcc.Fields(11) = (Int(Val(mrcc.Fields(10) - Val(mrbb.Fields(4))) / Val(mrbb.Fields(2))) + 1) * Val(mrbb.Fields(0))
End If
mrcc.Fields(12) = Val(mrb.Fields(7)) - Val(mrcc.Fields(11)) '余额的计算
mrb.Fields(7) = mrcc.Fields(12) '学生表中的余额更新。
mrcc.Update
mrc.Delete '删除上机表中的记录
mrc.Update '更新上机表表
mrb.Update
' mrc.Close
MsgBox "下机成功！"
'临时用户下机等于退卡。
If Trim(mrb.Fields(14)) = "临时用户" Then
MsgBox "您是临时用户即将执行退卡操作。", vbOKOnly + vbExclamation, "警告"
Call Add
End If
'每个文本框获取数据库中的内容。
txtCardno.Text = mrcc.Fields(1)
txtType.Text = mrb.Fields(14)
txtStudentNo.Text = mrcc.Fields(2)
txtStudentName.Text = mrcc.Fields(3)
txtDepartment.Text = mrcc.Fields(4)
txtSex.Text = mrcc.Fields(5)
txtOnDate.Text = mrcc.Fields(6)
txtOnTime.Text = mrcc.Fields(7)
txtOffDate.Text = mrcc.Fields(8)
txtOffTime.Text = mrcc.Fields(9)
txtConsumeTime.Text = mrcc.Fields(10)
txtCash.Text = mrcc.Fields(12)
txtConsume.Text = mrcc.Fields(11)
End If
End If
End If '
'获取当前的上机人数。显示在标签框中。
txtsql = "select count(cardno) from online_Info "
Set mrc = ExecuteSQL(txtsql, msgtext)
computer.Caption = "当前上机人数为：" & mrc.Fields(0)
End Sub
退卡操作代码：
Private Function Add() '临时用户退卡的操作。 SetParent frmOffcard.hWnd, frmMain.hWnd frmOffcard.Show frmOffcard.txtCardno = frmMain.txtCardno frmOffcard.cmdOK = True End Function