機房收費系統之上下機
阿新 • • 發佈：2019-02-09
【前言】上下機部分涉及到的表較多，邏輯性也比較強，如果不先理清邏輯關係就上手寫程式碼肯定會出現好多問題。我的上下機從開始的一頭霧水到後來的逐漸清晰到現在的soeasy,經歷了一個不斷學習和摸索的過程。其實所有的學習都會經歷這個過程，如果我們沒有之前的探索就不會有後來的熟練掌握。
一、上機邏輯
我們在動手之前一定要有一個清晰地邏輯，畫出流程圖認真思考還有沒有落下的地方，再補充流程圖，按著步驟寫程式碼，上下機就變得很簡單了。
上機其實沒有什麼難得就是把所有的要驗證的條件想全面了就好了，什麼情況下允許上機，什麼情況下需要使用者做出修改才能上機，這些都是要提前考慮清楚的，然後就是在Online和Line表裡新增上機資訊資料，再顯示在桌面就行啦！
下面是我畫的上機流程圖：
我的程式碼展示：
'判斷卡號是否為空 If Not Testtxt(txtCardNo.Text) Then MsgBox "請輸入卡號！", vbOKOnly + vbExclamation, "提示" txtCardNo.SetFocus Exit Sub End If '判斷是否為數字 If Not IsNumeric(txtCardNo.Text) Then MsgBox "卡號為數字，請輸入數字！", vbOKOnly + vbExclamation, "提示" txtCardNo.Text = "" txtCardNo.SetFocus Exit Sub End If '判斷是否註冊 txtSQLStu = "select * from student_Info where cardno='" & Trim(txtCardNo.Text) & "'" & "and status='使用" & "'" Set mrcStu = ExecuteSQL(txtSQLStu, MsgText) If mrcStu.EOF = True Then MsgBox "該卡未註冊或已經退卡，請輸入有效卡號！", vbOKOnly + vbExclamation, "提示" txtCardNo.Text = "" txtCardNo.SetFocus Exit Sub Else txtSQLon = "select * from Online_Info where cardno='" & Trim(txtCardNo.Text) & "'" Set mrcon = ExecuteSQL(txtSQLon, MsgText) '判斷是否在上機 If mrcon.EOF = False Then MsgBox "該卡正在上機，請選擇其他卡號上機！", vbOKOnly + vbExclamation, "提示" txtCardNo.Text = "" txtCardNo.SetFocus Exit Sub Else txtSQLBas = "select * from BasicData_Info" Set mrcBas = ExecuteSQL(txtSQLBas, MsgText) If mrcStu.Fields(7) < mrcBas.Fields(0) Then MsgBox "卡內餘額不足，請充值後再上機！", vbOKOnly + vbExclamation, "提示" txtCardNo.Text = "" frmOpeRecharge.Show Exit Sub Else '更新桌面顯示的內容 txtSID.Text = Trim(mrcStu.Fields(1)) txtDepart.Text = Trim(mrcStu.Fields(4)) txtType.Text = Trim(mrcStu.Fields(14)) txtName.Text = Trim(mrcStu.Fields(2)) txtSex.Text = Trim(mrcStu.Fields(3)) txtOnlineDate.Text = Trim(Date) txtOnlineTime.Text = Trim(Time) txtDownLineDate.Text = "" txtDownLineTime.Text = "" txtBalance.Text = Trim(mrcStu.Fields(7)) txtConsumeTime.Text = "" txtConsumeMoney.Text = "" '將內容新增到online表 mrcon.AddNew mrcon.Fields(0) = Trim(txtCardNo.Text) mrcon.Fields(1) = Trim(txtType.Text) mrcon.Fields(2) = Trim(txtSID.Text) mrcon.Fields(3) = Trim(txtName.Text) mrcon.Fields(4) = Trim(txtDepart.Text) mrcon.Fields(5) = Trim(txtSex.Text) mrcon.Fields(6) = Trim(Date) mrcon.Fields(7) = Trim(Time) mrcon.Fields(8) = VBA.Environ("computername") mrcon.Fields(9) = Trim(Now) mrcon.Fields(10) = Trim(Val(0)) mrcon.Update '將資訊更新到Line表 txtSQLline = "select * from Line_Info where cardno='" & txtCardNo.Text & "'" Set mrcline = ExecuteSQL(txtSQLline, MsgText) mrcline.AddNew mrcline.Fields(1) = Trim(txtCardNo.Text) mrcline.Fields(2) = Trim(txtSID.Text) mrcline.Fields(3) = Trim(txtName.Text) mrcline.Fields(4) = Trim(txtDepart.Text) mrcline.Fields(5) = Trim(txtSex.Text) mrcline.Fields(6) = Trim(Date) mrcline.Fields(7) = Trim(Time) mrcline.Fields(13) = Trim("正常上機") mrcline.Fields(14) = Trim(VBA.Environ("computername")) mrcline.Update mrcStu.Close mrcon.Close mrcline.Close End If End If End If
二、下機邏輯
下機的主要邏輯其實和上機的邏輯大同小異，比較複雜的就是計算消費金額。這裡有一個問題就是如果上機使用者改變系統時間我們算的錢不會出錯，所以要麼我們讀取的不能是系統時間，要麼我們就不能使用上機時間減去下機時間的方法來計算消費時間。
我採用的方法是加了一個timer控制元件，每分鐘執行一次，資料庫中的消費時間就會+1，這樣就算使用者改了系統時間也不會影響他的消費時間。
之前我把扣費也加到這個timer事件裡了，每隔一個單位遞增時間就會扣一次錢，但是第一個人上機時正常扣費的，第二個人上機就會有一段時間不收錢，直到第一個使用者下一次收費，第二個使用者才能進行第一次扣費，這就導致之後上機的使用者都會有一段時間是不收錢的，這樣賠本的買賣，客戶怎麼會接受這樣的系統呢。如果我們想要實現這個功能，就需要在資料庫裡做下修改，加一個i，讓每一個使用者上線i都是為1的，這樣就不會出現上述的問題。這樣在使用者餘額不足的時候就會讓他強制下機的。
下機流程圖：
之前的收費程式碼（有漏洞）：
Private Sub Timer2_Timer()
Dim unitTime As String
Dim leastTime As String
txtSQLBas = "select * from BasicData_Info"
Set mrcBas = ExecuteSQL(txtSQLBas, MsgText)
unitTime = mrcBas.Fields(2)
leastTime = mrcBas.Fields(3)
txtSQLon = "select * from Online_Info"
Set mrcon = ExecuteSQL(txtSQLon, MsgText)
'當online表沒有資料時直接跳出此過程
If mrcon.EOF = True Then
Exit Sub
End If
'到單位遞增時間扣一次錢，在準備時間不扣錢
Do While (mrcon.EOF = False)
mrcon.Fields(10) = Val(mrcon.Fields(10)) + 1
mrcon.Update
If i = Val(leastTime) + 1 Then
If Val(Trim(mrcon.Fields(11))) < Val(Trim(mrcBas.Fields(1))) Then
MsgBox "餘額不足，即將強制下機！", vbOKOnly + vbExclamation, "警告"
txtCardNo.Text = mrcon.Fields(0)
Call CmdDownLine_Click
Exit Sub
End If
Else
If Trim(mrcon.Fields(1)) = Trim("固定使用者") Then
mrcon.Fields(11) = Val(Trim(mrcon.Fields(11))) - Val(Trim(mrcBas.Fields(0)))
mrcon.Update
End If
If Trim(mrcon.Fields(1)) = Trim("臨時使用者") Then
mrcon.Fields(11) = Val(Trim(mrcon.Fields(11))) - Val(Trim(mrcBas.Fields(1)))
mrcon.Update
End If
i = i + 1
End If
Else
If i >= (Val(unitTime)) Then
i = 1
Else
i = i + 1
End If
End If
mrcon.MoveNext
Loop
End Sub計算消費時間程式碼：
Private Sub Timer2_Timer()
txtSQLon = "select * from Online_Info"
Set mrcon = ExecuteSQL(txtSQLon, MsgText)
'當online表沒有資料時直接跳出此過程
If mrcon.EOF = True Then
Exit Sub
End If
'執行一次，消費時間+1
Do While (mrcon.EOF = False)
mrcon.Fields(10) = Val(mrcon.Fields(10)) + 1
mrcon.Update
mrcon.MoveNext
Loop
End Sub下機程式碼：
'判斷卡號是否為空
If Not Testtxt(txtCardNo.Text) Then
MsgBox "請輸入要下機的卡號！", vbOKOnly + vbInformation, "提示"
txtCardNo.SetFocus
Exit Sub
End If
'判斷輸入的是否為數字
If Not IsNumeric(txtCardNo.Text) Then
MsgBox "卡號請輸入數字！", vbOKOnly + vbExclamation, "警告"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
'判斷是否註冊或使用
txtSQLStu = "select * from student_Info where cardno='" & Trim(txtCardNo.Text) & "'" & "and status='使用" & "'"
Set mrcStu = ExecuteSQL(txtSQLStu, MsgText)
If mrcStu.EOF = True Then
MsgBox "該卡未註冊或已經退卡，請輸入有效卡號！", vbOKOnly + vbExclamation, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else
txtSQLon = "select * from Online_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrcon = ExecuteSQL(txtSQLon, MsgText)
'判斷是否在上機
If mrcon.EOF = True Then
MsgBox "該卡沒有上機，請輸入正確的卡號！", vbOKOnly + vbExclamation, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else
txtSQLline = "select * from Line_Info where cardno='" & Trim(txtCardNo.Text) & "'and status='正常上機'"
Set mrcline = ExecuteSQL(txtSQLline, MsgText)
'計算消費金額
comsumeTime = mrcon.Fields(10)
'如果消費時間小於準備時間則不收錢，如果大於準備時間小於最短上機時間則半價，如果大於最短上機時間則正常收費
If Val(comsumeTime) <= Val(prepareTime) Then
mrcline.Fields(11) = "0"
Else
If Val(comsumeTime) < Val(leastTime) Then
If Trim(mrcon.Fields(1)) = Trim("固定使用者") Then
mrcline.Fields(11) = 0.5 * mrcBas.Fields(0)
Else
mrcline.Fields(11) = 0.5 * mrcBas.Fields(1)
End If
Else
If Val(comsumeTime) Mod Val(unitTime) = 0 Then
t = Int(comsumeTime / unitTime)
Else
t = Int(comsumeTime / unitTime) + 1
End If
If Trim(mrcon.Fields(1)) = Trim("固定使用者") Then
mrcline.Fields(11) = t * mrcBas.Fields(0)
Else
mrcline.Fields(11) = t * mrcBas.Fields(1)
End If
End If
End If
'將所有資料更新到line表裡
mrcline.Fields(8) = Trim(Date)
mrcline.Fields(9) = Trim(Time)
mrcline.Fields(10) = Trim(mrcon.Fields(10))
mrcline.Fields(12) = Trim(mrcStu.Fields(7) - mrcline.Fields(11))
mrcline.Fields(13) = "正常下機"
mrcline.Fields(14) = Trim(VBA.Environ("computername"))
mrcline.Update
mrcStu.Fields(7) = Trim(mrcline.Fields(11))
mrcStu.Update
'更新桌面的內容
txtType.Text = Trim(mrcon.Fields(1))
txtSID.Text = Trim(mrcon.Fields(2))
txtName.Text = Trim(mrcon.Fields(3))
txtDepart.Text = Trim(mrcon.Fields(4))
txtSex.Text = Trim(mrcon.Fields(5))
txtOnlineDate.Text = Trim(mrcon.Fields(6))
txtOnlineTime.Text = Trim(mrcon.Fields(7))
txtDownLineDate.Text = Trim(Date)
txtDownLineTime.Text = Trim(Time)
txtConsumeTime.Text = Trim(mrcline.Fields(10))
txtConsumeMoney.Text = Trim(mrcline.Fields(11))
txtBalance.Text = Trim(mrcline.Fields(12))
mrcon.Delete
mrcon.Close
mrcStu.Close
mrcline.Close
MsgBox "下機成功！", vbOKOnly, "恭喜"
txtCardNo.Text = ""
txtSID.Text = ""
txtDepart.Text = ""
txtType.Text = ""
txtName.Text = ""
txtSex.Text = ""
txtOnlineDate.Text = ""
txtOnlineTime.Text = ""
txtDownLineDate.Text = ""
txtDownLineTime.Text = ""
txtBalance.Text = ""
txtConsumeTime.Text = ""
txtConsumeMoney.Text = ""
End If
End If【總結】接觸一個新事物的時候首先要做的就是打敗自己的畏難心理，靜下心來慢慢分析不可急躁，否則一開始心煩就無法冷靜思考了。其實只要認真分析沒有什麼難的，要把自己的想法儘可能實現出來，如果覺得不合理就可以改正它，相信隨著我們的不斷成長我們做出的系統肯定會越來越完善的。