【背景】：一個完整的機房收費系統必将涉及到金額不能為負現象。是以考慮到這裡就需要我們實作動态下機功能，動态計算卡内餘額，確定卡内餘額為正。當卡内餘額為0時，系統會将您的卡自動下機。這樣就會避免了機房虧損現象。下面是代碼展示：
'-----------------------------------------------------
'作者：周家林
'功能：動态實作下機，當餘額為零時，電腦實作自動下機功能。
'臨時使用者自動下機，就等于退卡。student_Info表中相應的資料就自動删除，Online_Info表中相對的記錄也會清除，但Line_info表中會相應産生一條記錄。
'固定使用者自動下機和正長下機一樣。student_Info表中保留原卡資訊及最新資料，Online_Info表中相對的記錄也會清除，但Line_info表中會相應産生一條上機記錄。
'-------------------------------------------------------
Private Sub Timer2_Timer()
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
Dim mrc2 As ADODB.Recordset
Dim mrcc As ADODB.Recordset
Dim mrccc As ADODB.Recordset
Dim txtSQL As String
Dim txtSQL1 As String
Dim txtSQL2 As String
Dim txtSQLL As String
Dim txtSQLLL As String
Dim MsgText As String
Dim MsgText1 As String
Static ConsumeCash As Single
Dim Count As Integer
Dim rate As String
Dim strTime As String
Dim strLimitCash As String
Dim sBuffer As String
Dim lSize As Long
'通過對資料庫中Basicdata（基礎資料）表，查詢出學生上機花費的比率和最小金額
txtSQL = "select Rate,tmpRate from BasicData_Info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
rate = Trim$(mrc.Fields(0))
strLimitCash = Trim$(mrc.Fields(1))
mrc.Close
'查詢資料庫中Online（正在上機人員）表
txtSQL = "select * from OnLine_Info"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
Do While mrc.EOF = False '循環正在上機人員表中的每一條記錄
txtSQLL = "select cash from student_Info where cardno='" & _
Trim$(mrc.Fields(0)) & "' and status='使用'" '從Student（學生資訊）表中查詢學生的餘額
Set mrcc = ExecuteSQL(txtSQLL, MsgText)
txtSQL1 = "select * from OnLine_Info where cardno='" & _
Trim$(mrc.Fields(0))
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
If Trim$(mrc1.Fields(1)) = "固定使用者" Then '判斷使用者類型
mrc1.Close
strTime = DateDiff("s", mrc.Fields(7), CStr(Format$(Now, "hh:mm"))) '計算學生從開始上機到現在的時間差
strTime = Format$(strTime / 3600, "0.00")
If CSng(mrcc.Fields(0)) - CSng(CSng(rate) * CSng(strTime)) <= 0 Then 'CSng(strLimitCash) Then 如果餘額不足，則強制下機
'往Line（上機記錄）表中添加新的下機資訊，并強制該學生下機
txtSQLLL = "select * from Line_Info"
Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
mrccc.AddNew
mrccc.Fields(1) = Trim$(mrc.Fields(0))
mrccc.Fields(2) = Trim$(mrc.Fields(2))
mrccc.Fields(3) = Trim$(mrc.Fields(3))
mrccc.Fields(4) = Trim$(mrc.Fields(4))
mrccc.Fields(5) = Trim$(mrc.Fields(5))
mrccc.Fields(6) = Trim$(mrc.Fields(6))
mrccc.Fields(7) = Trim$(mrc.Fields(7))
mrccc.Fields(8) = CStr(Format$(Now, "yyyy-mm-dd"))
mrccc.Fields(9) = CStr(Format$(Now, "hh:mm"))
mrccc.Fields(10) = Trim$(strTime)
mrccc.Fields(11) = CStr(CSng(rate) * CSng(strTime))
mrccc.Fields(12) = CStr(CSng(mrcc.Fields(0)) - CSng(CSng(rate) * CSng(strTime)))
mrccc.Fields(13) = "強制下機"
mrccc.Fields(14) = Trim(Winsock1.LocalHostName) '擷取電腦名
mrccc.Fields(15) = "未結賬"
mrccc.Fields(16) = ad
mrccc.Update
mrccc.Close
'修改Student（學生資訊）表中的餘額
txtSQLLL = "select cash from student_Info where cardno='" & _
Trim$(mrc.Fields(0)) & "' and status='使用'"
Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
mrccc.Fields(0) = CStr(CSng(mrcc.Fields(0)) - CSng(CSng(rate) * CSng(strTime)))
mrccc.Update
mrccc.Close
'删除Online（正在上機人員）表中該學生的資訊
txtSQLLL = "select * from OnLine_Info where cardno='" & _
Trim$(mrc.Fields(0)) & "'"
Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
If Not mrccc.EOF Then
mrccc.Delete
Else
mrccc.Close
End If
'彈出對話框“餘額不足，已強制下機！”
MsgBox "卡号" & mrc.Fields(0) & "餘額不足，已強制下機！", vbOKOnly + vbExclamation, "警告"
End If
mrc.MoveNext
Else '臨時使用者的情況
strTime = DateDiff("s", mrc.Fields(7), CStr(Format$(Now, "hh:mm"))) '計算學生從開始上機到現在的時間差
strTime = Format$(strTime / 3600, "0.00")
If CSng(mrcc.Fields(0)) - CSng(CSng(strLimitCash) * CSng(strTime)) <= 0 Then 如果餘額不足，則強制下機
'往Line（上機記錄）表中添加新的下機資訊，并強制該學生下機
txtSQLLL = "select * from Line_Info"
Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
mrccc.AddNew
mrccc.Fields(1) = Trim$(mrc.Fields(0))
mrccc.Fields(2) = Trim$(mrc.Fields(2))
mrccc.Fields(3) = Trim$(mrc.Fields(3))
mrccc.Fields(4) = Trim$(mrc.Fields(4))
mrccc.Fields(5) = Trim$(mrc.Fields(5))
mrccc.Fields(6) = Trim$(mrc.Fields(6))
mrccc.Fields(7) = Trim$(mrc.Fields(7))
mrccc.Fields(8) = CStr(Format$(Now, "yyyy-mm-dd"))
mrccc.Fields(9) = CStr(Format$(Now, "hh:mm"))
mrccc.Fields(10) = Trim$(strTime)
mrccc.Fields(11) = CStr(CSng(rate) * CSng(strTime))
mrccc.Fields(12) = CStr(CSng(mrcc.Fields(0)) - CSng(CSng(rate) * CSng(strTime)))
mrccc.Fields(13) = "強制下機"
mrccc.Fields(14) = Trim(Winsock1.LocalHostName)
mrccc.Fields(15) = "未結賬"
mrccc.Fields(16) = ad
mrccc.Update
mrccc.Close
'修改Student（學生資訊）表中的餘額
txtSQLLL = "select cash from student_Info where cardno='" & _
Trim$(mrc.Fields(0)) & "' and status='使用'"
Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
mrccc.Fields(0) = CStr(CSng(mrcc.Fields(0)) - CSng(CSng(strLimitCash) * CSng(strTime)))
mrccc.Update
mrccc.Close
'删除Online（正在上機人員）表中該學生的資訊
txtSQLLL = "select * from OnLine_Info where cardno='" & _
Trim$(mrc.Fields(0)) & "'"
Set mrccc = ExecuteSQL(txtSQLLL, MsgText)
If Not mrccc.EOF Then
mrccc.Delete
Else
mrccc.Close
End If
txtSQL2 = "select * from student_Info where cardno = '" & Trim$(mrc.Fields(0)) & "'"
Set mrc2 = ExecuteSQL(txtSQL2, MsgText1)
mrc2.Delete
mrc2.Update
mrc2.Close
'彈出對話框“餘額不足，已強制下機！”
MsgBox "卡号" & mrc.Fields(0) & "餘額不足，已強制下機！", vbOKOnly + vbExclamation, "警告"
'
End If
mrc.MoveNext
End If
Loop
End If
End Sub
![Jericho Html Parser初探[圖]](data:image/gif;base64,R0lGODlhAQABAIAAAP///wAAACwAAAAAAQABAAACAkQBADs=)