机房收费系统之纵观全局

　　验收项目的时候，师父们从四方面进行了审核：界面、功能、代码、业务。之后师父布置了三项任务：用自己的理解将一般用户、操作员还有管理员的主要职能搞清楚；将本系统的主要功能化成流程图；“谈钱不伤系统”，但是也要搞清算法～～～

　　我是这样理解机房收费系统的消费本质的：机房收费系统，名曰“收费”，实则“消费”，消费的并不是金钱，而是由金钱兑换的时间——上网时间。

　　首先说自己对一般用户、操作员还有管理员的认识：

 　　一般用户就相当于我们去图书馆进行新视野大学英语视听说自主学习，负责签到的那个老师，她相当于是连接我们与需要上机才能完成的学习任务的接口。机房收费系统给我的感觉就是：这个负责上机的一般用户坐在那里，看着机房里边的所有电脑，而需要消费上网的同学排队来这消费，报上自己的卡号，卡号存在且余额充足就“过关”了，随便找台电脑上机。在上机的过程中，如果某一个学生的余额不足，老师还需要根据提示将相应的学生“请出去”，所以，管理起来很费时，也很费力，期初我是这样理解的。师傅说，理解无对错，但是没有必要让老师一直坐在那里，完全可以装个监控，让来上机的同学们自己去输入，可是，如果学生胆子大，也许在下机的时候还会改一下本地时间也不一定，那样的话，机房亏大发了……

　　（PS：一般用户、操作员还有管理员各司其职，只有一般用户负责上下机，其余等级的用户登录的时候，无上机界面——验收项目的时候，师傅表明的一点）

　　再来说操作员，进行的是钱的操作：收＋退，以及学生信息的增删改查，好比图书馆那个负责充值的老师……

　　至于管理员，在我看来，就是一个会计，在这个系统中，他的权限最高，但是，他在结账后还需要将钱上交给更高一级，所以，周结账单就是他工作的凭证，同样，日结账单显示的结果是操作员工作的凭证。

　　综上所述：机房收费系统本身存在漏洞，需要我们立足现实情况去考虑，如今的理解无对错～～～

　　以下是主要功能块的思维导图：上机＋下机，结账部分请见：机房收费系统之结账

<span style="font-size:18px;"><span style="font-size:18px;">Private Sub cmdOnLine_Click()
    Dim mrc As ADODB.Recordset   'student_Info表
    Dim mrcO As ADODB.Recordset   'OnLine_Info表
    Dim mrcB As ADODB.Recordset   'BasicData_Info表
    Dim mrcU As ADODB.Recordset    'user_Info表
 
    Dim txtSQL As String
    Dim MsgText As String
    
    Dim A As Integer    '用做msgbox的返回值
    Dim Cancel As Integer
    
    txtSQL = "select * from Student_Info where cardno='" & Trim(txtCardNo.Text) & "'and status='" & Trim("不使用") & "'"
    Set mrcS = ExecuteSQL(txtSQL, MsgText)
        If mrcS.EOF = False Then
                A = MsgBox("此卡已注销，是否激活？", vbOKCancel + vbExclamation, "提示")            '如果已退卡，询问是否要激活
                If A = vbOK Then
                    mrcS.Fields(7) = 0
                    mrcS.Fields(10) = "使用"
                    mrcS.Fields(11) = "未结账"
                    mrcS.Update
                    mrcS.Close
                    
                    B = MsgBox("激活成功！是否立即充值？", vbOKCancel + vbExclamation, "提示")
                    If B = vbOK Then
                        txtCardNo.Text = ""                    '不清空的话会弹出暂时不需要弹出的信息
                        txtSQL = "select * from User_Info where UserID='" & UserName & "' and Level<>'" & "一般用户" & "'"
                        Set mrc = ExecuteSQL(txtSQL, MsgText)
                        If mrc.EOF = False Then
                            SetParent frmRecharge.hWnd, frmMain.hWnd
                        Else
                            MsgBox "一般用户无权注册，抱歉~", vbOKOnly + vbExclamation, "提示"
                            txtCardNo.SetFocus
                            txtCardNo = ""
                            Exit Sub
                        End If
                    Else
                        Cancel = True
                        Exit Sub
                    End If
                Else
                    Cancel = True
                    Exit Sub
                End If
         End If 
        
    If Trim(txtCardNo.Text = "") Then
        MsgBox "请输入卡号！"
        txtCardNo.SetFocus
    Else
        
    '通过卡号，显示其其它内容
        txtSQL = "select * from student_Info where cardno='" & txtCardNo.Text & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
    
        If mrc.EOF = True Then
            A = MsgBox("此卡尚未注册！是否立即注册？", vbOKCancel + vbExclamation, "提示")
                If A = vbOK Then
                    txtSQL = "select * from User_Info where UserID='" & UserName & "' and Level<>'" & "一般用户" & "'"
                    Set mrc = ExecuteSQL(txtSQL, MsgText)
                        If mrc.EOF = False Then
                            SetParent frmRegister.hWnd, frmMain.hWnd
                            txtCardNo.SetFocus
                            txtCardNo = ""
                        Else
                            MsgBox "一般用户无权注册，抱歉~", vbOKOnly + vbExclamation, "提示"
                            txtCardNo.SetFocus
                            txtCardNo = ""
                        End If
                Else
                    Cancel = True
                    txtCardNo.SetFocus
                    txtCardNo = ""
                End If                
           
        Else
            txtSQL = "select * from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'"
            Set mrcO = ExecuteSQL(txtSQL, MsgText)
            
            If Not (mrcO.BOF And mrcO.EOF) Then
                MsgBox "此卡号正在上机！"
                txtCardNo.SetFocus
                txtCardNo = ""
                Exit Sub
            Else
                txtSQL = "select * from BasicData_Info"
                Set mrcB = ExecuteSQL(txtSQL, MsgText)

                If mrc.Fields(7) <= mrcB.Fields(5) Then
                    A = MsgBox("余额小于最低标准" & mrcB.Fields(5) & "，是否充值？", vbOKCancel + vbExclamation, "提示")
                    If A = vbOK Then
                        txtSQL = "select * from User_Info where UserID='" & UserName & "' and Level<>'" & "一般用户" & "'"
                        Set mrc = ExecuteSQL(txtSQL, MsgText)
                        If mrc.EOF = False Then
                            SetParent frmRecharge.hWnd, frmMain.hWnd
                            txtCardNo.SetFocus
                            txtCardNo = ""
                        Else
                            MsgBox "一般用户无权充值，抱歉~", vbOKOnly + vbExclamation, "提示"
                            txtCardNo.SetFocus
                            txtCardNo = ""                        

                        End If
                    Else
                        Cancel = True
                    End If
                
                 Else
                    '显示与上机卡号相关的信息
                    txtSQL = "select * from student_Info where cardno='" & txtCardNo.Text & "'"
                    Set mrc = ExecuteSQL(txtSQL, MsgText)
                    
                    lblType.Caption = mrc!Type
                    lblSID.Caption = mrc!studentno
                    lblName.Caption = mrc!studentName
                    lblDept.Caption = mrc!department
                    lblSex.Caption = mrc!sex
                    lblOnDate.Caption = Date
                    lblOnTime.Caption = Time
                    lblBalance.Caption = mrc!cash  '显示余额
    
                    '将上机记录保留到OnLine表中，便于显示当前上机人数
                    txtSQL = "select * from OnLine_Info"
                    Set mrcO = ExecuteSQL(txtSQL, MsgText)
                    mrcO.AddNew
                    mrcO.Fields(0) = Trim(txtCardNo.Text)
                    mrcO.Fields(1) = mrc!Type
                    mrcO.Fields(2) = mrc!studentno
                    mrcO.Fields(3) = mrc!studentName
                    mrcO.Fields(4) = mrc!department
                    mrcO.Fields(5) = mrc!sex
                    mrcO.Fields(6) = Date
                    mrcO.Fields(7) = Time
                    mrcO.Fields(8) = VBA.Environ("computerName")
                    mrcO.Fields(9) = Date  '不知表中给出的date和上边出现的date是否一样
                    mrcO.Fields(10) = Now
                    mrcO.Update
                    '查询此时正在上机的人数（PS：可以用Timer事件，实时更新当前上机人数）
                    lblPeople.Caption = mrcO.RecordCount
                    mrcO.Close
                    MsgBox "上机成功！"
                    
                 '清空窗体内所有显示框
                    txtCardNo.SetFocus
                    txtCardNo.Text = ""
                    lblType.Caption = ""
                    lblSID.Caption = ""
                    lblName.Caption = ""
                    lblDept.Caption = ""
                    lblSex.Caption = ""
                    lblOnDate.Caption = ""
                    lblOnTime.Caption = ""
                    lblBalance.Caption = ""
                   
                End If
            End If
        End If
    End If
End Sub
</span></span>

　　我的下机过程写得有点乱，主要提体现在有些数据没必要赋给中间变量；还有一点就是计费方式不合理，应该采取分段计费方式，不然会导致用户不满意。但是整理逻辑还是清楚的，体现在上边的导图中，代码仅供参考：

<span style="font-size:18px;">Private Sub cmdOffLine_Click()
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset    'student_Info表，将计算后的最新余额存入
    Dim mrcO As ADODB.Recordset   'OnLine_Info表  取出上机记录，存入Line_Info表，然后删除
    Dim mrcB As ADODB.Recordset    'BasicData_Info表，用来算余额和消费时间
    Dim mrcL As ADODB.Recordset    'Line_Info表，将上下机记录存入
    Dim PastCash As Integer  '原余额
    Dim Newcash As Integer   '新余额
    Dim Timefact As Long '实际上机时间,定义为long便于有利于提高效率
    Dim FreeTime As Long  '上机前的准备时间，相当于白送的时间
    Dim FixUserCharge As Integer   '固定用户的单位费用
    Dim TemUserCharge As Integer   '临时用户的单位费用
    Dim OnTime As Date
    Dim offTime As Date
    
    '判断部分
    If Trim(txtCardNo.Text = "") Then
        MsgBox "请输入卡号!", vbOKOnly + vbExclamation, "警告"
        txtCardNo.SetFocus
        Exit Sub
    End If
    '判断卡号是否注册
    txtSQL = "select * from student_Info where cardno='" & txtCardNo.Text & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF Then
        MsgBox "该卡号未注册，请重新输入!", vbOKOnly + vbExclamation, "警告"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
    Else
        '判断该卡号是否上机
        txtSQL = "select * from Online_Info where cardno='" & txtCardNo.Text & "'"
        Set mrcO = ExecuteSQL(txtSQL, MsgText)
        If mrcO.EOF Then
            MsgBox "该卡没有上机！"
            txtCardNo.SetFocus
            txtCardNo.Text = ""
            Exit Sub
           
        End If
    End If
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
        
    '计算部分（前期准备）
    
    '后发现如果只是用time算时间的话，那么还需要用Date算出相差的天数换成分钟与time算出的数相加，所以，直接用Now
    '在Online表中添加了onnow字段,在Line表中添加了offnow字段
    OnTime = Trim(mrcO!onnow)
    '将下机时间等信息赋给中间变量
    offTime = Time
    '将原余额提出来用于计算下机后的余额
    txtSQL = "select * from student_Info where cardno='" & txtCardNo.Text & " '"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    PastCash = Val(Trim(mrc!cash))
    '从基本数据表中取出用于计算的每小时费用
    txtSQL = "select * from BasicData_Info "
    Set mrcB = ExecuteSQL(txtSQL, MsgText)
    FreeTime = Val(mrcB!PrepareTime)
    '将固定用户和临时用户的每小时费用分别赋给中间变量
    FixUserCharge = mrcB!Rate
    TemUserCharge = mrcB!tmpRate
    '计算实际上机时间
    Timefact = DateDiff("n", OnTime, Now) - FreeTime  '以分钟为单位,避免隔天问题，用Now算上机时间
    lblCTime.Caption = Timefact
    
 '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
 '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
    '正式计费
    
    '判断实际在线时间是否小于准备时间,若小于则消费时间为0
     If lblCTime.Caption <= Val(Trim(mrcB!PrepareTime)) Then
        lblCTime.Caption = 0
        lblCMoney.Caption = 0
     Else
        '判断实际在线时间是否小于最低消费时间，若小于消费时间为0
        If lblCTime.Caption <= Val(Trim(mrcB!leasttime)) Then
            lblCTime.Caption = 0
            lblCMoney.Caption = 0
        Else
         '实际在线时间大于最低消费时间则按单位时间算，分固定用户和临时用户
            If lblCTime.Caption >= Val(Trim(mrcB!leasttime)) And lblCTime.Caption < Val(Trim(mrcB!UnitTime)) _
            And Trim(mrc!Type) = "固定用户" Then
                lblCMoney.Caption = FixUserCharge '就像是网吧一样，不到一小时也按照一小时算
            Else
                If lblCTime.Caption >= Val(Trim(mrcB!leasttime)) And lblCTime.Caption < Val(Trim(mrcB!UnitTime)) _
                And Trim(mrc!Type) = "临时用户" Then
                    lblCMoney.Caption = TemUserCharge   '临时用户每小时费用
                Else
                    '当实际在线时间大于单位时间，即递增单位时间60分钟，就按有几个单位时间算，分固定用户和临时用户
                    '计算固定用户的消费
                    If lblCTime.Caption > Val(mrcB!UnitTime) And Trim(mrc!Type) = "固定用户" Then
                        lblCMoney.Caption = Int(Val(lblCTime.Caption) / 60 + 1) * Val(FixUserCharge) '加1是避免1.5小时按1小时算
                    Else
                        '计算临时用户的消费
                        If lblCTime.Caption > Val(mrcB!UnitTime) And Trim(mrc!Type) = "临时用户" Then
                            lblCMoney.Caption = Int(Val(lblCTime.Caption) / 60 + 1) * Val(TemUserCharge)
                        End If
                    End If
                End If
            End If
        End If
    End If
    
    '计算余额=原余额—消费金额
    Newcash = PastCash - Val(lblCMoney.Caption)
    
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

    '下机信息完整显示
    
    '先通过卡号显示上机信息
    txtSQL = "select * from Online_Info where cardno='" & txtCardNo.Text & "'"
    Set mrcO = ExecuteSQL(txtSQL, MsgText)
    lblType.Caption = mrcO!cardtype
    lblSID.Caption = mrcO!studentno
    lblName.Caption = mrcO!studentName
    lblDept.Caption = mrcO!department
    lblSex.Caption = mrcO!sex
    lblOnDate.Caption = Format(mrcO!ondate)
    lblOnTime.Caption = mrcO!OnTime
    '然后显示下机信息
    lblOffDate.Caption = Date  '下机日期
    lblOffTime.Caption = offTime   '下机时间
    lblBalance.Caption = Newcash '显示余额
    
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
    '更新相应表中的数据
    
    '更新student表中的余额记录
    txtSQL = "select * from student_Info where cardno='" & txtCardNo.Text & " '"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc!cash = Newcash
    mrc.Update
    mrc.Close
    
    '更新Line_Info表
    txtSQL = "select * from Line_Info"
    Set mrcL = ExecuteSQL(txtSQL, MsgText)
    mrcL.AddNew    '敲代码时忘了加了，导致3021错误
    mrcL.Fields(1) = mrcO.Fields(0)
    mrcL.Fields(2) = mrcO.Fields(2)
    mrcL.Fields(3) = mrcO.Fields(3)
    mrcL.Fields(4) = mrcO.Fields(4)
    mrcL.Fields(5) = mrcO.Fields(5)
    mrcL.Fields(6) = mrcO.Fields(6)
    mrcL.Fields(7) = mrcO.Fields(7)
    '向line表中存入当前日期和时间
    mrcL.Fields(8) = Date
    mrcL.Fields(9) = offTime
    '向line表中存入经过计算的数据
    mrcL.Fields(10) = lblCTime.Caption
    mrcL.Fields(11) = lblCMoney.Caption
    mrcL.Fields(12) = Newcash
    '向line表中存入固定数据
    mrcL.Fields(13) = "正常下机"
    mrcL.Fields(14) = VBA.Environ("ComputerName")
    mrcL.Update
    
    '删除Online表中的上机数据
    mrcO.Delete
    mrcO.Update
    MsgBox "下机成功！欢迎再次使用~~~"
    mrcO.Close
     
     '重新打开上机表，更新一下，重新计算当前上机人数，否则保留的是原来取得的旧记录
    txtSQL = "select * from Online_Info "
    Set mrcO = ExecuteSQL(txtSQL, MsgText)
    lblPeople.Caption = mrcO.RecordCount
    
    '将显示的内容清空
    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 = ""
 
End Sub
</span>

　　关于结账部分：机房收费系统之结账，听取小伙伴们的建议，画了一张流程图，更新中，敬请期待……