机房收费系统——下机封装、点击下机、全员下机、选择下机和动态下机（有关下机的所有代码）-阿里云开发者社区

下机封装

机房收费系统有很多地方涉及到下机功能，我们可以将下机的代码封装起来，需要下机的时候直接调用，这样避免了代码冗余，逻辑也更容易捋顺。下面是代码：

'下机'
Public Function OffLine(ByVal cardno, MsgString As String)
  Dim studentSQL, OnLineSQL, LineSQL, BasicDataSQL, MsgText As String'SQL前是表名，studentSQL就是存放连接student_Info的语句的'
  Dim mrcstudent, mrcOnLine, mrcLine, mrcBasicData As ADODB.Recordset'mrc后面的也是表名'
  Dim TTime, DTime '用来储存时间的差值和日期的差值'
  Dim CTime, CMoney, Balance As String '消费时间、消费金额、剩余金额'
    If Trim(cardno = "") Then
        MsgString = MsgBox("卡号不可为空！", 0, "系统提示")
        Exit Function
    Else
        studentSQL = "select * from student_info where cardno = '" & cardno & "'and status='使用'"
        Set mrcstudent = ExecuteSQL(studentSQL, MsgText)
        If mrcstudent.EOF Then
            MsgString = MsgBox("卡号尚未注册或被注销！", 0, "系统提示")
            Exit Function
        Else
            OnLineSQL = "select * from OnLine_Info where cardno = '" & cardno & "'"
            Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText)
            If mrcOnLine.EOF Then
                MsgString = MsgBox("未检测到卡号上机。", 0, "系统提示")
                mrcOnLine.Close
                Exit Function
            Else
        '把时间差转换为分钟'
                TTime = Trim(DateDiff("n", Trim(mrcOnLine.Fields(7)), Time))  
                '把日期差转换为分钟'                
                DTime = Trim(DateDiff("n", Trim(mrcOnLine.Fields(6)), Date))                   
                Set mrcBasicData = New ADODB.Recordset
                BasicDataSQL = "select * from BasicData_Info where head = '11'"
                Set mrcBasicData = ExecuteSQL(BasicDataSQL, MsgText)
                Set mrcstudent = New ADODB.Recordset
                studentSQL = "select * from student_info where cardno = '" & cardno & "'"
                Set mrcstudent = ExecuteSQL(studentSQL, MsgText)
                 '如果上机时间小于准备时间，则上消费时间0，不产生消费;如大于准备时间，消费时间就等于时间差与日期差之和减去准备时间'
                If Val(TTime) + Val(DTime) < Val(mrcBasicData.Fields(3)) Then
                    CTime = "0"
                    CMoney = "0.00"
                    Balance = mrcstudent!cash
                    MsgString = "下机成功！卡号" & cardno & "上机时间过短，未产生消费！"
                Else
                    CTime = Val(TTime) + Val(DTime) - Val(mrcBasicData.Fields(3))
                    '判断用户类型，临时用户3元/小时、固定用户2元/小时'
                    If Trim(mrcOnLine.Fields(1)) = "固定用户" Then
                        '计算固定用户消费金额和余额'
                        CMoney = Int(Val(mrcBasicData.Fields(0)) / 60 * Val(CTime))
                        '如果消费金额为0，就改为一小时上网的费用'
                        If CMoney = 0 Then CMoney = Val(mrcBasicData.Fields(0))
                        Balance = mrcstudent!cash - Val(CMoney)
                        mrcstudent.Fields(7) = Val(Balance)
                        mrcstudent.Update   '更新student表中的余额'
                        mrcstudent.Close
                        mrcBasicData.Close
                    Else
                        '计算临时用户消费金额和余额'
                        CMoney = Int(Val(mrcBasicData.Fields(1)) / 60 * Val(CTime))
                        If CMoney = 0 Then CMoney = Val(mrcBasicData.Fields(1))
                        Balance = Val(mrcstudent!cash) - Val(CMoney)
                        mrcstudent.Fields(7) = Val(Balance)
                        mrcstudent.Update   '更新student表中的余额'
                        mrcstudent.Close
                        mrcBasicData.Close
                    End If
                    MsgString = "下机成功！"
                End If
                '更新Line表中的数据'
                LineSQL = "select * from Line_info where ontime= '" & Trim(mrcOnLine.Fields(7)) & "' and ondate= '" & Trim(mrcOnLine.Fields(6)) & "' and cardno= '" & cardno & "'"
                Set mrcLine = ExecuteSQL(LineSQL, MsgText)
                mrcLine.Fields(8) = Date
                mrcLine.Fields(9) = Time
                mrcLine.Fields(10) = Trim(CTime)
                mrcLine.Fields(11) = Trim(CMoney)
                mrcLine.Fields(12) = Trim(Balance)
                mrcLine.Fields(13) = "正常下机"
                mrcLine.Update
                mrcLine.Close
                '删除OnLine表中的信息'
                OnLineSQL = "delete from online_info where cardno='" & cardno & "'"
                Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText)
                '更新上机人数'
                OnLineSQL = "select * from OnLine_Info"
                Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText)
                lblPeople = mrcOnLine.RecordCount
            End If
        End If
    End If
End Function

点击下机

在Main窗体可以实现点击按键上下机，上机就不多说了，下面是下机的代码：

'点击下机按钮'
Private Sub cmdOffLine_Click()
    Dim LineSQL As String'SQL前是表名'
    Dim studentSQL As String
    Dim MsgText As String'存放查询数据库返回的结果'
    Dim MsgS As String  '存放下机返回的结果'
    Dim mrcLine, mrcstudent As ADODB.Recordset'mrc后是表名'
  '调用封装好的下机方法'
    Call OffLine(txtCardNo.Text, MsgS)
    '如果返回的结果包含‘下机成功’就执行后面的代码'
    If InStr(1, MsgS, "下机成功") = 1 Then
    MsgBox MsgS, 0, "系统提示"
        studentSQL = "select * from student_Info where cardno='" & txtCardNo.Text & "'"
        Set mrcstudent = ExecuteSQL(studentSQL, MsgText)
        '更新窗体上的信息'
        txtType.Text = Trim(mrcstudent.Fields(14))
        txtSID.Text = Trim(mrcstudent.Fields(1))
        txtName.Text = Trim(mrcstudent.Fields(2))
        txtDept.Text = Trim(mrcstudent.Fields(4))
        txtSex.Text = Trim(mrcstudent.Fields(3))
        '向Line表中查询同时满足卡号、上机时间和日期的数据'
        LineSQL = "select * from Line_info where ontime= '" & txtOnTime.Text & "' and ondate= '" & txtOnDate.Text & "' and cardno= '" & txtCardNo.Text & "'"
        Set mrcLine = ExecuteSQL(LineSQL, MsgText)
        '更新窗体上的信息'
        txtOnDate.Text = Trim(mrcLine.Fields(6))
        txtOnTime.Text = Trim(mrcLine.Fields(7))
        txtOffDate.Text = Trim(mrcLine.Fields(8))
        txtOffTime.Text = Trim(mrcLine.Fields(9))
        txtCTime.Text = Trim(mrcLine.Fields(10))
        txtCMoney.Text = Trim(mrcLine.Fields(11))
        txtBaLance.Text = Trim(mrcLine.Fields(12))
        mrcstudent.Close
        mrcLine.Close
    End If
End Sub

全员下机

'全部学生下机'
Private Sub AllOffLine_Click()
  Dim Msg As String
  Dim OnLineSQL, MsgText As String
  Dim mrcOnLine As ADODB.Recordset
    '连接OnLine表'
    OnLineSQL = "select * from OnLine_Info"
    Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText)
    If mrcOnLine.EOF Then
        MsgBox "没有卡号在上机，请您稍后重试!", vbOKOnly + vbExclamation, "温馨提示"
        Exit Sub
    Else
      mrcOnLine.MoveFirst
      Do While Not mrcOnLine.EOF
          Call OffLine(mrcOnLine!cardno, Msg)
          mrcOnLine.MoveNext
      Loop
    End If
    MSFlexGrid1.Clear
    Call a
    MsgBox "所有学生下线成功!", vbOKOnly + vbExclamation, "温馨提示"
End Sub

选择下机

这里借鉴了很多前辈的代码，熟练运用变量太重要了。

'鼠标单击选中事件'
Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    '获取选中不连续行的权限，及实现多行选中'
    Dim col As Integer
    If MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = "选中" Then
     MsgBox "请选择卡号下机！", vbOKOnly + vbExclamation, "温馨提示"
    Else
        If MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = "√" Then
            MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = ""
            '改变行颜色(变为没选中之前的）'
            For col = 0 To MSFlexGrid1.cols - 1
                MSFlexGrid1.col = col
                MSFlexGrid1.CellBackColor = vbWhite
            Next col
        Else
            MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = "√"
            '改变行颜色（选中后的颜色）'
            For col = 0 To MSFlexGrid1.cols - 1
                MSFlexGrid1.col = col
                MSFlexGrid1.CellBackColor = vbYellow
            Next col
        End If
    End If
    AllOffLine.Enabled = True
End Sub

'选择卡号下机'
Private Sub SelectedOffLine_Click()
        Dim od(999) As String '存放上机日期'
        Dim ot(999) As String '存放上机时间'
        Dim sz(999) As String '这是一个数组，用来存储带“√”的学号'
        Dim xh(999) As String '用来存储带“√”的MSFlexGrid1的行号'
        Dim z As Integer '用来存储带“√”的学号用到的变量'
        Dim i As Integer '改变颜色时候调用的变量'
        Dim s As Integer '存带√的MSFlexGrid1的行号用到的变量'
        Dim j As Integer
        Dim t As Integer
        Dim Msg As String'存放下机返回的结果'
        '查看MSFlexGrid1表格控件，查看上机状态'
        If MSFlexGrid1.rows <= 1 Then
             MsgBox "没有卡号在上机，请您稍后重试!", vbOKOnly + vbExclamation, "温馨提示"
             Exit Sub
        End If
        '判断有无选择卡号再点击下机'
        If MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = "√" Then
              MsgBox "选中的卡号正在下机中，请稍等!", vbOKOnly + vbExclamation, "温馨提示"
        Else
              MsgBox "您还没有选中卡号!", vbOKOnly + vbExclamation, "温馨提示"
        Exit Sub
        End If
        With MSFlexGrid1
        '记录选中下机的卡号，在最后一行加了一个勾，将这些记录的所有卡号信息全部存到数组sz中'
        i = 0
        For j = 1 To .rows - 1
            If .TextMatrix(j, 9) = "√" Then
                sz(i) = .TextMatrix(j, 1)    '存的是卡号'
                od(i) = .TextMatrix(j, 7)
                ot(i) = .TextMatrix(j, 8)
                xh(i) = Val(j)
                i = i + 1
            End If
        Next j
        For z = 0 To i - 1     '数组是从0开始的'
          Call OffLine(sz(z), Msg)'调用下机'
        Next z
        '更新MSFlexGrid1的界面'
        For s = 0 To i - 1
            .RemoveItem xh(s)
        Next s
        End With
        MsgBox "选中的卡号已下机成功！", vbOKOnly + vbExclamation, "温馨提示"  
    End Sub

动态下机

我的计算方法是把余额转换成时间，以分钟为单位，接着10秒钟查询一遍所有登陆卡号的剩余时间，如果不足10分钟就提示充值，时间用尽就强制下机。

'动态下机'
Private Sub Timer1_Timer()
Dim OnLineSQL, TOnLineSQL, studentSQL, MsgText As String
Dim mrcOnLine, mrcTOnLine, mrcstudent As ADODB.Recordset
Dim i, a As Integer'放置卡号'
Dim consumetime As Single '剩余分钟'
Dim Msg As String'存放下机返回的结果'
    OnLineSQL = "select * from  OnLine_Info"
    Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText)
    BasicDataSQL = "select * from BasicData_Info where head = '11'"
    Set mrcBasicData = ExecuteSQL(BasicDataSQL, MsgText)
    '判断是否有卡号上机'
    If mrcOnLine.EOF Then
        Timer1.Enabled = False
        Exit Sub
    Else
        mrcOnLine.MoveFirst
    End If
    '将上机卡号定义为一个数组'
    ReDim a(mrcOnLine.RecordCount) As String
    For i = 0 To mrcOnLine.RecordCount - 1
        a(i) = Trim(mrcOnLine!cardno)
        '连接学生库查询卡号余额'
        studentSQL = "select * from  student_Info where cardno='" & a(i) & "'"
        Set mrcstudent = ExecuteSQL(studentSQL, MsgText)
        '计算剩余时间（单位：分钟）'
        If Trim(mrcstudent!Type) = "固定用户" Then
            consumetime = Val(mrcstudent!cash) / Val(mrcBasicData.Fields(0)) * 60 + 2
            consumetime = consumetime - Trim(DateDiff("n", Trim(mrcOnLine.Fields(7)), Time))
        Else
            consumetime = Val(mrcstudent!cash) / Val(mrcBasicData.Fields(1)) * 60 + 2
            consumetime = consumetime - Trim(DateDiff("n", Trim(mrcOnLine.Fields(7)), Time))
        End If
        mrcOnLine.MoveNext
        '提醒充值，时间用尽就下机'
        If consumetime < 11 And consumetime > 10 Then
            MsgBox "上机剩余时间不足10分钟，请尽快充值，否则将会被强制下机！", 0 + 1, "系统提示"
        End If
        If consumetime < 2 Then
          '时间用尽了，调用下机'
            Call OffLine(a(i), Msg)
            MsgBox "卡号" & a(i) & ",剩余时间为零，下机完成！", 48, "系统提示"
        End If
    Next i
End Sub

机房收费系统——下机封装、点击下机、全员下机、选择下机和动态下机（有关下机的所有代码）

下机封装

点击下机

全员下机

选择下机

动态下机

热门文章

最新文章

相关电子书

相关实验场景

热门

活动广场

任务中心

开发者评测

高校计划

乘风者计划

训练营

阿里云MVP

话题

直播

下载

镜像站

技术资料

插件

机房收费系统——下机封装、点击下机、全员下机、选择下机和动态下机（有关下机的所有代码）

下机封装

点击下机

全员下机

选择下机

动态下机

热门文章

最新文章

相关电子书

相关实验场景