机房收费系统-上下机

前言：在十一结束的时候，机房收费系统的基本功能终于完成了，但因为自考的缘故，也没有一直写博客总结，今天就趁着闲暇时间完成总结，完美收官。

机房收费系统的上下机是最基本的功能，简单来说，收费、统计等功能都是建立在上下机以及相连的数据库表之上的，没有上下机，其他都是空谈。

上机：上机很简单，流程就是操作员给要上机的用户上机，在用户名处输入学号，然后点击上机，将上机的用户从学生表中找出，并将部分数据传递给Online表中，从而完成上机。

流程图：

代码部分：
Private Sub cmdOnline_Click()
    Dim mrcbd As ADODB.Recordset
    Dim mrcol As ADODB.Recordset
    
    '下机按钮可用
    cmdOffline.Enabled = True
    
    '若卡号框为空
    If txtCardID.Text = "" Then
        Label14.Caption = "请输入卡号！"
        txtCardID.SetFocus
        Exit Sub
    Else
        If Not IsNumeric(Trim(txtCardID.Text)) Then
            Label14.Caption = "请输入数字！"
            txtCardID.Text = ""
            txtCardID.SetFocus
            Exit Sub
        End If
    End If
    
    '查询学生表中卡号列
    txtSQL = "select * from student_info where cardno='" & Trim(txtCardID.Text) & "'"
    Set mrcs = ExecuteSQL(txtSQL, MsgText)
    
    '第一次判断是否有用户
    If mrcs.EOF Then
        Label14.Caption = "没有该用户，请注册或核实信息是否正确！"
        txtCardID.SetFocus
        txtCardID.Text = ""
        Exit Sub
    Else
        '第二次判断是否用户正在上机
        txtSQL = "select * from online_info where cardno='" & Trim(txtCardID.Text) & "'"
        Set mrcol = ExecuteSQL(txtSQL, MsgText)
        
        '如果用户正在上机
        If mrcol.EOF = False Then
                Label14.Caption = "该用户正在上机！"
                txtCardID.Text = mrcs!cardno
                txtType.Text = mrcs!Type
                txtSID.Text = mrcs!studentno
                txtName.Text = mrcs!studentname
                txtFaculty.Text = mrcs!department
                txtGender.Text = mrcs!sex
                txtOnlineDate.Text = mrcs!Date
                txtOnlineTime.Text = mrcs!Time
                lblUserName.Caption = UserName
                txtBalance.Text = mrcs!cash
                
            Exit Sub
        Else
        
            '第三次判断用户余额是否充足
            '该处一定要用where来判断是对哪一列数据的对比
            txtSQL = "select * from student_info where cardno='" & Trim(txtCardID.Text) & "'"
            Set mrcs = ExecuteSQL(txtSQL, MsgText)
            
            txtSQL = "select * from basicdata_info "
            Set mrcbd = ExecuteSQL(txtSQL, MsgText)
            
            If Val(mrcs.Fields(7)) < Val(mrcbd.Fields(5)) Then
                Label14.Caption = "账户余额不足！请充值后登陆！"
                txtCardID.Text = ""
                txtCardID.SetFocus
                Exit Sub
                
            Else
                '若都符合条件，数据库内数据显示到界面
                txtCardID.Text = mrcs!cardno
                txtType.Text = mrcs!Type
                txtSID.Text = mrcs!studentno
                txtName.Text = mrcs!studentname
                txtFaculty.Text = mrcs!department
                txtGender.Text = mrcs!sex
                txtOnlineDate.Text = Date
                txtOnlineTime.Text = Time
                txtBalance.Text = mrcs!cash
                txtOfflineDate.Text = ""
                txtOfflineTime.Text = ""
                txtCostMoney.Text = ""
                txtCostTime.Text = ""
                
                '更新online表
                txtSQL = "select * from online_info where cardno='" & Trim(txtCardID.Text) & "'"
                Set mrcol = ExecuteSQL(txtSQL, MsgText)
                
                mrcol.AddNew
                mrcol.Fields(0) = Trim(txtCardID.Text)
                mrcol.Fields(1) = Trim(txtType.Text)
                mrcol.Fields(2) = Trim(txtSID.Text)
                mrcol.Fields(3) = Trim(txtName.Text)
                mrcol.Fields(4) = Trim(txtFaculty.Text)
                mrcol.Fields(5) = Trim(txtGender.Text)
                mrcol.Fields(6) = Date
                mrcol.Fields(7) = Time
                
                '获取计算机的名字和日期
                mrcol.Fields(8) = Trim(VBA.Environ("computername"))
                mrcol.Fields(9) = Date
                
                '更新上机人数
                txtSQL = "select * from online_info"
                Set mroln = ExecuteSQL(txtSQL, MsgText)
                
                    If mroln.EOF = False Then
                        Label16.Caption = mroln.RecordCount
                    Else
                        Label16.Caption = 0
                    End If
                
                txtBalance.Text = Trim(mrcs!cash)
                
                '更新表
                mrcol.Update
                MsgBox "上机成功!", 0 + 48, "提示"
                mrcol.Close
                
                '提示框清除数据，防止以前报错的信息遗留
                Label14.Caption = ""
                
            End If
        End If
    End If
   End Sub

下机则是将要下机的用户从界面中"取消登陆的状态"，从数据库Online表中删掉，再添加到line表中，并且通过Basicdata表中的计费数据，进行计算。之后根据用户所消费的金额，从余额中扣除金钱，从而更新学生表

下机代码：

Private Sub cmdOffline_Click()
    Dim mrcol As ADODB.Recordset
    Dim mrcl As ADODB.Recordset
    Dim mrcoloff As ADODB.Recordset
    Dim offlinetime As Integer
    Dim mrcbd As ADODB.Recordset
    Dim costtime As String
    Dim costday As String
    Dim alltime As String
    Dim unittime As String
    
    '判断是否输入卡号
    If txtCardID.Text = "" Then
        Label14.Caption = "请输入卡号！"
        txtCardID.SetFocus
        Exit Sub
    End If
    
    '查询online表中的卡号列
    txtSQL = "select * from online_info where cardno='" & Trim(txtCardID.Text) & "'"
    Set mrcol = ExecuteSQL(txtSQL, MsgText)
    
    '判断该用户是否正在上机
    If mrcol.EOF Then
        Label14.Caption = "该用户尚未上机！"
        txtCardID.SetFocus
        txtCardID.Text = ""
        Exit Sub
    Else
        '消费时间计算
        costday = DateDiff("n", mrcol!ondate, Date)
        costtime = DateDiff("n", mrcol!OnTime, Time)
        alltime = Val(costday) + Val(costtime)
        
        txtSQL = "select * from basicdata_info "
        Set mrcbd = ExecuteSQL(txtSQL, MsgText)
        
        '判断是什么类型用户，从而进行计费
        If Trim(mrcol!cardtype) = "固定用户" Then
            txtCostMoney = alltime / 60 * mrcbd!Rate
        Else
            txtCostMoney = alltime / 60 * mrcbd!tmprate
        End If
        
        '判断是否超过准备时间
        If costtime < mrcbd!leastTime Then
            txtCostMoney = 0
        End If
        
        '将各表中的部分数据更新到桌面
        txtSQL = "select * from online_info where cardno='" & Trim(txtCardID.Text) & "'"
        Set mrcoloff = ExecuteSQL(txtSQL, MsgText)
        
        txtCardID.Text = mrcoloff.Fields(0)
        txtType.Text = mrcoloff!cardtype
        txtSID.Text = mrcoloff.Fields(2)
        txtName.Text = mrcoloff.Fields(3)
        txtFaculty.Text = mrcoloff.Fields(4)
        txtGender.Text = mrcoloff.Fields(5)
        txtOnlineDate.Text = Trim(mrcoloff.Fields(6))
        txtOnlineTime.Text = Trim(mrcoloff.Fields(7))
        lblUserName.Caption = UserName
        txtOfflineDate.Text = Date
        txtOfflineTime.Text = Time
        txtBalance.Text = Trim(mrcs!cash) - txtCostMoney.Text
        txtCostTime.Text = str(alltime)
        
        '将桌面信息记录到下机表line表中
        
        txtSQL = "select * from line_info where cardno='" & Trim(txtCardID.Text) & "'"
        Set mrcl = ExecuteSQL(txtSQL, MsgText)
        
        mrcl.AddNew
        mrcl!cardno = mrcoloff!cardno
        mrcl!studentno = mrcoloff!studentno
        mrcl!studentname = mrcoloff!studentname
        mrcl!department = mrcoloff!department
        mrcl!sex = mrcoloff!sex
        mrcl!ondate = mrcoloff!ondate
        mrcl!OnTime = mrcoloff!OnTime
        
        mrcl.Fields(8) = Date
        mrcl.Fields(9) = Time
        mrcl.Fields(10) = alltime
        mrcl.Fields(11) = Val(txtCostMoney)
        mrcl.Fields(12) = Trim(txtBalance.Text)
        mrcl.Fields(13) = "正常下机"
        mrcl.Fields(14) = Trim(VBA.Environ("computername"))
        mrcl.Update
        
        '将余额更新至学生表中
        txtSQL = "select * from student_info where cardno='" & Trim(txtCardID.Text) & "'"
        Set mrcs = ExecuteSQL(txtSQL, MsgText)
        
        mrcs!cash = Trim(txtBalance.Text)
        mrcs.Update
        
        '删除上机表中的要下机的数据
        mrcoloff.Delete               
        MsgBox "下机成功", 0 + 48, "提示"
                
        mrcoloff.Close
        '更新上机人数
        txtSQL = "select * from online_info"
        Set mroln = ExecuteSQL(txtSQL, MsgText)
                
            If mroln.EOF = False Then
                Label16.Caption = mroln.RecordCount
            Else
                Label16.Caption = 0
            End If
    End If
    
    '禁用下机按钮
    cmdOffline.Enabled = False
End Sub

总结：上下机其实就是对数据表中，信息的增加、修改或删除。
难点：下机消费时间与金额的计算，以及对之后表的更新，这期间逻辑一定要十分清晰。