具体讲解参考上一篇博客:
机房收费系统下机之动态显示余额和强制下机(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