机房收费系统之实时收费动态下机

　　为了避免上机的过程中断电等情况，给机房造成损失，所以，我们就需要进行实时收费还用动态下机，首先设置Timer的interval属性，然后就是编写代码：

<span style="font-size:18px;">Private Sub Timer2_Timer()
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrcS As ADODB.Recordset   'student表
    Dim mrcL As ADODB.Recordset  'line表
    Dim mrcO As ADODB.Recordset  'online表
    Dim mrcB As ADODB.Recordset   'basicdata表
    Dim PastCash As Single             '原余额
    Dim ThroughTime As Integer          '经历的上机时间
    Dim CMoney As Integer     '消费金额
    Dim Newcash As Single    '新余额
    Dim FixUserCharge As Integer   '固定用户的单位费用
    Dim TemUserCharge As Integer   '临时用户的单位费用
    
    txtSQL = "select * from OnLine_Info "
    Set mrcO = ExecuteSQL(txtSQL, MsgText)
        If mrcO.EOF Then
            Exit Sub
        Else
            txtSQL = "select * from BasicData_Info "
            Set mrcB = ExecuteSQL(txtSQL, MsgText)
            '固定用户的单位费用
            FixUserCharge = mrcB.Fields(0)
            '临时用户的单位费用
            TemUserCharge = mrcB.Fields(1)
                
             '遍历上机的学生
            Do While Not mrcO.EOF
                
                txtSQL = "select * from student_Info where cardno='" & Trim(mrcO.Fields(0)) & "'and status='使用'"
                 Set mrcS = ExecuteSQL(txtSQL, MsgText)
                     '原余额
                    PastCash = mrcS.Fields(7)
                
                txtSQL = "select * from OnLine_Info "
                Set mrcO = ExecuteSQL(txtSQL, MsgText)

                '计算经历的上机时间
                ThroughTime = DateDiff("n", mrcO.Fields(10), Now)
                '若是经历的上机时间小于最低消费时间，不需要考虑用户类型
                If ThroughTime < mrcB!leasttime Then
                    CMoney = 0
                Else
                    If mrcO!cardtype = "固定用户" Then
                        CMoney = Int(ThroughTime / 60 + 1) * FixUserCharge
                        Newcash = PastCash - CMoney
                        mrcS!cash = Newcash
                        mrcS.Update
                    Else
                        CMoney = Int(ThroughTime / 60 + 1) * TemUserCharge
                        Newcash = PastCash - CMoney
                        mrcS!cash = Newcash
                        mrcS.Update
                    End If
                End If
                    txtSQL = "select * from Line_Info where cardno='" & mrcO.Fields(0) & "'"
                    Set mrcL = ExecuteSQL(txtSQL, MsgText)
                    If mrcL.EOF Then     '如果Line表中不存在上机表中的卡号，就添加
                        mrcL.AddNew
                        mrcL.Fields(1) = Trim(mrcO.Fields(0))
                        mrcL.Fields(2) = Trim(mrcO.Fields(2))
                        mrcL.Fields(3) = Trim(mrcO.Fields(3))
                        mrcL.Fields(4) = Trim(mrcO.Fields(4))
                        mrcL.Fields(5) = Trim(mrcO.Fields(5))
                        mrcL.Fields(6) = Trim(mrcO.Fields(6))
                        mrcL.Fields(7) = Trim(mrcO.Fields(7))
                         '向line表中存入当前日期和时间
                        mrcL.Fields(8) = Date
                        mrcL.Fields(9) = Time
                        mrcL.Fields(10) = ThroughTime  '即Line表中的消费时间Consume tine，以分钟为单位
                        mrcL.Fields(11) = CMoney
                        mrcL.Fields(12) = Newcash
                        '以下内容固定
                        mrcL.Fields(13) = "正常上机"
                        mrcL.Fields(14) = VBA.Environ("ComputerName")
                        mrcL.Fields(15) = Now    '添加的字段，用来记录下机时间
                        mrcL.Update
                    Else            '如果Line表中存在上机表中的卡号，就更新
                        mrcL.Fields(8) = Date
                        mrcL.Fields(9) = Time
                        mrcL.Fields(10) = ThroughTime  '即Line表中的消费时间Consume time，以分钟为单位
                        mrcL.Fields(11) = CMoney
                        mrcL.Fields(12) = Newcash
                        mrcL.Fields(15) = Now    '添加的字段offnow，用来记录下机时间
                        mrcL.Update
                    End If

                '余额不足强制下机
                If (Newcash > 0) And (Newcash <= Val(mrcB!LimitCash)) Or (Newcash < 0) Then
                    mrcL.Fields(13) = "强制下机"
                    mrcL.Update
                    mrcL.Close
                    '显示下机信息
                    txtCardNo.Text = mrcO!cardno
                    lblType.Caption = mrcO!cardtype
                    lblSID.Caption = mrcO!studentno
                    lblName.Caption = mrcO!studentName
                    lblDept.Caption = mrcO!department
                    lblSex.Caption = mrcO!sex
                    lblOnDate.Caption = mrcO!ondate
                    lblOnTime.Caption = mrcO!OnTime
                    lblOffDate.Caption = Format(Date, "yyyy-mm-dd")
                    lblOffTime.Caption = Time
                    lblCTime.Caption = ThroughTime
                    lblBalance.Caption = Newcash
                    lblCMoney.Caption = Format(CMoney, "0.00")
                    
                    MsgBox "用户" & Trim(mrcO!cardno) & "余额不足，已强制下机", vbOKOnly + vbExclamation, "提示"
                    
                    
                    '将显示的内容清空
                     txtCardNo.Text = ""
                     lblType.Caption = ""
                     lblSID.Caption = ""
                     lblName.Caption = ""
                     lblDept.Caption = ""
                     lblSex.Caption = ""
                     lblOnDate.Caption = ""
                     lblOnTime.Caption = ""
                     lblBalance.Caption = ""
                     lblOffDate.Caption = ""
                     lblOffTime.Caption = ""
                     lblCMoney.Caption = ""
                     lblCTime.Caption = ""
                     lblBalance.Caption = ""
                    '删除Online表中的上机数据
                     mrcO.Delete
                     mrcO.Update
                     mrcO.MoveNext
                Else '余额还足以上机，不执行强制下机
                    Exit Sub
                End If               
            Loop
        End If
         mrcO.Close
         mrcS.Close
'         mrcL.Close       '对象关闭时，不允许操作
         mrcB.Close
End Sub</span>

　　以上代码虽然能实现想要的功能，但是疏漏之处还是有的：比如从基本数据表中读取数据，是先读还是动态读，很显然，我用的是先读数据，然后赋给中间变量，进行全局运算，但是这样做的弊端就在于如果上机的过程中改变了收费策略，如何计费？

　　运行的时候发现，我想实现的是进行所以上机学生的监督，但是运行中发现，只有钱数少的学生强制下机后，才开始队后一个学生进行监督，并存储相应的数据～

　　动态下机是我最后进行的优化，在运行的过程中，才意识到可以通过Timer事件来实时统计当前上机人数：

<span style="font-size:18px;">Private Sub Timer3_Timer()
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrcO As ADODB.Recordset
         
    txtSQL = "select * from Online_Info "
    Set mrcO = ExecuteSQL(txtSQL, MsgText)
    lblPeople.Caption = mrcO.RecordCount
    mrcO.Close     '不关闭会占内存
End Sub
</span>

　　期初统计当前上机人数的时候，虽然并没有费多大力气，但是总是涉及到代码书写顺序导致的上机人数无变化或是“ 对象关闭时，不允许操作”的问题，只好重新将上机表打开计数：

<span style="font-size:18px;">'重新打开上机表，更新一下，重新计算当前上机人数，否则保留的是原来取得的旧记录
     txtSQL = "select * from Online_Info "
     Set mrcO = ExecuteSQL(txtSQL, MsgText)

     lblPeople.Caption = mrcO.RecordCount
    
</span>

　　关于动态下机还有动态计数，让我体会最深的一点就是：我们总是习惯于忽略最简单和基础的东西，用眼下的掌握得并不是很好的方法去达成某些目的，整的自己焦头烂额，频繁出错，实际上，应该用最简单有效的方式去实现需求的功能，比如——Timer的使用……