【机房收费系统】——上下机
用户登录系统后消费，上下机是首要的操作，这一部分我花了很长时间才完成，中间遇到的问题不计其数，但最终还是解决了，心里的石头总算落下了。先来看图说说思路吧。
一、知识网
二、代码解释
（一）上机：
Private Sub cmdonLine_Click()
'从student中查询cardno
txtSQL = "select * from student_info where cardno= '" & txtCardno.Text & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
'判断卡号是否为空
If txtCardno.Text = "" Then
MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
txtCardno.SetFocus
txtCardno.Text = ""
Exit Sub
End If
'检查卡号是否存在
If mrc.EOF And mrc.BOF Then
MsgBox "卡号不存在！", vbOKOnly + vbExclamation, "警告"
txtCardno.SetFocus '获得焦点
txtCardno.Text = "" '定义数据集对象
Exit Sub
End If
'查询基本数据设定表
txtSQL = "select * from basicdata_info "
Set mrcdata = ExecuteSQL(txtSQL, MsgText)
'判断该卡号余额是否充足
If mrc.Fields(7) < mrcdata.Fields(5) Then
MsgBox "余额只有" & mrc.Fields(7) & ",少于最少金额，请先充值！", vbOKOnly, "警告!"
txtCardno.Text = "" '清空
txtCardno.SetFocus '获得焦点
Exit Sub
End If
'判断该卡号是否在上机
txtSQL = "select * from online_info where cardno= '" & txtCardno.Text & "'"
Set onmrc = ExecuteSQL(txtSQL, MsgText)
'数据库中是否为空
If (onmrc.EOF Or onmrc.BOF) = False Then '若不为空
MsgBox "该卡号正在上机！", vbOKOnly + vbExclamation, "警告" '提示正在上机
'如果在上机则从onmrc中调取上机记录显示在text中
txtType = Trim(onmrc.Fields(1))
txtStudentno = Trim(onmrc.Fields(2))
txtStudentname = Trim(onmrc.Fields(3))
txtDepartment = Trim(onmrc.Fields(4))
txtSex = Trim(onmrc.Fields(5))
txtOndate = Trim(Format(onmrc.Fields(6), "yyyy-mm-dd"))
txtOntime = Trim(Format(onmrc.Fields(7), "hh:mm:ss"))
txtCash = Trim(mrc.Fields(7))
Else
'如果没上机，查询student中记录
txtSQL = "select * from online_info where cardno='" & txtCardno & "'"
Set onmrc = ExecuteSQL(txtSQL, MsgText)
'将信息显示在text框中
txtType = Trim(mrc.Fields(14))
txtStudentno = Trim(mrc.Fields(1))
txtStudentname = Trim(mrc.Fields(2))
txtDepartment = Trim(mrc.Fields(4))
txtSex = Trim(mrc.Fields(3))
txtOndate = Trim(Format(Date, "yyyy-mm-dd"))
txtOntime = Trim(Format(Time, "hh:mm:ss"))
txtCash = Trim(mrc.Fields(7))
'更新上机online数据库
onmrc.AddNew
onmrc.Fields(0) = Trim(txtCardno)
onmrc.Fields(1) = Trim(txtType)
onmrc.Fields(2) = Trim(txtStudentno)
onmrc.Fields(3) = Trim(txtStudentname)
onmrc.Fields(4) = Trim(txtDepartment)
onmrc.Fields(5) = Trim(txtSex)
onmrc.Fields(6) = Trim(Format(txtOndate, "yyyy-mm-dd"))
onmrc.Fields(7) = Trim(Format(txtOntime, "hh:mm:ss"))
onmrc.Fields(8) = Trim(VBA.Environ("computername")) '机器名
onmrc.Fields(9) = Trim(Now) '当前时间
onmrc.Update '更新数据集对象
onmrc.close '关闭数据集对象
'提示上机成功
MsgBox "上机成功！", vbOKOnly + vbExclamation, "警告"
' txtcardno.Text = "" '清空卡号
txtCardno.SetFocus '获得焦点
End If
'上机清空文本框
txtOfftime = ""
txtOffdate = ""
txtConsumetime = ""
txtConsume = ""
End Sub（二）下机：
Private Sub cmdLine_Click()
'定义变量
Dim Leasttime, Pretime As Integer
Dim intLinetime As Integer
Dim Consumetime As Integer
Dim curConsume As Currency
Dim curCash As Currency
Dim strType As String
'从student中查卡号
txtSQL = "select * from student_info where cardno= '" & txtCardno.Text & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
'获取online表中的数据
txtSQL = "select * from online_info"
Set onmrc = ExecuteSQL(txtSQL, MsgText)
'卡号是否为空
If txtCardno.Text = "" Then
MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
txtCardno.SetFocus
txtCardno.Text = ""
Exit Sub
End If
'该卡号是否已注册
If mrc.EOF Then
MsgBox "该卡号未注册！", vbOKOnly + vbExclamation, "警告"
txtCardno.SetFocus
txtCardno.Text = ""
Exit Sub
End If
'查上机卡号
txtSQL = "select * from online_info where cardno='" & Trim(txtCardno.Text) & "'"
Set onmrc = ExecuteSQL(txtSQL, MsgText)
'如果未上机，则提示未上机
If onmrc.EOF Then
MsgBox "该卡号未上机！", vbOKOnly + vbExclamation, "警告"
txtCardno.Text = "" '清空
txtCardno.SetFocus '获得焦点
Exit Sub
End If
'查basicdata表
txtSQL = "select * from basicdata_info"
Set mrcdata = ExecuteSQL(txtSQL, MsgText)
'得出准备时间和至少上机时间
Pretime = Val(Trim(mrcdata.Fields(4)))
Leasttime = Val(Trim(mrcdata.Fields(3)))
'计算消费时间
txtSQL = "select * from online_info where cardno='" & Trim(txtCardno.Text) & "'"
Set onmrc = ExecuteSQL(txtSQL, MsgText)
intLinetime = (Date - DateValue(onmrc!Ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(onmrc!ontime))) * 60 + (Minute(Time) - Minute(TimeValue(onmrc!ontime)))
' intlinetime = Val(DateDiff("n", offtime, ontime))
'如果实际上机时间小于准备时间，则不收钱
If intLinetime <= Pretime Then
Consumetime = "0.0"
Else '否则消费时间 = 实际上机时间 - 准备时间
Consumetime = intLinetime - Pretime
If Consumetime < Leasttime Then '如果消费时间小于至少上机时间
Consumetime = Leasttime '则按最少时间算
Else '若消费时间大于至少上机时间
Consumetime = Round(Consumetime / mrcdata.Fields(2)) * mrcdata.Fields(2) 'round函数四舍五入
End If
End If
'不同用户每小时的收费
If strType = "固定用户" Then
curConsume = Consumetime / 60 * mrcdata.Fields(0) '固定用户每小时消费金额
Else
curConsume = Consumetime / 60 * mrcdata.Fields(1) '临时用户每小时消费金额
End If
'判断消费金额是否小于最低收费
If curConsume > 0 And curConsume < mrcdata.Fields(5) Then
curConsume = mrcdata.Fields(5)
End If
'计算余额//{账户余额=原-消费}
curCash = mrc!Cash - curConsume
'下机信息显示
txtSQL = "select * from online_info"
Set onmrc = ExecuteSQL(txtSQL, MsgText)
'显示下机信息
txtOfftime = Format(Time, "hh:mm:ss")
txtOffdate = Format(Date, "yyyy-mm-dd")
txtType = Trim(onmrc.Fields(1))
txtStudentno = Trim(onmrc.Fields(2))
txtStudentname = Trim(onmrc.Fields(3))
txtDepartment = Trim(onmrc.Fields(4))
txtSex = Trim(onmrc.Fields(5))
txtOndate = Format(onmrc.Fields(6), "yyyy-mm-dd")
txtOntime = Format(onmrc.Fields(7), "hh:mm:ss")
txtConsumetime.Text = Consumetime
txtConsume.Text = curConsume
txtCash.Text = curCash
'更新学生信息表余额
mrc!Cash = txtCash
mrc.Update
mrc.close
'更新下机表记录
txtSQL = "select * from line_info "
Set lmrc = ExecuteSQL(txtSQL, MsgText)
lmrc.AddNew
lmrc.Fields(1) = Trim(txtCardno)
lmrc.Fields(2) = Trim(txtStudentno)
lmrc.Fields(3) = Trim(txtStudentname)
lmrc.Fields(4) = Trim(txtDepartment)
lmrc.Fields(5) = Trim(txtSex)
lmrc.Fields(6) = Trim(Format(txtOndate, "yyyy-mm-dd"))
lmrc.Fields(7) = Trim(Format(txtOntime, "hh:mm:ss"))
lmrc.Fields(8) = Trim(Format(Date, "yyyy-mm-dd"))
lmrc.Fields(9) = Trim(Format(Time, "hh:mm:ss"))
lmrc.Fields(10) = Trim(txtConsumetime)
lmrc.Fields(11) = Val(Trim(txtConsume))
lmrc.Fields(12) = Val(Trim(txtCash))
lmrc.Fields(13) = "正常下机"
lmrc.Fields(14) = Trim(VBA.Environ("computername"))
lmrc.Update '更新下机数据集对象
lmrc.close '关闭数据集对象
'提示下机成功
MsgBox "您已成功下机！", vbOKOnly + vbExclamation, "警告"
Call ExecuteSQL(txtSQL, MsgText)
'删除相应的在线卡状态表记录
onmrc.Delete
LabelNum.Caption = LabelNum.Caption - 1 '更新上机人数
'下机清空文本框中的记录
txtCardno.Text = ""
txtOfftime.Text = ""
txtOffdate.Text = ""
txtStudentno.Text = ""
txtStudentname.Text = ""
txtDepartment.Text = ""
txtSex.Text = ""
txtType.Text = ""
txtOndate.Text = ""
txtOntime.Text = ""
txtConsumetime.Text = ""
txtConsume.Text = ""
txtCash.Text = ""
txtCardno.SetFocus '卡号框获得焦点，方便用户
End Sub
三、总结
通过这次做上下机，清楚了基本流程，锻炼了自信心，增加了代码熟练度，考虑更周全了，总之受益很大，机房收费系统的完成，告诉我，一接触就知道敲代码是不可取的，而思路才是最重要的，只要先梳理好思路，敲起代码来很容易就可以完成。