第一次机房收费——上机流程

Private Sub cmdOnline_Click()
    Dim mrc As ADODB.Recordset '连接学生表
    Dim mrc1 As ADODB.Recordset '连接上线表
    Dim mrc2 As ADODB.Recordset '连接基础表
    Dim mrc3 As ADODB.Recordset '连接line表
    Dim txtSQL As String
    Dim MsgText As String
    If txtCardNo.Text = "" Then '判断是否输入卡号
        MsgBox "请输入卡号", vbOKOnly + vbExclamation, "提示"
        txtCardNo.SetFocus
        Exit Sub
    End If
    If Not IsNumeric(Trim(txtCardNo.Text)) Then '判断卡号是否为数字形式
        MsgBox "请输入正确的卡号！", vbOKOnly + vbExclamation, "提示"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If
    txtSQL = "select * from student_info where cardno='" & txtCardNo.Text & "' and status='使用'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = True Then
        MsgBox "无此卡号，请核对后再重新输入", vbOKOnly + vbExclamation, "提示" '判断卡号是否已注册
        txtCardNo.Text = ""
        txtCardNo.SetFocus
    Else
        txtSQL = "select * from Online_info where cardno='" & txtCardNo.Text & "'"
        Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = False Then '判断卡号是否登录
        MsgBox "此卡号已登录，请勿重复登录！", vbOKOnly + vbExclamation, "提示"
        txtOnDate.Text = mrc1.Fields(6)
        txtOnTime.Text = mrc1.Fields(7)
    Else
        txtSQL = "select * from  BasicData_info"
        Set mrc2 = ExecuteSQL(txtSQL, MsgText)
        If Val(mrc.Fields(7)) < Val(mrc2.Fields(5)) Then  '判断余额是否充足
            MsgBox "余额不足，无法登录，请充值", vbOKOnly + vbExclamation, "提示"
            frmRecharge.Show                              '充值窗口显示
        Else
            '显示主窗体的信息
            txtCardNo.Text = Trim(mrc.Fields(0)) 'trim（）函数是用来去掉字符串前面和后面的空格
            txtSID.Text = Trim(mrc.Fields(1))
            txtDept.Text = Trim(mrc.Fields(4))
            txtType.Text = Trim(mrc.Fields(14))
            txtName.Text = Trim(mrc.Fields(2))
            txtSex.Text = Trim(mrc.Fields(3))
            txtOnDate.Text = Date
            txtOnTime.Text = Time
            txtBalance.Text = Trim(mrc.Fields(7))
            mrc.Update
            mrc.Close
            '数据更新到Online表中
            txtSQL = "select * from Online_info"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            mrc.AddNew '添加新纪录
            mrc.Fields(0) = Trim(txtCardNo.Text)
            mrc.Fields(1) = Trim(txtType.Text)
            mrc.Fields(2) = Trim(txtSID.Text)
            mrc.Fields(3) = Trim(txtName.Text)
            mrc.Fields(4) = Trim(txtDept.Text)
            mrc.Fields(5) = Trim(txtSex.Text)
            mrc.Fields(6) = Trim(txtOnDate.Text)
            mrc.Fields(7) = Trim(txtOnTime.Text)
            mrc.Fields(8) = VBA.Environ("computername")
            mrc.Fields(9) = Now
            '查询上机人数并更新
            Label16.Caption = "当前上机人数为：" & mrc.RecordCount & "人"
            mrc.Update
            mrc.Close
            txtSQL = "select * from Line_info"
            Set mrc3 = ExecuteSQL(txtSQL, MsgText)
            mrc3.Fields(1) = Trim(txtCardNo.Text)
            mrc3.Fields(2) = Trim(txtSID.Text)
            mrc3.Fields(3) = Trim(txtName.Text)
            mrc3.Fields(4) = Trim(txtDept.Text)
            mrc3.Fields(5) = Trim(txtSex.Text)
            mrc3.Fields(6) = Trim(txtOnDate.Text)
            mrc3.Fields(7) = Trim(txtOnTime.Text)
            mrc3.Fields(12) = Trim(txtBalance.Text)
            mrc3.Fields(13) = "正常上机"
            mrc3.Fields(14) = VBA.Environ("computername")
            mrc3.Update
            mrc3.Close
            MsgBox "上机完成！", vbOKOnly + vbExclamation, "提示"
        End If
    End If
End If
End Sub