机房管理系统—学生上机状态查询—上机管理

本篇博客主要是讲<全部下机>和<选中下机>。

全部下机：

思路：

1.查询Online表，查询是否有人上机，若无，则不用进行下机处理了。
2.将记录移至第一项
3.进行循环处理：
①.查询学生表数据，目标是查到与Online表第一项一致的记录。
②.利用Datediff函数，计算数据库中的上机日期与时间和现在的日期时间的差值，从而获取消费时长。
③.查询用户的类型，根据用户类型和消费时长，计算出消费金额。
④.连接Line表，将数据同步到Line表。
⑤.删除Online表的当前数据，并移至下一条记录。（我用的是Movenext，不是MoveFrist，应该也可以。）
4.关闭数据库连接

代码片：

Private Sub Menu_AllStuOff_Click()
Dim mrcON As ADODB.Recordset
Dim mrcL As ADODB.Recordset
Dim mrcStu As ADODB.Recordset
Dim txtSQLON As String
Dim txtSQLL As String
Dim txtSQLStu As String
Dim MsgText As String
Dim Minute As String
Dim Day As String
Dim Hour As Integer
Dim ATime As Long               '上机时间
Dim AMoney As Long              '上机金额
Dim Status As String
Dim save As Boolean
    Status = "全部下机"
    save = False
    txtSQLON = "select * from online_info"
    Set mrcON = ExecuteSQL(txtSQLON, MsgText)
    '第一步，先查询数据库中是否有记录，如无，结束IF语句。
    If mrcON.RecordCount = 0 Then
        MsgBox "当前无用户上机！", vbOKOnly, "提示"
        
    Else
        '第二步，对数据库记录集中的所有记录进行处理。
        mrcON.MoveFirst                 '先定位到第一条记录。
        Do While Not mrcON.EOF              '开始循环处理，直到无记录。
            txtSQLStu = "select * from student_info where cardno='" & Trim(mrcON.Fields(0)) & "'"   '保持记录与ONline表第一个一致
            Set mrcStu = ExecuteSQL(txtSQLStu, MsgText)
            
            Day = DateDiff("d", mrcON.Fields(6), Date)       '计算上机下机的日期差
            Minute = DateDiff("n", mrcON.Fields(7), Time)         '计算上机下机的同日时间
            ATime = 3600 * Val(Day) + Minute               '计算总时间差，分钟为单位
            Hour = ATime \ 60
            If ATime <= 3 Then        '上机时间不超过三分钟，不收钱。
                Hour = 0
                AMoney = 0
                save = True
            Else
                Hour = Hour + 1         '超过三分钟，先收一个小时的钱。
                save = True
                If Trim(mrcON.Fields(1)) = "固定用户" Then
                    AMoney = Hour * 3               '花费的金钱
                    mrcStu.Fields(7) = mrcStu.Fields(7) - Val(AMoney)
                Else
'                    txtSQLStu = "select * from student_info where cardno='" & Trim(mrcON.Fields(0)) & "'"
'                    Set mrcStu = ExecuteSQL(txtSQLStu, MsgText)
                    AMoney = Hour * 5               '花费的金钱
                    mrcStu.Fields(7) = mrcStu.Fields(7) - Val(AMoney)
                End If
            End If
            
            If save = True Then
            txtSQLL = "select * from line_info"
            Set mrcL = ExecuteSQL(txtSQLL, MsgText)
            mrcL.AddNew              '将数据添加到数据库中
            mrcL.Fields(1) = mrcON.Fields(0)
            mrcL.Fields(2) = mrcON.Fields(2)
            mrcL.Fields(3) = mrcON.Fields(3)
            mrcL.Fields(4) = mrcON.Fields(4)
            mrcL.Fields(5) = mrcON.Fields(5)
            mrcL.Fields(6) = mrcON.Fields(6)
            mrcL.Fields(7) = mrcON.Fields(7)
            mrcL.Fields(8) = Date
            mrcL.Fields(9) = Time
            mrcL.Fields(10) = Val(ATime)
            mrcL.Fields(11) = AMoney
            mrcL.Fields(12) = Val(mrcStu.Fields(7)) - AMoney
            mrcL.Fields(13) = Status
            mrcL.Fields(14) = VBA.Environ("computername")
            mrcL.Update
            End If
            
            save = False
            mrcON.Delete
            mrcON.MoveNext
        Loop
        MsgBox "所有用户下机成功！", vbOKOnly, "提示"
        mrcL.Close
        mrcStu.Close
        mrcON.Close
    End If

End Sub

选中下机：

思路：

1.先查询MSHF是否是有数据，无数据则出现提示
2.连接学生表，查询到与当前选中行的卡号一致的记录。
3.进行数值处理：
①.利用Datediff函数，计算数据库中的上机日期与时间和现在的日期时间的差值，从而获取消费时长。
②.查询用户的类型，根据用户类型和消费时长，计算出消费金额。
③.连接Line表，将数据同步到Line表。
⑤.删除Online表的当前数据。
4.关闭数据库连接
5.最后刷新一下记录。

代码片：

Private Sub Menu_SltStuOff_Click()
Dim mrcON As ADODB.Recordset
Dim mrcL As ADODB.Recordset
Dim mrcStu As ADODB.Recordset
Dim txtSQLON As String
Dim txtSQLL As String
Dim txtSQLStu As String
Dim MsgText As String
Dim Minute As String
Dim Day As String
Dim Hour As Integer
Dim ATime As Long               '上机时间
Dim AMoney As Long              '上机金额
Dim Status As String
Dim save As Boolean
    Status = "选中下机"
    save = False
    txtSQLON = "select * from online_info where cardno='" & Trim(MSHF.Text) & "'"
    Set mrcON = ExecuteSQL(txtSQLON, MsgText)
    '第一步，先查询数据库中是否有记录，如无，结束IF语句。
    If Trim(MSHF.Text) = "" Then
        MsgBox "请先选择用户！", vbOKOnly, "提示"
    ElseIf mrcON.RecordCount = 0 Then
        MsgBox "该用户未上机！", vbOKOnly, "提示"
    Else
        '第二步，对数据库记录集中的记录进行处理。
            txtSQLStu = "select * from student_info where cardno='" & Trim(MSHF.Text) & "'"
            Set mrcStu = ExecuteSQL(txtSQLStu, MsgText)
            
            Day = DateDiff("d", mrcON.Fields(6), Date)       '计算上机下机的日期差
            Minute = DateDiff("n", mrcON.Fields(7), Time)         '计算上机下机的同日时间
            ATime = 3600 * Val(Day) + Minute               '计算总时间差，分钟为单位
            Hour = ATime \ 60
            If ATime <= 3 Then        '上机时间不超过三分钟，不收钱。
                Hour = 0
                AMoney = 0
                save = True
            Else
                Hour = Hour + 1         '超过三分钟，先收一个小时的钱。
                save = True
                If Trim(mrcON.Fields(1)) = "固定用户" Then
                    AMoney = Hour * 3               '花费的金钱
                    mrcStu.Fields(7) = mrcStu.Fields(7) - Val(AMoney)
                    
                Else
'                    txtSQLStu = "select * from student_info where cardno='" & Trim(mrcON.Fields(0)) & "'"
'                    Set mrcStu = ExecuteSQL(txtSQLStu, MsgText)
                    AMoney = Hour * 5               '花费的金钱
                    mrcStu.Fields(7) = mrcStu.Fields(7) - Val(AMoney)
                End If
            End If
            
            If save = True Then
            txtSQLL = "select * from line_info"
            Set mrcL = ExecuteSQL(txtSQLL, MsgText)
            mrcL.AddNew              '将数据添加到数据库中
            mrcL.Fields(1) = mrcON.Fields(0)
            mrcL.Fields(2) = mrcON.Fields(2)
            mrcL.Fields(3) = mrcON.Fields(3)
            mrcL.Fields(4) = mrcON.Fields(4)
            mrcL.Fields(5) = mrcON.Fields(5)
            mrcL.Fields(6) = mrcON.Fields(6)
            mrcL.Fields(7) = mrcON.Fields(7)
            mrcL.Fields(8) = Date
            mrcL.Fields(9) = Time
            mrcL.Fields(10) = Val(ATime)
            mrcL.Fields(11) = AMoney
            mrcL.Fields(12) = Val(mrcStu.Fields(7)) - AMoney
            mrcL.Fields(13) = Status
            mrcL.Fields(14) = VBA.Environ("computername")
            mrcL.Update
            End If
            
            save = False
            mrcON.Delete
            MsgBox "选中用户下机成功！", vbOKOnly, "提示"
            mrcL.Close
            mrcStu.Close
            mrcON.Close
    End If
    Call Menu_ShowAll_Click   '比较懒，直接call了一次。
End Sub

结尾

附赠一下<显示全部>部分的代码。（PS：就是Call的那一部分。）

Private Sub Menu_ShowAll_Click()
Dim txtSQL As String
Dim mrc As ADODB.Recordset
Dim MsgText As String

    txtSQL = "select * from online_info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.RecordCount = 0 Then
        MsgBox "当前无用户上机！", vbOKOnly, "提示"
        With MSHF
        .Clear
        .Rows = 2
        .Cols = 5
        .CellAlignment = 4     '单元内容居中对齐
        .ColAlignment = 4       '列内容居中对齐
        .AllowUserResizing = 3              '尚未感知其用处，解释为用户可以改变网格行列尺寸
        .FixedRows = 1          '更新后，第一行仍是固定行
        .TextMatrix(0, 0) = "卡号"
        .TextMatrix(0, 1) = "姓名"
        .TextMatrix(0, 2) = "上机日期"
        .TextMatrix(0, 3) = "上机时间"
        .TextMatrix(0, 4) = "机器号"
        End With
    Else
        MsgBox "查询成功,如需获取最新信息，请重新点击！", vbOKOnly, "提示"
        mrc.MoveFirst
        With MSHF
            
            .Rows = 1
            .Cols = 5
        Do While Not mrc.EOF    '如果不是最后一个记录
            .Rows = .Rows + 1
            .CellAlignment = 4     '单元内容居中对齐
            .ColAlignment = 4       '列内容居中对齐
            .AllowUserResizing = 3              '尚未感知其用处，解释为用户可以改变网格行列尺寸
            .FixedRows = 1          '更新后，第一行仍是固定行
            .TextMatrix(0, 0) = "卡号"
            .TextMatrix(0, 1) = "姓名"
            .TextMatrix(0, 2) = "上机日期"
            .TextMatrix(0, 3) = "上机时间"
            .TextMatrix(0, 4) = "机器号"
            .TextMatrix(.Rows - 1, 0) = mrc.Fields(0)
            .TextMatrix(.Rows - 1, 1) = mrc.Fields(3)
            .TextMatrix(.Rows - 1, 2) = mrc.Fields(6)
            .TextMatrix(.Rows - 1, 3) = mrc.Fields(7)
            .TextMatrix(.Rows - 1, 4) = mrc.Fields(8)
            mrc.MoveNext
        Loop
        End With
    End If
    mrc.Close
End Sub