前言：在十一结束的时候，机房收费系统的基本功能终于完成了，但因为自考的缘故，也没有一直写博客总结，今天就趁着闲暇时间完成总结，完美收官。
机房收费系统的上下机是最基本的功能，简单来说，收费、统计等功能都是建立在上下机以及相连的数据库表之上的，没有上下机，其他都是空谈。
上机：上机很简单，流程就是操作员给要上机的用户上机，在用户名处输入学号，然后点击上机，将上机的用户从学生表中找出，并将部分数据传递给Online表中，从而完成上机。
流程图：
代码部分：
Private Sub cmdOnline_Click()
Dim mrcbd As ADODB.Recordset
Dim mrcol As ADODB.Recordset
'下机按钮可用
cmdOffline.Enabled = True
'若卡号框为空
If txtCardID.Text = "" Then
Label14.Caption = "请输入卡号！"
txtCardID.SetFocus
Exit Sub
Else
If Not IsNumeric(Trim(txtCardID.Text)) Then
Label14.Caption = "请输入数字！"
txtCardID.Text = ""
txtCardID.SetFocus
Exit Sub
End If
End If
'查询学生表中卡号列
txtSQL = "select * from student_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcs = ExecuteSQL(txtSQL, MsgText)
'第一次判断是否有用户
If mrcs.EOF Then
Label14.Caption = "没有该用户，请注册或核实信息是否正确！"
txtCardID.SetFocus
txtCardID.Text = ""
Exit Sub
Else
'第二次判断是否用户正在上机
txtSQL = "select * from online_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcol = ExecuteSQL(txtSQL, MsgText)
'如果用户正在上机
If mrcol.EOF = False Then
Label14.Caption = "该用户正在上机！"
txtCardID.Text = mrcs!cardno
txtType.Text = mrcs!Type
txtSID.Text = mrcs!studentno
txtName.Text = mrcs!studentname
txtFaculty.Text = mrcs!department
txtGender.Text = mrcs!sex
txtOnlineDate.Text = mrcs!Date
txtOnlineTime.Text = mrcs!Time
lblUserName.Caption = UserName
txtBalance.Text = mrcs!cash
Exit Sub
Else
'第三次判断用户余额是否充足
'该处一定要用where来判断是对哪一列数据的对比
txtSQL = "select * from student_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcs = ExecuteSQL(txtSQL, MsgText)
txtSQL = "select * from basicdata_info "
Set mrcbd = ExecuteSQL(txtSQL, MsgText)
If Val(mrcs.Fields(7)) < Val(mrcbd.Fields(5)) Then
Label14.Caption = "账户余额不足！请充值后登陆！"
txtCardID.Text = ""
txtCardID.SetFocus
Exit Sub
Else
'若都符合条件，数据库内数据显示到界面
txtCardID.Text = mrcs!cardno
txtType.Text = mrcs!Type
txtSID.Text = mrcs!studentno
txtName.Text = mrcs!studentname
txtFaculty.Text = mrcs!department
txtGender.Text = mrcs!sex
txtOnlineDate.Text = Date
txtOnlineTime.Text = Time
txtBalance.Text = mrcs!cash
txtOfflineDate.Text = ""
txtOfflineTime.Text = ""
txtCostMoney.Text = ""
txtCostTime.Text = ""
'更新online表
txtSQL = "select * from online_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcol = ExecuteSQL(txtSQL, MsgText)
mrcol.AddNew
mrcol.Fields(0) = Trim(txtCardID.Text)
mrcol.Fields(1) = Trim(txtType.Text)
mrcol.Fields(2) = Trim(txtSID.Text)
mrcol.Fields(3) = Trim(txtName.Text)
mrcol.Fields(4) = Trim(txtFaculty.Text)
mrcol.Fields(5) = Trim(txtGender.Text)
mrcol.Fields(6) = Date
mrcol.Fields(7) = Time
'获取计算机的名字和日期
mrcol.Fields(8) = Trim(VBA.Environ("computername"))
mrcol.Fields(9) = Date
'更新上机人数
txtSQL = "select * from online_info"
Set mroln = ExecuteSQL(txtSQL, MsgText)
If mroln.EOF = False Then
Label16.Caption = mroln.RecordCount
Else
Label16.Caption = 0
End If
txtBalance.Text = Trim(mrcs!cash)
'更新表
mrcol.Update
MsgBox "上机成功!", 0 + 48, "提示"
mrcol.Close
'提示框清除数据，防止以前报错的信息遗留
Label14.Caption = ""
End If
End If
End If
End Sub
下机则是将要下机的用户从界面中"取消登陆的状态"，从数据库Online表中删掉，再添加到line表中，并且通过Basicdata表中的计费数据，进行计算。之后根据用户所消费的金额，从余额中扣除金钱，从而更新学生表
下机代码：
Private Sub cmdOffline_Click()
Dim mrcol As ADODB.Recordset
Dim mrcl As ADODB.Recordset
Dim mrcoloff As ADODB.Recordset
Dim offlinetime As Integer
Dim mrcbd As ADODB.Recordset
Dim costtime As String
Dim costday As String
Dim alltime As String
Dim unittime As String
'判断是否输入卡号
If txtCardID.Text = "" Then
Label14.Caption = "请输入卡号！"
txtCardID.SetFocus
Exit Sub
End If
'查询online表中的卡号列
txtSQL = "select * from online_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcol = ExecuteSQL(txtSQL, MsgText)
'判断该用户是否正在上机
If mrcol.EOF Then
Label14.Caption = "该用户尚未上机！"
txtCardID.SetFocus
txtCardID.Text = ""
Exit Sub
Else
'消费时间计算
costday = DateDiff("n", mrcol!ondate, Date)
costtime = DateDiff("n", mrcol!OnTime, Time)
alltime = Val(costday) + Val(costtime)
txtSQL = "select * from basicdata_info "
Set mrcbd = ExecuteSQL(txtSQL, MsgText)
'判断是什么类型用户，从而进行计费
If Trim(mrcol!cardtype) = "固定用户" Then
txtCostMoney = alltime / 60 * mrcbd!Rate
Else
txtCostMoney = alltime / 60 * mrcbd!tmprate
End If
'判断是否超过准备时间
If costtime < mrcbd!leastTime Then
txtCostMoney = 0
End If
'将各表中的部分数据更新到桌面
txtSQL = "select * from online_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcoloff = ExecuteSQL(txtSQL, MsgText)
txtCardID.Text = mrcoloff.Fields(0)
txtType.Text = mrcoloff!cardtype
txtSID.Text = mrcoloff.Fields(2)
txtName.Text = mrcoloff.Fields(3)
txtFaculty.Text = mrcoloff.Fields(4)
txtGender.Text = mrcoloff.Fields(5)
txtOnlineDate.Text = Trim(mrcoloff.Fields(6))
txtOnlineTime.Text = Trim(mrcoloff.Fields(7))
lblUserName.Caption = UserName
txtOfflineDate.Text = Date
txtOfflineTime.Text = Time
txtBalance.Text = Trim(mrcs!cash) - txtCostMoney.Text
txtCostTime.Text = str(alltime)
'将桌面信息记录到下机表line表中
txtSQL = "select * from line_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcl = ExecuteSQL(txtSQL, MsgText)
mrcl.AddNew
mrcl!cardno = mrcoloff!cardno
mrcl!studentno = mrcoloff!studentno
mrcl!studentname = mrcoloff!studentname
mrcl!department = mrcoloff!department
mrcl!sex = mrcoloff!sex
mrcl!ondate = mrcoloff!ondate
mrcl!OnTime = mrcoloff!OnTime
mrcl.Fields(8) = Date
mrcl.Fields(9) = Time
mrcl.Fields(10) = alltime
mrcl.Fields(11) = Val(txtCostMoney)
mrcl.Fields(12) = Trim(txtBalance.Text)
mrcl.Fields(13) = "正常下机"
mrcl.Fields(14) = Trim(VBA.Environ("computername"))
mrcl.Update
'将余额更新至学生表中
txtSQL = "select * from student_info where cardno='" & Trim(txtCardID.Text) & "'"
Set mrcs = ExecuteSQL(txtSQL, MsgText)
mrcs!cash = Trim(txtBalance.Text)
mrcs.Update
'删除上机表中的要下机的数据
mrcoloff.Delete
MsgBox "下机成功", 0 + 48, "提示"
mrcoloff.Close
'更新上机人数
txtSQL = "select * from online_info"
Set mroln = ExecuteSQL(txtSQL, MsgText)
If mroln.EOF = False Then
Label16.Caption = mroln.RecordCount
Else
Label16.Caption = 0
End If
End If
'禁用下机按钮
cmdOffline.Enabled = False
End Sub
总结：上下机其实就是对数据表中，信息的增加、修改或删除。
难点：下机消费时间与金额的计算，以及对之后表的更新，这期间逻辑一定要十分清晰。