第一次机房收费系统之一般用户查询上机状态

最新推荐文章于 2019-10-29 14:56:40 发布

追寻_无憾

最新推荐文章于 2019-10-29 14:56:40 发布

阅读量236

点赞数

分类专栏： VB

本文链接：https://blog.csdn.net/TGB__15__ZYB/article/details/97750216

版权

VB 专栏收录该内容

29 篇文章 0 订阅

订阅专栏

对于一般用户的充值记录与查询上机记录的过程相同，唯一不同的时将表line_info换成了recharge_info表，其他的相同，就不重复说明了，下面时一般用户查询上机状态的总结：

操作流程：

点击查询-----弹出条件查询的窗体进行查询
点击显示全部-----则显示所有正在上机的用户
完成第二步可以点击全部用户下机和选中下机------根据不同的方式进行操作连接数据库进行下机

使用数据库表：

student_info（存放学生信息）
online_info（用于判断是否上机）
lind_info（存放上下机记录）
basicdata_info（说明单价以及限制时间）

具体流程：

（具体的操作与操作流程相同，将不再做解释）

代码如下：

1.显示全部

Private Sub ShowAll_Click()
    '对Online_Info表操作
    Dim mrconline As ADODB.Recordset '用于存放记录集
    Dim onlineSQL As String '用于存放SQL语句
    Dim onlineMsgText As String '用于存放返回信息
    
    onlineSQL = "select * from OnLine_Info"
    Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
    
    If mrconline.EOF Then
        MsgBox "没有学生上机！", vbOKCancel + vbExclamation, "警告"
    Else
        With MSHFlexGrid
            Do While mrconline.EOF = False
                .Rows = .Rows + 1
                .CellAlignment = 4
                .TextMatrix(.Rows - 1, 0) = Trim(mrconline.Fields(0))
                .TextMatrix(.Rows - 1, 1) = Trim(mrconline.Fields(3))
                .TextMatrix(.Rows - 1, 2) = Trim(mrconline.Fields(6))
                .TextMatrix(.Rows - 1, 3) = Trim(mrconline.Fields(7))
                .TextMatrix(.Rows - 1, 4) = Trim(mrconline.Fields(8))
                mrconline.MoveNext
            Loop
        End With
        mrconline.Close
    End If
    ShowAll.Enabled = False
    ManagementOn.Enabled = True
End Sub

2.全部下机：

Private Sub AllOff_Click()
    Dim ADDTime As String '上机时间
    Dim Money As Double '消费金额
    Dim Balance As Long '余额
    Dim i As Integer '用于数组行数
    '对student_info表操作
    Dim mrcstudent As ADODB.Recordset '用于存放记录集
    Dim studentSQL As String '用于存放SQL语句
    Dim studentMsgText As String '用于存放返回信息
    '对Oline_info表操作
    Dim mrconline As ADODB.Recordset '用于存放记录集
    Dim onlineSQL As String '用于存放SQL语句
    Dim onlineMsgText As String '用于存放返回信息
    '对line_info表操作
    Dim mrcline As ADODB.Recordset '用于存放记录集
    Dim lineSQL As String '用于存放SQL语句
    Dim lineMsgText As String '用于存放返回信息
    '对basic_info表操作
    Dim mrcbasic As ADODB.Recordset '用于存放记录集
    Dim basicSQL As String '用于存放SQL语句
    Dim basicMsgText As String '用于存放返回信息
     
    onlineSQL = "select * from online_info"
    Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
    
    basicSQL = "select * from basicdata_info"
    Set mrcbasic = ExecuteSQL(basicSQL, basicMsgText)
    
    '定义一个未知行数组
    ReDim a(mrconline.RecordCount) As String
    
    If mrconline.EOF = True Then
        MsgBox "没有上机记录，无法下机！", vbOKOnly + vbInformation, "提示"
        Exit Sub
    Else
        mrconline.MoveFirst
    End If
    
    For i = 0 To mrconline.RecordCount - 1
        a(i) = Trim(mrconline.Fields(0))
    
        studentSQL = "select * from student_info where cardno='" & Trim(mrconline.Fields(0)) & "'"
        Set mrcstudent = ExecuteSQL(studentSQL, studentMsgText)
        
        lineSQL = "select * from Line_Info where status= '正常上机' and cardno='" & Trim(mrconline.Fields(0)) & "'"
        Set mrcline = ExecuteSQL(lineSQL, lineMsgText)
        
        'abs()函数时绝对值函数；datediff（"单位",日期1,日期2）计算时间差；val（）函数字符转数字型
        ADDTime = Abs(Val(DateDiff("n", Trim(mrconline.Fields(9)), Now)))
        If ADDTime < Val(mrcbasic.Fields(4)) Then
            Balance = Trim(mrcstudent.Fields(7))
        Else
            If ADDTime < Val(mrcbasic.Fields(3)) Then
                Money = "1"
                Balance = Val(mrcstudent.Fields(7)) - Money
            Else
                If mrconline.Fields(1) = "固定用户" Then
                    'round（）四舍五入保留两位小数；cdbl（）将string转换为double类型
                    Money = Round(CDbl(ADDTime) * mrcbasic.Fields(0) / 60)
                    Balance = Val(mrcstudent.Fields(7)) - Money
                Else
                    Money = Round(CDbl(ADDTime) * mrcbasic.Fields(1) / 60)
                    Balance = Val(mrcstudent.Fields(7)) - Money
                End If
            End If
        End If
        If Balance < 0 Then
            MsgBox "卡号:" & a(i) & "余额不足，无法下机！", vbOKCancel + vbQuestion, "提示"
            mrconline.MoveNext
        Else
            '更改数据表Student
            mrcstudent.Fields(7) = Trim(Balance)
            mrcstudent.Fields(11) = "未结账"
            mrcstudent.Update
            mrcstudent.Close
            '更新数据表line
            mrcline.Fields(8) = Date
            mrcline.Fields(9) = Time
            mrcline.Fields(10) = ADDTime
            mrcline.Fields(11) = Trim(Money)
            mrcline.Fields(12) = Trim(Balance)
            mrcline.Fields(13) = "正常下机"
            mrcline.MoveNext
            mrconline.Delete
            mrconline.MoveNext
        End If
    Next i
    mrconline.Close
    mrcline.Close
    mrcbasic.Close
    MsgBox "全部学生都已下机！", vbOKOnly + vbExclamation, "提示"
    MSHFlexGrid.Clear
    ShowAll.Enabled = True
    ManagementOn.Enabled = False
    frmMain.lblNOWPeople.Caption = 0
    With MSHFlexGrid
        .Rows = 1
        .TextMatrix(0, 0) = "卡号"
        .TextMatrix(0, 1) = "姓名"
        .TextMatrix(0, 2) = "上机日期"
        .TextMatrix(0, 3) = "上机时间"
        .TextMatrix(0, 4) = "机房号"
        .TextMatrix(0, 5) = "是否选中"
    End With
End Sub

3.选中部分下机

Private Sub MSHFlexGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim column As Integer '定义行数变量
    '判断是否选中
    If MSHFlexGrid.TextMatrix(MSHFlexGrid.Row, 5) = "√" Then
        MSHFlexGrid.TextMatrix(MSHFlexGrid.Row, 5) = ""
        For column = 0 To MSHFlexGrid.Cols - 1
            MSHFlexGrid.Col = column
            MSHFlexGrid.CellBackColor = vbWhite
        Next column
    Else
        If MSHFlexGrid.TextMatrix(MSHFlexGrid.Row, 5) <> "是否选中" Then
            MSHFlexGrid.TextMatrix(MSHFlexGrid.Row, 5) = "√"
            For column = 0 To MSHFlexGrid.Cols - 1
                MSHFlexGrid.Col = column
                MSHFlexGrid.CellBackColor = vbGreen
            Next column
        End If
    End If
End Sub
Private Sub SomeOff_Click()
    Dim a As Integer '用于判断选择下机人数
    Dim Line1 As Integer '用于FOR循环的变量
    Dim line As Integer '用于FOR循环的变量
    Dim ADDTime As Double '上机时间
    Dim Money As Double '消费金额
    Dim Balance As Double '余额
    '对student_info表操作
    Dim mrcstudent As ADODB.Recordset '用于存放记录集
    Dim studentSQL As String '用于存放SQL语句
    Dim studentMsgText As String '用于存放返回信息
     '对Oline_info表操作
    Dim mrconline As ADODB.Recordset '用于存放记录集
    Dim onlineSQL As String '用于存放SQL语句
    Dim onlineMsgText As String '用于存放返回信息
    '对Online_info表再次操作
    Dim mrconline1 As ADODB.Recordset '用于存放记录集
    Dim onlineSQL1 As String '用于存放SQL语句
    Dim onlineMsgText1 As String '用于存放返回信息
    '对line_info表操作
    Dim mrcline As ADODB.Recordset '用于存放记录集
    Dim lineSQL As String '用于存放SQL语句
    Dim lineMsgText As String '用于存放返回信息
    '对basic_info表操作
    Dim mrcbasic As ADODB.Recordset '用于存放记录集
    Dim basicSQL As String '用于存放SQL语句
    Dim basicMsgText As String '用于存放返回信息
    flag = True
    a = 0
    For Line1 = MSHFlexGrid.Rows To 1 Step -1
        If MSHFlexGrid.TextMatrix(Line1 - 1, 5) = "√" Then
            a = a + 1
        End If
    Next Line1
    If a = 0 Then
        MsgBox "请选择下机人员！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    Else
        For line = MSHFlexGrid.Rows To 2 Step -1
            If MSHFlexGrid.TextMatrix(line - 1, 5) = "√" Then
                onlineSQL = "select * from online_info where cardno='" & Trim(MSHFlexGrid.TextMatrix(line - 1, 0)) & "'"
                Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
    
                lineSQL = "select * from Line_Info where cardno='" & Trim(MSHFlexGrid.TextMatrix(line - 1, 0)) & "' and status= '正常上机' "
                Set mrcline = ExecuteSQL(lineSQL, lineMsgText)
    
                basicSQL = "select * from basicdata_info"
                Set mrcbasic = ExecuteSQL(basicSQL, basicMsgText)
    
                studentSQL = "select * from student_info where cardno='" & Trim(MSHFlexGrid.TextMatrix(line - 1, 0)) & "'"
                Set mrcstudent = ExecuteSQL(studentSQL, studentMsgText)
    
                'abs()函数时绝对值函数；datediff（"单位",日期1,日期2）计算时间差；val（）函数字符转数字型
                ADDTime = Abs(Val(DateDiff("n", Trim(mrconline.Fields(9)), Now)))
                If ADDTime < Val(mrcbasic.Fields(4)) Then
                    mrcstudent.Fields(7) = Trim(mrcstudent.Fields(7))
                End If
                If ADDTime < Val(mrcbasic.Fields(3)) Then
                    Money = "1"
                    Balance = Val(mrcstudent.Fields(7)) - Money
                End If
                If mrconline.Fields(1) = "固定用户" Then
                    'round（）四舍五入保留两位小数；cdbl（）将string转换为double类型
                    Money = Round(CDbl(ADDTime) * mrcbasic.Fields(0) / 60)
                    Balance = Val(mrcstudent.Fields(7)) - Money
                Else
                    Money = Round(CDbl(ADDTime) * mrcbasic.Fields(1) / 60)
                    Balance = Val(mrcstudent.Fields(7)) - Money
                End If
                If Balance < 0 Then
                    MsgBox "此卡余额不足，无法下机！", vbOKCancel + vbQuestion, "提示"
                    mrconline.MoveNext
                Else
                    mrcstudent.Fields(7) = Trim(Balance)
                    mrcstudent.Fields(11) = "未结账"
                    mrcstudent.Update
                    mrcstudent.Close
                    mrcline.Fields(8) = Date
                    mrcline.Fields(9) = Time
                    mrcline.Fields(10) = ADDTime
                    mrcline.Fields(11) = Trim(Money)
                    mrcline.Fields(12) = Trim(Balance)
                    mrcline.Fields(13) = "正常下机"
                    mrcline.Update
                    mrcline.Close
                    mrconline.Delete
                    mrconline.Close
                    mrcbasic.Close
                    MSHFlexGrid.RemoveItem line - 1
                End If
            End If
        Next line
        MsgBox "选中的学生已经下机！", vbOKOnly + vbInformation, "提示"
        ShowAll.Enabled = True
    End If
    '显示上机人数
    onlineSQL1 = "select * from OnLine_info"
    Set mrconline1 = ExecuteSQL(onlineSQL1, onlineMsgText1)
    If mrconline1.EOF Then
        frmMain.lblNOWPeople.Caption = 0
    Else
        frmMain.lblNOWPeople.Caption = mrconline1.RecordCount '计算上机总人数
    End If
End Sub

4.条件查询
条件查询见后面博客