机房收费系统之上下机
在敲上下机之前，没有从程序的角度来理解上下机，就以一个用户的身份来想了想这个功能。所以等到敲得时候只能大眼瞪小眼了……
做每一件事，我们都要有一个宏观的认识，只有大方向掌握了，我们才不会走很多的弯路！
首先我们先来缕一遍上下机的逻辑：
上机：
根据上机逻辑图，我们可以看出我们用到了：student_Info 、BasicData_Info、Online_Info 表。
下机：
根据下机逻辑图，我们用到了：student_Info 、BasicData_Info、Online_Info和Line_Info 表。
上下机的逻辑掌握了，接下来就是代码实现功能的时候了：
上机：
<span style="font-size:24px;">'判断卡号是否为空
If txtkahao.Text = "" Then
MsgBox "请输入卡号！", vbOKOnly, "警告"
txtkahao.SetFocus
Exit Sub
End If
'判断卡号输入的是否是数字
If Not IsNumeric(txtkahao.Text) Then
MsgBox "卡号请输入数字！", vbOKOnly, "警告"
txtkahao.Text = ""
txtkahao.SetFocus
Exit Sub
Else
'查询数据库里学生基本信息表
' Set objRst = New ADODB.Recordset
strSQL = "select * from student_Info where cardno= '" & Trim(txtkahao.Text) & "'"
Set objRst = ExecuteSQL(strSQL, strMsgtext)
' 判断该卡号是否存在
If objRst.EOF Then
MsgBox "该卡号未注册！", vbOKOnly, "警告"
txtkahao.Text = ""
txtkahao.SetFocus
Exit Sub
Else
' 判断该卡号是否已经退卡，若退卡不能上机
If Trim(objRst.Fields(10)) = "不使用" Then
MsgBox "该卡号已经退卡，不能上机！", vbOKOnly, "警告"
Exit Sub
Else
'从基本数据表中取出最少金额数据
strSQL2 = "select * from BasicData_Info "
Set objRst2 = ExecuteSQL(strSQL2, strMsgtext2)
objRst2.MoveLast
leastfee = Val(Trim(CStr(objRst2.Fields(5))))
objRst2.Close
If Val(Trim(objRst.Fields(7))) < leastfee Then
' Dim a As Single
' a = objRst2.Fields(5)
'判断余额是否充足
' If objRst.Fields(7) < objRst2.Fields(5) Then
MsgBox "余额只有" & Trim(objRst.Fields(7)) & "元,少于最少金额，请先充值!", vbOKOnly, "警告"
Exit Sub
Else
'判断该卡号是否正在上机
' Set objRst3 = New ADODB.Recordset
strSQL3 = "select * from Online_Info where cardno = '" & Trim(txtkahao.Text) & "'"
Set objRst3 = ExecuteSQL(strSQL3, strMsgtext3)
If Not (objRst3.BOF And objRst3.EOF) Then
MsgBox "该卡正在上机！上机信息已导出！", vbOKOnly, "警告
txtxuehao.Text = Trim(objRst3.Fields(2))
txtname.Text = Trim(objRst3.Fields(3))
txtxibie.Text = Trim(objRst3.Fields(4))
txtleixing.Text = Trim(objRst3.Fields(1))
txtsex.Text = Trim(objRst3.Fields(5))
txtsjdate.Text = Trim(objRst3.Fields(6))
txtsjtime.Text = Trim(objRst3.Fields(7))
txtyue.Text = Trim(objRst.Fields(7))
Exit Sub
Else
'显示信息
txtxuehao.Text = Trim(objRst.Fields(1))
txtname.Text = Trim(objRst.Fields(2))
txtxibie.Text = Trim(objRst.Fields(4))
txtleixing.Text = Trim(objRst.Fields(14))
txtsex.Text = Trim(objRst.Fields(3))
txtsjdate.Text = Date
txtsjtime.Text = Time
txtyue.Text = Trim(objRst.Fields(7))
objRst3.AddNew’更新Online_Info
objRst3.Fields(0) = Trim(txtkahao.Text)
objRst3.Fields(2) = Trim(txtxuehao.Text)
objRst3.Fields(3) = Trim(txtname.Text)
objRst3.Fields(4) = Trim(txtxibie.Text)
objRst3.Fields(1) = Trim(txtleixing.Text)
objRst3.Fields(5) = Trim(txtsex.Text)
objRst3.Fields(6) = Trim(txtsjdate.Text)
objRst3.Fields(7) = Trim(txtsjtime.Text)
objRst3.Fields(8) = Trim(Winsock1.LocalHostName)
objRst3.Fields(9) = GetSqlTime
objRst3.Update
'显示此时正在上机的人数
strsql4 = "select * from Online_Info"
Set objrst4 = ExecuteSQL(strsql4, strMsgtext4)
objrst4.Update
lblsjrenshumu.Caption = objrst4.RecordCount
End If
End If
End If
End If
End If
End Sub
</span>
由于上下机的窗体一显示出来，就应该在左下角显示正在上机人数，所以应该在form_Load()中添加：
<span style="font-size:24px;">'从OnLine表里读取数据 strSQL = "select * from Online_Info" Set mrcc = ExecuteSQL(strSQL, strText) '显示上机人数 lblsjrenshumu.Caption = mrcc.RecordCount </span>
下机：
首先是各种判断：
<span style="font-size:24px;">'判断卡号框是否为空
If txtkahao.Text = "" Then
MsgBox "请输入卡号！", vbOKOnly, "警告"
txtkahao.SetFocus
Exit Sub
Else
'判断卡号输入的是否是数字
If Not IsNumeric(txtkahao.Text) Then
MsgBox "卡号请输入数字！", vbOKOnly, "警告"
txtkahao.Text = ""
txtkahao.SetFocus
Exit Sub
Else
'判断此卡号是否存在
studentSQL = "select * from student_Info where cardno = '" & Trim(txtkahao.Text) & "'"
Set rstStudent = ExecuteSQL(studentSQL, smsgtext)
If rstStudent.EOF Then
MsgBox "该卡号尚未注册！请重新输入！", vbOKOnly, "警告"
txtkahao.SetFocus
Exit Sub
Else
'判断该卡号是否可以使用（是否已被退卡）
If rstStudent.Fields(10) = "不使用" Then
MsgBox "该卡号已经退卡，不能下机！", vbOKOnly, "警告"
txtkahao.SetFocus
Exit Sub
Else
'判断该卡号是否正在上机
OnlineSQL = "select * from Online_Info where cardno = '" & Trim(txtkahao.Text) & "'"
Set rstOnline = ExecuteSQL(OnlineSQL, OMsgtext)
' If Not (rstOnline.Fields(0) = Trim(txtkahao.Text)) Then
If rstOnline.EOF Then
MsgBox "该卡号没有上机！", vbOKOnly, "警告"
Exit Sub
txtkahao.SetFocus
End If
End If
End If
End If
End If
</span>
之后计算上机时间，根据不同用户，计算上机消费：
获取基本数据：
<span style="font-size:24px;">'查询基本数据表，获得设定的基本数据
BasicDataSQL = "select * from BasicData_Info "
Set rstBasicData = ExecuteSQL(BasicDataSQL, BMsgtext)
</span>
计算消费时间，并根据消费时间和用户不同计算消费金额：
<span style="font-size:24px;">'计算消费时间（实际在线时间=下机时间-上机时间，，消费时间=取整(实际在线时间-准备时间)/递增单位时间）*递增单位时间
'在此的时间单位均为分钟，取整必须用round函数四舍五入，不可用int或fix函数
'实际在线时间
intLineTime = (Date - DateValue(rstOnline!ondate)) * 1440 + (Hour(Time) - _
Hour(TimeValue(rstOnline!OnTime))) * 60 + (Minute(Time) - _
Minute(TimeValue(rstOnline!OnTime)))
'把固定用户、临时用户30分钟的费用分别赋给费用
fixedRate = Val(rstBasicData.Fields(0)) '把固定用户的金额赋给变量
fixedRate1 = Val(rstBasicData.Fields(1)) '把临时用户的金额赋给变量
'判断实际在线时间是否小于准备时间,若小于则消费时间为0
If intLineTime <= Val(Trim(rstBasicData.Fields(4))) Then
txtcostmoney.Text = 0
Else
'判断实际在线时间是否小于最低消费时间，若小于消费为0
If intLineTime <= Val(Trim(rstBasicData.Fields(3))) Then
txtcostmoney.Text = 0
Else
'实际在线时间大于最低消费时间则按单位时间算，分固定用户和临时用户
If intLineTime >= Val(Trim(rstBasicData!leastTime)) And intLineTime < Val(Trim(rstBasicData!unitTime)) And Trim(rstStudent.Fields(14)) = "固定用户" Then
txtcostmoney.Text = fixedRate
Else
If intLineTime >= Val(Trim(rstBasicData!leastTime)) And intLineTime < Val(Trim(rstBasicData!unitTime)) And Trim(rstStudent.Fields(14)) = "临时用户" Then
txtcostmoney.Text = fixedRate1
Else '当实际在线时间大于单位时间，就按有几个单位时间算，分固定用户和临时用户
If intLineTime > Val(Trim(rstBasicData!leastTime)) And Trim(rstStudent.Fields(14)) = "固定用户" Then
curConsume = intLineTime / Val(Trim(rstBasicData!unitTime))
txtcostmoney.Text = Val(curConsume) * Val(fixedRate)
Else
If intLineTime > Val(Trim(rstBasicData!leastTime)) And Trim(rstStudent.Fields(14)) = "临时用户" Then
curConsume = intLineTime / Val(Trim(rstBasicData!unitTime))
txtcostmoney.Text = Val(curConsume) * Val(fixedRate1)
End If
End If
End If
End If
End If
End If
'计算余额（账户余额=原账户余额-消费金额）
curBalance = rstStudent!cash - Val(txtcostmoney.Text)
下机信息显示：
'下机信息显示
txtxjdate.Text = Date
txtxjtime.Text = Time
txtxuehao.Text = Trim(rstOnline.Fields(2))
txtname.Text = Trim(rstOnline.Fields(3))
txtxibie.Text = Trim(rstOnline.Fields(4))
txtleixing.Text = Trim(rstOnline.Fields(1))
txtsex.Text = Trim(rstOnline.Fields(5))
txtsjdate.Text = Trim(rstOnline.Fields(6))
txtsjtime.Text = Trim(rstOnline.Fields(7))
txtcosttime.Text = intLineTime
txtyue.Text = curBalance
MsgBox "下机成功！欢迎下次再来！", vbOKOnly, "提示"
更新学生表：
rstStudent.Fields(7) = curBalance
rstStudent.Update
rstStudent.Close
更新上机记录表：
LineSQL = "select * from Line_Info"
Set rstLine = ExecuteSQL(LineSQL, LMsgtext)
rstLine.AddNew
rstLine.Fields(1) = Trim(txtkahao.Text)
rstLine.Fields(2) = Trim(txtxuehao.Text)
rstLine.Fields(3) = Trim(txtname.Text)
rstLine.Fields(4) = Trim(txtxibie.Text)
rstLine.Fields(5) = Trim(txtsex.Text)
rstLine.Fields(6) = Trim(txtsjdate.Text)
rstLine.Fields(7) = Trim(txtsjtime.Text)
rstLine.Fields(8) = Trim(txtxjdate.Text)
rstLine.Fields(9) = Trim(txtxjtime.Text)
rstLine.Fields(10) = Trim(Val(txtcosttime.Text))
rstLine.Fields(11) = Trim(Val(txtcostmoney.Text))
rstLine.Fields(12) = Trim(Val(txtyue.Text))
rstLine.Fields(13) = "正常下机"
rstLine.Fields(14) = Trim(Winsock1.LocalHostName)
rstLine.Update
删除在线表中的信息：
OnlineSQL = "select * from online_Info where cardno = '" & Trim(txtkahao.Text) & "'"
Set rstOnline = ExecuteSQL(OnlineSQL, OMsgtext)
rstOnline.Delete
rstOnline.Update
lblsjrenshumu.Caption = Str(lblsjrenshumu.Caption - 1)
</span>
上下机这个伟大的工程完成了，但是我还是不能松懈呀！我们应该从各个方面培养我们的全局观，站在巨人的肩膀上，提炼自己需要的精华……等待我的还有更多的挑战，让我越挫越勇吧！！