机房收费中很重要的一部分，就是钱一定要算好，上下机就是其中的一部分，当时做上下机之前就听说上下机挺不好做的，当真正做到这的时候一会就把上机敲完了，因为想的比较清楚。在上机之前需要做好以下工作，也就相当于判定条件
（1）在上机之前先判断有没有输入卡号
（2）判断该卡号是否注册，从student表中选择。
（3）判断该卡号金额是否充足，如果资金不足，提示充值后再上机
（4）判断该卡号是否已上机，从online表中判断
（5）上机成功后，把所有的上机信息更新到online表中，显示上机人数。
流程图：
上机的代码
Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
Dim mrcc As ADODB.Recordset
If Text1.Text = "" Then
MsgBox "请输入卡号！", vbOKOnly, "提示"
Text1.SetFocus
Exit Sub
Else
If Len(Text1.Text) > 10 Then
'判断输入卡号是否超过设定的长度，防止出错
MsgBox "卡号过长，请输入长度<10的卡号", vbOKOnly, "警告!"
Text1.SetFocus
Exit Sub
End If
txtSQL = "select *from student_info where cardno='" & Trim(Text1.Text) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF Then
MsgBox "该卡号没有注册！", vbOKOnly, "提示"
Exit Sub
Else
txtSQL = "select*from basicdata_info "
Set mrcc = ExecuteSQL(txtSQL, MsgText)
'上机前检查金额是否够上一个小时，如果不够，进行提示
If mrc.Fields(14) = "固定用户" Then
If Val(Trim(mrc.Fields(7))) < Val(Trim(mrcc.Fields(0))) Then
MsgBox "该固定用户所剩金额不足以上一小时，请充值后在上机", 48, "提示"
Exit Sub
End If
Else
If Val(Trim(mrc.Fields(7))) < Val(Trim(mrcc.Fields(1))) Then
MsgBox "该临时用户所剩金额不足以上一小时，请充值后在上机", 48, "提示"
Exit Sub
End If
End If
<span style="white-space:pre"> </span>
'从online表中选择卡号上机
txtSQL = "select*from online_info where cardno='" & Text1.Text & "' "
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then '如果有证明正在上机，进行提示
MsgBox "此卡正在上机", vbOKOnly, "提示"
Text1.SetFocus
Text1.Text = Trim(mrc.Fields(0))
Text2.Text = Trim(mrc.Fields(1))
Text3.Text = Trim(mrc.Fields(2))
Text4.Text = Trim(mrc.Fields(3))
Text5.Text = Trim(mrc.Fields(4))
Text6.Text = Trim(mrc.Fields(5))
Text7.Text = Trim(mrc.Fields(6))
Text8.Text = Trim(mrc.Fields(7))
mrc.Close
Exit Sub
Else
txtSQL = "select*from online_info "
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.AddNew '向表中添加数据
Label23.Caption = Label23.Caption + 1 '上机人数随时变动
mrc.Fields(0) = Trim(Text1.Text)
mrc.Fields(1) = Trim(Text2.Text)
mrc.Fields(2) = Trim(Text3.Text)
mrc.Fields(3) = Trim(Text4.Text)
mrc.Fields(4) = Trim(Text5.Text)
mrc.Fields(5) = Trim(Text6.Text)
mrc.Fields(6) = Trim(Text7.Text)
mrc.Fields(7) = Trim(Text8.Text)
mrc.Fields(9) = Date
mrc.Fields(8) = Environ("computername")
mrc.Update
MsgBox "上机成功，欢迎使用!", vbOKOnly, "提示"
mrc.Close
End If
End If
End If
End Sub
但是做到下机的时候花费了好长时间，真正做的时候才发现没有想的那么简单，主要的困惑点是消费时间跟消费金额算的不对，它是第一次下机的时候金额是0，之后的就正常了，但是再看看自己的代码发现没什么问题啊，自己改了好长时间还是这个问题，加上一些同学的调试才知道是选择固定用户跟临时用户的消费费率那块出问题了。选择的时候没有选好，导致显示是0.（这个是细节性的问题，只要大方向没问题，这些都不是事），先来看看我的思路吧。
（1）首先，你需要判断一下是否输入了卡号
（2）其次，判断卡号是否注册
（3）从online表中判断卡号是否上机，
（4）从line表中判断此卡是否已下机
（5）从基本信息表中选择费率，分为固定用户的和临时用户的，计算金额
（6）将下机的信息更新到line表中，同时删除online中的信息
（7）提示下机成功，更新上机人数。
流程图：
代码：
<pre name="code" class="plain"> Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
Dim mrcc As ADODB.Recordset
Dim mrccc As ADODB.Recordset
Dim outtime As String '下机时间
Dim ontime As String '上机时间
Dim consumetime As String '消费时间
Dim precash As Currency '上机之前的金额
Dim Consumecash As Currency '消费金额
Dim cash As Currency '剩余金额
Dim rate As Single '固定用户的费率
Dim tmprate As Single '临时用户的费率
If Text1.Text = "" Then
MsgBox "请输入卡号", vbOKOnly, "提示"
Text1.SetFocus
Exit Sub
Else
If Len(Text1.Text) > 11 Then
MsgBox "卡号请输入少于11位的数字", vbOKOnly, "提示"
Text1.SetFocus
Exit Sub
Else
txtSQL = "select * from student_info where cardno='" & Text1.Text & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF Then
MsgBox "卡号未注册，请重新输入", vbOKOnly, "提示"
Text1.SetFocus
Exit Sub
mrc.Close
Else
If mrc.Fields(11) = "不使用" Then
MsgBox "此卡号已退卡，请重新注册", vbOKOnly, "提示"
Text1.SetFocus
Exit Sub
End If
precash = mrc.Fields(7)
txtSQL = "select * from online_info where cardno='" & Text1.Text & "'"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If mrcc.EOF And mrcc.BOF Then
MsgBox "此卡没有上机！", vbOKOnly, "提示"
Text1.SetFocus
Exit Sub
Else
ontime = mrcc.Fields(7)
outtime = Time
' Text10.Text = outtime
consumetime = Int(DateDiff("h", ontime, Time)) + 1
txtSQL = "select * from basicdata_info "
Set mrc = ExecuteSQL(txtSQL, MsgText)
rate = Trim(mrc.Fields(0)) '固定用户的计费标准
tmprate = Trim(mrc.Fields(1)) '临时用户的计费标准
Select Case Trim(mrcc.Fields(1))
Case "固定用户" '固定用户的费用
Consumecash = Val((consumetime)) * rate
Case "临时用户" '临时用户的费用
Consumecash = Val((consumetime)) * tmprate
End Select
Text7.Text = mrcc.Fields(6)
Text8.Text = mrcc.Fields(7)
Text9.Text = Date
Text10.Text = outtime
Text12.Text = consumetime
Text14.Text = Val(Consumecash)
Text11.Text = precash - Val(Consumecash)
Text1.Text = Trim(mrcc.Fields("cardNo"))
Text4.Text = Trim(mrcc.Fields("studentName"))
Text3.Text = mrcc.Fields("studentNo")
Text5.Text = mrcc.Fields("department")
Text6.Text = mrcc.Fields("sex")
Text2.Text = Trim(mrcc.Fields(1))
txtSQL = "delete from online_info where cardno='" & Text1.Text & "'" '删除数据库中的数据
Set mrc = ExecuteSQL(txtSQL, MsgText)
Label23.Caption = Label23.Caption - 1 '上机人数随时变动
txtSQL = "select*from line_info where cardno='" & Text1.Text & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.AddNew
mrc.Fields(1) = Text1.Text
mrc.Fields(2) = Text3.Text
mrc.Fields(3) = Text4.Text
mrc.Fields(4) = Text5.Text
mrc.Fields(5) = Text6.Text
mrc.Fields(6) = Text7.Text
mrc.Fields(7) = Text8.Text
mrc.Fields(8) = Text9.Text
mrc.Fields(9) = Text10.Text
mrc.Fields(10) = Text12.Text
mrc.Fields(11) = Text14.Text
mrc.Fields(12) = Text11.Text
mrc.Fields(13) = "正常下机"
mrc.Fields(14) = Environ("computername")
mrc.Update
txtSQL = "select*from student_info where cardno='" & Text1.Text & "' "
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.Fields(7) = Text11.Text
mrc.Update
txtSQL = "select*from online_info where cardno='" & Text1.Text & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF Then
MsgBox "此卡已下机", vbOKOnly, "提示"
Text1.SetFocus
Exit Sub
End If
Text12.Text = ""
Text14.Text = ""
MsgBox "下机成功，欢迎下次再来", vbOKOnly, "提示"
mrcc.Close
mrc.Close
End If
End If
End If
End If
下机后的界面：
扫一扫
2277
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
