機房收費系統（二）-上下機
阿新 • • 發佈：2018-11-29
【前言】
開始做機房時間也不短了，也看了不少大佬的部落格，但是真的是每個人有每個人的思路，所以我也有了自己的思路。剛開始的時候沒有什麼思路，不知道如何下手，只有靜下心來，一點點往下走，才能理清自己的思路。有些地方可能還存在不足，望指點。
【內容】
上機和下機導圖
上機程式碼
Private Sub cmdOnLine_Click() Dim MsgText As String Dim Stusql As String Dim OnLinesql As String Dim Linesql As String Dim BasicDatasql As String Dim mrcStu As ADODB.Recordset Dim mrcOnLine As ADODB.Recordset Dim mrcLine As ADODB.Recordset Dim mrcBasicData As ADODB.Recordset '判斷卡號是否為空 If txtCardNo.Text = "" Then MsgBox "卡號不能為空，請輸入卡號！", 48, "警告" txtCardNo.SetFocus Exit Sub End If '判斷卡號是否為數字 If Not IsNumeric(Trim(txtCardNo.Text)) Then MsgBox "請輸入數字！", vbOKOnly + vbExclamation, "警告" txtCardNo.Text = "" txtCardNo.SetFocus Exit Sub End If '判斷該卡號是否已註冊 Stusql = "select * from student_Info where cardno= '" & Trim(txtCardNo.Text) & "'" Set mrcStu = ExecuteSQL(Stusql, MsgText) If mrcStu.EOF = True Then MsgBox "該卡號不存在，請註冊！", 48, "警告" txtCardNo.Text = "" txtCardNo.SetFocus Exit Sub Else '判斷卡號是否退卡 If mrcStu.EOF Then MsgBox "此卡已經退卡", vbOKOnly + vbExclamation, "提示" txtCardNo.Text = "" txtCardNo.SetFocus Exit Sub End If End If '判斷餘額是否充足 BasicDatasql = "select * from BasicData_Info" Set mrcBasicData = ExecuteSQL(BasicDatasql, MsgText) If mrcStu.Fields(7) < mrcBasicData.Fields(5) Then MsgBox "餘額不足，請先充值再上機！", 48, "提示" Exit Sub End If '判斷該卡號是否正在上機 OnLinesql = "select * from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'" Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText) If mrcOnLine.EOF = False Then MsgBox "該卡正在上機，不能重複上機！", 64, "提示" Exit Sub End If '呼叫學生資訊到輸入框 txtCardNo.Text = mrcStu.Fields(0) txtType.Text = mrcStu.Fields(14) txtSID.Text = mrcStu.Fields(1) txtName.Text = mrcStu.Fields(2) txtDept.Text = mrcStu.Fields(4) comboSex.Text = mrcStu.Fields(3) txtCash.Text = mrcStu.Fields(7) txtOnDate.Text = Date txtOnTime.Text = Time txtOffDate.Text = "" txtOffTime.Text = "" txtCMoney.Text = "" txtCTime = "" '上機時將上機卡的資料同步至online_info表中 Set mrcOnLine = New ADODB.Recordset OnLinesql = "select * from OnLine_info" Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText) mrcOnLine.AddNew mrcOnLine.Fields(0) = Trim(txtCardNo.Text) mrcOnLine.Fields(1) = Trim(txtType.Text) mrcOnLine.Fields(2) = Trim(txtSID.Text) mrcOnLine.Fields(3) = Trim(txtName.Text) mrcOnLine.Fields(4) = Trim(txtDept.Text) mrcOnLine.Fields(5) = Trim(comboSex.Text) mrcOnLine.Fields(6) = Trim(txtOnDate.Text) mrcOnLine.Fields(7) = Trim(txtOnTime.Text) mrcOnLine.Fields(8) = Trim(VBA.Environ("computername")) '將計算機名同步到資料庫的相應表格中 lblAmount.Caption = mrcOnLine.RecordCount + 1 '顯示上機人數 mrcOnLine.Update mrcOnLine.Close '上機時將上機卡的資料同步到line_info表中 Set mrcLine = New ADODB.Recordset Linesql = "select * from line_info" Set mrcLine = ExecuteSQL(Linesql, 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(txtDept.Text) mrcLine.Fields(5) = Trim(comboSex.Text) mrcLine.Fields(6) = Trim(txtOnDate.Text) mrcLine.Fields(7) = Trim(txtOnTime.Text) mrcLine.Fields(13) = "正常上機" mrcLine.Fields(14) = Trim(VBA.Environ("computername")) mrcLine.Update mrcLine.Close MsgBox "上機成功！", 64, "提示" '顯示正在上機的人數 OnLinesql = "select * from OnLine_Info" Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText) If mrcOnLine.EOF = True Then lblAmount.Caption = 0 Else lblAmount.Caption = mrcOnLine.RecordCount End If End Sub
下機程式碼
Private Sub cmdOffLine_Click() Dim MsgText As String Dim StuSQL As String Dim OnLineSQL As String Dim BasicDataSQL As String Dim LineSQL As String Dim mrcStu As ADODB.Recordset Dim mrcOnLine As ADODB.Recordset Dim mrcBasicData As ADODB.Recordset Dim mrcLine As ADODB.Recordset '判斷卡號是否為空 If Trim(txtCardNo.Text = "") Then MsgBox "請輸入卡號！", vbOKOnly + vbInformation, "溫馨提示" txtCardNo.SetFocus Exit Sub End If '判斷卡號是否為數字 If Not IsNumeric(txtCardNo.Text) Then MsgBox "請輸入數字！", vbOKOnly + vbInformation, "溫馨提示" txtCardNo.Text = "" txtCardNo.SetFocus Exit Sub End If '判斷卡號是否存在 StuSQL = "select * from student_info where cardno='" & txtCardNo.Text & "'" Set mrcStu = ExecuteSQL(StuSQL, MsgText) If mrcStu.EOF = True Then MsgBox "您輸入的卡號還未註冊，請先註冊！", 48, "警告" txtCardNo.Text = "" txtCardNo.SetFocus Exit Sub End If '判斷該卡是否正在上機 OnLineSQL = "select * from OnLine_info where cardno='" & txtCardNo.Text & "'" Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText) If mrcOnLine.EOF = True Then MsgBox "該卡未上機，請先上機再下機！", 48, "警告" txtCardNo.Text = "" txtCardNo.SetFocus Exit Sub Else txtCardNo.Text = mrcOnLine.Fields(0) txtType.Text = mrcOnLine.Fields(1) txtSID.Text = mrcOnLine.Fields(2) txtName.Text = mrcOnLine.Fields(3) txtDept.Text = mrcOnLine.Fields(4) comboSex.Text = mrcOnLine.Fields(5) txtOnDate.Text = mrcOnLine.Fields(6) txtOnTime.Text = mrcOnLine.Fields(7) txtOffTime.Text = Time txtOffDate.Text = Format(Date, "yyyy-mm-dd") '線上時長計算 linetime = (Date - DateValue(mrcOnLine!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrcOnLine!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrcOnLine!OnTime))) '時間單位為分鐘 '計算消費金額;消費時間小於準備時間，則消費金額為0 BasicDataSQL = "select * from basicdata_info " Set mrcBasicData = ExecuteSQL(BasicDataSQL, MsgText) If Trim(linetime) <= Val(mrcBasicData.Fields(4)) Then txtCMoney.Text = 0 txtCTime.Text = 0 Else consumetime = Val(linetime) - Val(mrcBasicData.Fields(4)) txtCTime.Text = linetime If Trim(txtType.Text) = "固定使用者" Then txtCMoney.Text = Format(consumetime / mrcBasicData.Fields(2) * mrcBasicData.Fields(0), "0.00") Else txtCMoney.Text = Format(consumetime / mrcBasicData.Fields(2) * mrcBasicData.Fields(1), "0.00") End If End If '計算餘額 txtCash.Text = Val(mrcStu.Fields(7)) - Val(Trim(txtCMoney.Text)) '將餘額更新到student表中 mrcStu.Fields(7) = Val(Trim(txtCash.Text)) mrcStu.Update mrcStu.Close End If '刪除line表中上機的資訊 LineSQL = "select * from line_info where cardno='" & txtCardNo.Text & "'" Set mrcLine = ExecuteSQL(LineSQL, MsgText) mrcLine.Delete mrcLine.Update mrcLine.Close '更新Line表 LineSQL = "select * from line_info where cardno='" & txtCardNo.Text & "'" Set mrcLine = ExecuteSQL(LineSQL, MsgText) With mrcLine .AddNew .Fields(1) = Trim(txtCardNo.Text) .Fields(2) = Trim(txtSID.Text) .Fields(3) = Trim(txtName.Text) .Fields(4) = Trim(txtDept.Text) .Fields(5) = Trim(comboSex.Text) .Fields(6) = mrcOnLine!ondate .Fields(7) = mrcOnLine!OnTime !COMPUTER = VBA.Environ("computername") !offdate = Trim(txtOffDate.Text) !offtime = Trim(txtOffTime.Text) !consumetime = Trim(txtCTime.Text) !consume = Trim(txtCMoney.Text) !cash = Trim(txtCash.Text) & "" !Status = "正常下機" .Update .Close End With '更新online表 mrcOnLine.Delete mrcOnLine.Update mrcOnLine.Close '顯示正在上機的人數 OnLineSQL = "select * from OnLine_Info" Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText) If mrcOnLine.EOF = True Then lblAmount.Caption = 0 Else lblAmount.Caption = mrcOnLine.RecordCount End If End Sub