【第一次机房】机房收费系统——上机

上机是机房收费系统中非常重要的一个功能，也是最先需要实现的功能呢，以上是上机的流程图

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

以上是代码部分，供大家参考