【第一次機房】機房收費系統——上機

上機是機房收費系統中非常重要的一個功能，也是最先需要實現的功能呢，以上是上機的流程圖

Private Sub cmdOnLine_Click()
    Dim startime As String
    Dim mrc As ADODB.Recordset     '連接student表中的
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc1 As ADODB.Recordset  '連接online表中的
    Dim mrc2 As ADODB.Recordset  '連接line表中的
    
    '檢查卡號是否存在
    txtSQL = "select * from student_Info where cardno= '" & txtCardNo.Text & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    If mrc.EOF Then
        MsgBox "沒有這個卡號，請重新輸入！", vbOKOnly + vbExclamation, "警告"
        txtCardNo.Text = ""
        mrc.Close
        txtCardNo.SetFocus
    Else
        If Trim(mrc.Fields(10)) = "不使用" Then
            MsgBox "沒有此卡號"
        Else
            If Trim(Val(mrc.Fields(7))) <= 0 Then
            MsgBox "餘額不足，請充值"
            txtCardNo.Text = ""
                 txtName.Text = ""
                 txtSex.Text = ""
                 txtSID.Text = ""
                 txtDept.Text = ""
                 txtType.Text = ""
                 txtOffDate.Text = ""
                 txtOnTime.Text = ""
                 txtOnDate.Text = ""
                 txtOffTime.Text = ""
                 txtCTime.Text = ""
                 txtCMoney.Text = ""
            Else
            
                '點擊上機，下機時間和日期，消費時間和金額文本框中數據清空
                txtOnDate.Text = ""
                txtOnTime.Text = ""
                txtCTime.Text = ""
                txtCMoney.Text = ""
                
                '檢查上機是否重複
                txtSQL = "select * from Online_Info where cardno = '" & txtCardNo.Text & "'"
                Set mrc1 = ExecuteSQL(txtSQL, MsgText)
                
                If mrc1.EOF Then
                    '從student表中向各個文本框中添加上機的數據
                    
                    mrc.Update
                        txtSID.Text = mrc.Fields(1)
                        txtName.Text = mrc.Fields(2)
                        txtSex.Text = mrc.Fields(3)
                        txtDept.Text = mrc.Fields(4)
                        txtBalance.Text = mrc.Fields(7)
                        txtType.Text = mrc.Fields(14)
                    
                    mrc.Close
                    
                    '如果沒有查到數據，那麼創建一個新行，添加各個數據
                    mrc1.AddNew
                        mrc1.Fields(0) = Trim(txtCardNo.Text)
                        mrc1.Fields(1) = Trim(txtType.Text)
                        mrc1.Fields(2) = Trim(txtSID.Text)
                        mrc1.Fields(3) = Trim(txtName.Text)
                        mrc1.Fields(4) = Trim(txtDept.Text)
                        mrc1.Fields(5) = Trim(txtSex.Text)
                        mrc1.Fields(6) = Date
                        mrc1.Fields(7) = Time
                        mrc1.Fields(8) = VBA.Environ("computername")
                        
                    startime = Now  '獲得系統時間
                    txtOnDate.Text = Format(startime, "yyyy/mm/dd")
                    txtOnTime.Text = Format(startime, "hh:mm:ss") '使用格式函數顯示格式
                    mrc1.Update
                    
                    '刷新line表中的數據
                    txtSQL = "select * from Line_Info where cardno = '" & txtCardNo.Text & "'"
                    Set mrc2 = ExecuteSQL(txtSQL, MsgText)
                    
                    mrc2.AddNew
                    mrc2.Fields(1) = Trim(txtCardNo.Text)
                    mrc2.Fields(13) = "正常下機"
                    
                    mrc2.Fields(2) = Trim(txtSID.Text)
                    mrc2.Fields(3) = Trim(txtName.Text)
                    mrc2.Fields(4) = Trim(txtDept.Text)
                    mrc2.Fields(5) = Trim(txtSex.Text)
                    mrc2.Fields(6) = Date
                    mrc2.Fields(7) = Time
                    mrc2.Fields(14) = VBA.Environ("computername")
                    
                    mrc2.Update
                    
                    MsgBox "上機成功", vbOKOnly + vbExclamation, "登錄成功"
                Else
                    MsgBox "此用戶正在上機"
                End If
            End If
        End If
    End If
End Sub

以上是代碼部分，供大家參考