机房收费系统之上下机

        机房收费中很重要的一部分，就是钱一定要算好，上下机就是其中的一部分，当时做上下机之前就听说上下机挺不好做的，当真正做到这的时候一会就把上机敲完了，因为想的比较清楚。在上机之前需要做好以下工作，也就相当于判定条件

（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 IfEnd 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                     

     下机后的界面：