机房收费系统下机之动态显示余额和强制下机(2)

具体讲解参考上一篇博客：
机房收费系统下机之动态显示余额和强制下机(1)

封装下机代码

Public Function offline(cardno As String)
    Dim mrcline As ADODB.Recordset
    Dim mrcbasic As ADODB.Recordset
    Dim mrccash As ADODB.Recordset
    Dim mrcupdate As ADODB.Recordset
    Dim mrc As ADODB.Recordset
    Dim txtsql, msgtext As String
    Dim alltime As Integer
    
    '下机时间
    txtofflinedate.Text = Now()
    
    '查询上机表
    txtsql = "select * from line_info where cardno='" & username & "' and status='上机中'"
    Set mrcline = ExecuteSQL(txtsql, msgtext)
    
    '计算上机时间
    alltime = Fix(DateDiff("n", mrcline!ondatetime, Now()))
    txttime.Text = alltime
    
    '查询基础数据表
    txtsql = "select * from basicdata_info"
    Set mrcbasic = ExecuteSQL(txtsql, msgtext)

    '判断是否超过准备时间
    If alltime < mrcbasic!leasttime Then
        txtcash.Text = "0.00"
    Else
        '根据用户类型计算每15分钟的花费
        If Trim(mrcline!cardtype) = "固定用户" Then
            unitmoney = Format(1 / 4 * Val(mrcbasic!Rate), "0.00")
        Else
            unitmoney = Format(1 / 4 * Val(mrcbasic!tmprate), "0.00")
        End If
        
       '不是十五的整倍数的进1，按照十五进行计算
        If alltime Mod 15 = 0 Then
            '判断用户类型而收费
            If Trim(mrcline!cardtype) = "固定用户" Then
                    costmoney = Format(alltime / 15 * unitmoney, "0.00")
                Else
                    costmoney = Format(alltime / 15 * unitmoney, "0.00")
            End If
        
        Else
            '判断用户类型而收费
            If Trim(mrcline!cardtype) = "固定用户" Then
                costmoney = Format((Fix(alltime / 15) + 1) * unitmoney, "0.00")
            Else
                costmoney = Format((Fix(alltime / 15) + 1) * unitmoney, "0.00")
            End If
        
        End If
    
        '计算余额
        txtsql = "select * from card_info where cardno='" & username & "'"
        Set mrccash = ExecuteSQL(txtsql, msgtext)
    
        txtbalance.Text = Format(mrccash!cash - costmoney) '显示余额
        txtcash.Text = Format(costmoney, "0.00")           '显示消费金额
    
    End If

    '更新上下机表
    txtsql = "update line_info set offdatetime='" & Trim(txtofflinedate.Text) & "',consumetime='" & Trim(txttime.Text) & _
    "',consume='" & Trim(txtcash.Text) & "',cash='" & Trim(txtbalance.Text) & "',status='已下机' where cardno='" & username & "' and status='上机中'"
    Set mrc = ExecuteSQL(txtsql, msgtext)
    
    '更新卡号表
    txtsql = "update card_info set cash='" & Trim(txtbalance.Text) & "' where cardno='" & username & "'"
    Set mrc = ExecuteSQL(txtsql, msgtext)
    
    MsgBox "下机成功！", 0 + 48, 提示
    frmcommonuser.Hide
    flogin.Show

End Function

调用下机代码

Private Sub cmdoffline_Click()
    Call offline(username)
End Sub

动态计费和强制下机

Private Sub Timer2_Timer()
    Dim mrcline As ADODB.Recordset
    Dim mrcbasic As ADODB.Recordset
    Dim mrccash As ADODB.Recordset
    Dim txtsql As String
    Dim msgtext As String
    Dim alltime As Integer
    

    '查询上机表
    txtsql = "select * from line_info where cardno='" & username & "' and status='上机中'"
    Set mrcline = ExecuteSQL(txtsql, msgtext)
    
    '计算上机时间
    alltime = Fix(DateDiff("n", mrcline!ondatetime, Now()))
    txttime.Text = alltime
    
    '查询基础数据表
    txtsql = "select * from basicdata_info"
    Set mrcbasic = ExecuteSQL(txtsql, msgtext)

    '根据用户类型计算每15分钟的花费，用户后面的动态余额计算
    If Trim(mrcline!cardtype) = "固定用户" Then
        unitmoney = Format(1 / 4 * Val(mrcbasic!Rate), "0.00")
    Else
        unitmoney = Format(1 / 4 * Val(mrcbasic!tmprate), "0.00")
    End If

        
    '每隔15分钟进行一次计费
    If alltime Mod 15 = 0 Then
        
        '判断用户类型而计费
        If Trim(mrcline!cardtype) = "固定用户" Then
            costmoney = Format(alltime / 15 * unitmoney, "0.00")
        Else
            costmoney = Format(alltime / 15 * unitmoney, "0.00")
        End If

        '动态计算余额
        txtsql = "select * from card_info where cardno='" & username & "'"
        Set mrccash = ExecuteSQL(txtsql, msgtext)

        txtbalance.Text = Format(txtbalance.Text - unitmoney, "0.00") '动态显示桌面余额
        txtcash.Text = Format(costmoney, "0.00")                       '动态显示桌面计费
        
        If Val(txtbalance.Text) <= unitmoney Then
            MsgBox "卡号：" & username & "，余额不足，即将下机", 0 + 48, "提示"
            '调用下机代码
            Call offline(username)
            Exit Sub
        End If
        
        '判断余额是否低于最低充值要求
        If Val(txtbalance.Text) <= unitmoeny + 1 Then
            MsgBox "卡号：" & username & "，余额不足，请先充值！", 0 + 48, "提示"
        End If

    End If
 
End Sub