机房上机,细心很重要

机房上下机是一个非常重要的功能,敲窗体之前一定要先搞请上下机逻辑关系,其次就是要把限定的条件想周到这样操作起来就容易多了。
上机,就是将以注册的,在用的,金额充足等符合上机要求的卡号进行上机。
上机流程图
在这里插入图片描述
一定要搞清楚上机的要求是什么?和那几个表相联系?在敲代码
上机部分展示

Private Sub Command1_Click()
    '卡号是否为空
    If txtCardNo = "" Then
        MsgBox "请输入卡号!", 48, "提示"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If
    
     '判断卡号是否为数字
        If Not IsNumeric(Trim(txtCardNo.Text)) Then
            
            MsgBox "请输入数字!", 48, "提示"
            txtCardNo.SetFocus
            txtCardNo.Text = ""
            Exit Sub
        End If
        
        '判断卡号是否注册
        txtsql = "select * from student_info where cardno ='" & txtCardNo.Text & "'"
        Set mrc = ExecuteSQL(txtsql, msgtext)
        If mrc.EOF = True Then
            MsgBox "此卡号尚未注册!", 48, "提示"
            txtCardNo.Text = ""
            txtCardNo.SetFocus
            Exit Sub
        Else
        
        '判断卡号是否注销
        If Trim(mrc.Fields(10)) = Trim("未使用") Then
            MsgBox "该卡已经注销", 48, "提示"
            txtCardNo.Text = ""
            txtCardNo.SetFocus
            Exit Sub
        Else
          
        '判断是否上机
        txtsql = "select * from online_info where cardno= '" & txtCardNo.Text & "'"
        Set mrc1 = ExecuteSQL(txtsql, msgtext)
                
        If mrc1.EOF = False Then
            MsgBox "该卡正在上机,不能重复上机!", 48, "提示"
            '显示该卡好的上机信息
            txtType.Text = mrc1!cardtype
            txtStudentNO.Text = mrc1!studentno
            txtDept.Text = mrc1!department
            txtName.Text = mrc1!studentname
            ComboSex.Text = mrc1!sex
            txtonDate.Text = mrc1!ondate
            txtonTime.Text = mrc1!ontime
            txtsql = "select * from student_info where cardno='" & txtCardNo.Text & "'"
            Set mrc = ExecuteSQL(txtsql, msgtext)
            txtBalance.Text = mrc!cash
            '下机日期和时间要空着
            txtoffDate.Text = ""
            txtoffTime.Text = ""
            costTime.Text = ""
            costMoney.Text = ""
            mrc.Update
            mrc.Close
            Exit Sub
        Else
        
        '若该卡没有上机,则显示上机信息
        txtsql = "select * from student_info where cardno= '" & Trim(txtCardNo.Text) & "'"
        Set mrc = ExecuteSQL(txtsql, msgtext)
            If mrc.EOF = False Then
                txtType.Text = mrc!Type
                txtStudentNO.Text = mrc!studentno
                txtDept.Text = mrc!department
                txtName.Text = mrc!studentname
                ComboSex.Text = mrc!sex
                txtonDate.Text = Date
                txtBalance.Text = mrc!cash
            '获取系统时间
            txtonTime.Text = Format(DateTime.Time, "hh:mm:ss")
            txtBalance.Text = mrc!cash
            End If
        End If
    End If
End If
        
                    
        '判断余额是否小于最小金额,如需要充值在上机,强制下机
        
        txtsql = "select * from student_Info where cardno = '" & txtCardNo.Text & "'"
        Set mrc = ExecuteSQL(txtsql, msgtext)
        
        txtsql = "select * from basicdata_info "
        Set mrc4 = ExecuteSQL(txtsql, msgtext)
        If Val(mrc.Fields(7)) < Val(mrc4.Fields(5)) Then
            MsgBox "余额小于最小限制金额,请充值后再上机!", 48, "提示"
            
            txtCardNo.Text = ""
            txtStudentNO.Text = ""
            txtDept.Text = ""
            txtType.Text = ""
            txtName.Text = ""
            ComboSex.Text = ""
            txtonDate.Text = ""
            txtonTime.Text = ""
            txtBalance.Text = ""
            txtCardNo.SetFocus
            Exit Sub
        End If
                        
                    
        '更新online表
        txtsql = "select * from OnLine_info"
        Set mrc1 = ExecuteSQL(txtsql, msgtext)
            mrc1.AddNew
            mrc1!cardno = txtCardNo.Text
            mrc1!studentno = txtStudentNO.Text
            mrc1!department = txtDept.Text
            mrc1!cardtype = txtType.Text
            mrc1!studentname = txtName.Text
            mrc1!sex = ComboSex.Text
            mrc1!ondate = txtonDate.Text
            mrc1!ontime = txtonTime.Text
            mrc1!computer = Trim(VBA.Environ("computername"))
            mrc1!Date = Date
                    
            mrc1.Update
            mrc1.Close
                    
        '更新line表
        txtsql = "select * from Line_info where cardno = '" & txtCardNo.Text & "'"
        Set mrc2 = ExecuteSQL(txtsql, msgtext)
            mrc2.AddNew
            mrc2!cardno = txtCardNo.Text
            mrc2!studentno = txtStudentNO.Text
            mrc2!department = txtDept.Text
            mrc2!studentname = txtName.Text
            mrc2!sex = ComboSex.Text
            mrc2!ondate = txtonDate.Text
            mrc2!ontime = txtonTime.Text
            mrc2!cash = txtBalance.Text
            mrc2!Status = "正常上机"
            mrc2!computer = Trim(VBA.Environ("computername"))
                    
            mrc2.Update
            mrc2.Close
                    
        '更新上机人数
        txtsql = "select count(*) from OnLine_info "
        Set mrc1 = ExecuteSQL(txtsql, msgtext)
            lblpeople.Caption = Trim(mrc1.Fields(0))
        '更新临时用户数
        txtsql = "select count(*) from OnLine_info where cardtype='临时用户 '"
        Set mrc1 = ExecuteSQL(txtsql, msgtext)
            lblplain.Caption = Trim(mrc1.Fields(0))
        '更新固定用户数
        txtsql = "select count(*) from OnLine_info where cardtype='固定用户 '"
        Set mrc1 = ExecuteSQL(txtsql, msgtext)
            lblmember.Caption = Trim(mrc1.Fields(0))
        
            mrc1.Close
                    
            MsgBox "上机成功!", 48, "提示"
                
        
End Sub

上机相对还是蛮简单的,上机成功后一定要及时更新上机记录表,正在上机表
后期陆续更新,欢迎评论区留言!

猜你喜欢

转载自blog.csdn.net/qq_42758288/article/details/85101459