【机房收费系统】机房收费系统之动态下机功能

【背景】：一个完整的机房收费系统必将涉及到金额不能为负现象。所以考虑到这里就需要我们实现动态下机功能，动态计算卡内余额，确保卡内余额为正。当卡内余额为0时，系统会将您的卡自动下机。这样就会避免了机房亏损现象。下面是代码展示：

'-----------------------------------------------------
'作者：周家林
'功能：动态实现下机，当余额为零时，电脑实现自动下机功能。
'临时用户自动下机，就等于退卡。student_Info表中相应的数据就自动删除，Online_Info表中相对的记录也会清除，但Line_info表中会相应产生一条记录。
'固定用户自动下机和正长下机一样。student_Info表中保留原卡信息及最新数据，Online_Info表中相对的记录也会清除，但Line_info表中会相应产生一条上机记录。
'-------------------------------------------------------
Private Sub Timer2_Timer()
    Dim mrc As ADODB.Recordset
    Dim mrc1 As ADODB.Recordset
    Dim mrc2 As ADODB.Recordset
    Dim mrcc As ADODB.Recordset
    Dim mrccc As ADODB.Recordset
    Dim txtSQL As String
    Dim txtSQL1 As String
    Dim txtSQL2 As String
    Dim txtSQLL As String
    Dim txtSQLLL As String
    Dim MsgText As String
    Dim MsgText1 As String
    Static ConsumeCash As Single
    Dim Count As Integer
    Dim rate As String
    Dim strTime As String
    Dim strLimitCash As String
    Dim sBuffer As String
    Dim lSize As Long
     
     '通过对数据库中Basicdata（基础数据）表，查询出学生上机花费的比率和最小金额
    txtSQL = "select Rate,tmpRate from BasicData_Info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    rate = Trim$(mrc.Fields(0))
    strLimitCash = Trim$(mrc.Fields(1))
    mrc.Close
  
    '查询数据库中Online（正在上机人员）表
    txtSQL = "select * from OnLine_Info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
  
    If Not mrc.EOF Then
        Do While mrc.EOF = False            '循环正在上机人员表中的每一条记录
  
            txtSQLL = "select cash from student_Info where cardno='" & _
                      Trim$(mrc.Fields(0)) & "' and status='使用'"         '从Student（学生信息）表中查询学生的余额
            Set mrcc = ExecuteSQL(txtSQLL, MsgText)
            txtSQL1 = "select * from OnLine_Info where cardno='" & _
                      Trim$(mrc.Fields(0))
            Set mrc1 = ExecuteSQL(txtSQL, MsgText)
         If Trim$(mrc1.Fields(1)) = "固定用户" Then  '判断用户类型
            mrc1.Close
            strTime = DateDiff("s", mrc.Fields(7), CStr(Format$(Now, "hh:mm")))      '计算学生从开始上机到现在的时间差
            strTime = Format$(strTime / 3600, "0.00")
  
            If CSng(mrcc.Fields(0)) - CSng(CSng(rate) * CSng(strTime)) <= 0 Then  'CSng(strLimitCash) Then  如果余额不足，则强制下机
  
                '往Line（上机记录）表中添加新的下机信息，并强制该学生下机
                txtSQLLL = "select * from Line_Info"
                Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
  
                mrccc.AddNew
                mrccc.Fields(1) = Trim$(mrc.Fields(0))
                mrccc.Fields(2) = Trim$(mrc.Fields(2))
                mrccc.Fields(3) = Trim$(mrc.Fields(3))
                mrccc.Fields(4) = Trim$(mrc.Fields(4))
                mrccc.Fields(5) = Trim$(mrc.Fields(5))
                mrccc.Fields(6) = Trim$(mrc.Fields(6))
                mrccc.Fields(7) = Trim$(mrc.Fields(7))
                mrccc.Fields(8) = CStr(Format$(Now, "yyyy-mm-dd"))
                mrccc.Fields(9) = CStr(Format$(Now, "hh:mm"))
                mrccc.Fields(10) = Trim$(strTime)
                mrccc.Fields(11) = CStr(CSng(rate) * CSng(strTime))
                mrccc.Fields(12) = CStr(CSng(mrcc.Fields(0)) - CSng(CSng(rate) * CSng(strTime)))
                mrccc.Fields(13) = "强制下机"
                mrccc.Fields(14) = Trim(Winsock1.LocalHostName)    '获取电脑名
                mrccc.Fields(15) = "未结账"
                mrccc.Fields(16) = ad
                mrccc.Update
                mrccc.Close
  
                '修改Student（学生信息）表中的余额
                txtSQLLL = "select cash from student_Info where cardno='" & _
                           Trim$(mrc.Fields(0)) & "' and status='使用'"
                Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
  
                mrccc.Fields(0) = CStr(CSng(mrcc.Fields(0)) - CSng(CSng(rate) * CSng(strTime)))
                mrccc.Update
                mrccc.Close
                  
                '删除Online（正在上机人员）表中该学生的信息
                txtSQLLL = "select * from OnLine_Info where cardno='" & _
                           Trim$(mrc.Fields(0)) & "'"
                Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
  
                If Not mrccc.EOF Then
                    mrccc.Delete
                Else
                    mrccc.Close
                End If
                  
                '弹出对话框“余额不足，已强制下机！”
                MsgBox "卡号" & mrc.Fields(0) & "余额不足，已强制下机！", vbOKOnly + vbExclamation, "警告"
  
            End If
            mrc.MoveNext
        Else                                           '临时用户的情况
            strTime = DateDiff("s", mrc.Fields(7), CStr(Format$(Now, "hh:mm")))      '计算学生从开始上机到现在的时间差
            strTime = Format$(strTime / 3600, "0.00")
  
            If CSng(mrcc.Fields(0)) - CSng(CSng(strLimitCash) * CSng(strTime)) <= 0 Then  如果余额不足，则强制下机
  
                '往Line（上机记录）表中添加新的下机信息，并强制该学生下机
                txtSQLLL = "select * from Line_Info"
                Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
  
                mrccc.AddNew
                mrccc.Fields(1) = Trim$(mrc.Fields(0))
                mrccc.Fields(2) = Trim$(mrc.Fields(2))
                mrccc.Fields(3) = Trim$(mrc.Fields(3))
                mrccc.Fields(4) = Trim$(mrc.Fields(4))
                mrccc.Fields(5) = Trim$(mrc.Fields(5))
                mrccc.Fields(6) = Trim$(mrc.Fields(6))
                mrccc.Fields(7) = Trim$(mrc.Fields(7))
                mrccc.Fields(8) = CStr(Format$(Now, "yyyy-mm-dd"))
                mrccc.Fields(9) = CStr(Format$(Now, "hh:mm"))
                mrccc.Fields(10) = Trim$(strTime)
                mrccc.Fields(11) = CStr(CSng(rate) * CSng(strTime))
                mrccc.Fields(12) = CStr(CSng(mrcc.Fields(0)) - CSng(CSng(rate) * CSng(strTime)))
                mrccc.Fields(13) = "强制下机"
                mrccc.Fields(14) = Trim(Winsock1.LocalHostName)
                mrccc.Fields(15) = "未结账"
                mrccc.Fields(16) = ad
                mrccc.Update
                mrccc.Close
  
                '修改Student（学生信息）表中的余额
                txtSQLLL = "select cash from student_Info where cardno='" & _
                           Trim$(mrc.Fields(0)) & "' and status='使用'"
                Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
  
                mrccc.Fields(0) = CStr(CSng(mrcc.Fields(0)) - CSng(CSng(strLimitCash) * CSng(strTime)))
                mrccc.Update
                mrccc.Close
                  
                '删除Online（正在上机人员）表中该学生的信息
                txtSQLLL = "select * from OnLine_Info where cardno='" & _
                           Trim$(mrc.Fields(0)) & "'"
                Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
  
                If Not mrccc.EOF Then
                    mrccc.Delete
                Else
                    mrccc.Close
                End If
                txtSQL2 = "select * from student_Info where cardno = '" & Trim$(mrc.Fields(0)) & "'"
                Set mrc2 = ExecuteSQL(txtSQL2, MsgText1)
                mrc2.Delete
                mrc2.Update
                mrc2.Close
                '弹出对话框“余额不足，已强制下机！”
                MsgBox "卡号" & mrc.Fields(0) & "余额不足，已强制下机！", vbOKOnly + vbExclamation, "警告"
'
            End If
            mrc.MoveNext
     End If
        Loop
    End If
End Sub