机房收费系统之登录窗体（一般用户和操作员）

实现思路

大家在点原机房的时候，有没有发现，当一般用户登录的时候，它还可以上别人的卡号，查询别人的消费记录和余额，于是，我做了两个登录界面，右边界面是一般用户登录界面，一般用户用卡号登录，登录就是上机（需要调用上机代码），左边界面是管理者登录界面（操作员和管理员）。

登录流程图（一般用户和管理者）

一般用户代码展示（管理者类似）

Private Sub cmdok_Click()
    Dim mrc As adodb.Recordset
    Dim txtsql As String
    Dim msgtext As String
    Dim frmlogin As Boolean
    
    '判断用户名和密码输入是否为空
    If testtxt(txtusername.Text) = False Then
        MsgBox "用户名不能为空，请输入用户名！", 0 + 48, 提示
        txtusername.SetFocus
        Exit Sub
    End If
    
    If testtxt(txtpwd.Text) = False Then
        MsgBox "密码不能为空，请输入密码！", 0 + 48, 提示
        txtpwd.SetFocus
        Exit Sub
    End If

   '从card表中查询
    txtsql = "select * from card_info where cardno='" & Trim(txtusername.Text) & "' and status='使用'"
    Set mrc = ExecuteSQL(txtsql, msgtext)
    
    '判断用户名和密码输入是否正确
    If mrc.EOF And mrc.BOF Then
        MsgBox "用户名不正确，请重新输入，还剩余" & (2 - a) & "次机会 ！", 0 + 48, 提示
        txtusername.Text = ""
        txtpwd.Text = ""
        txtusername.SetFocus
        frmlogin = False
        a = a + 1
        '判断登陆次数
        If a > 2 Then
            MsgBox "登陆次数过多，将退出程序！", 0 + 48, 提示
            End
        End If
        Exit Sub
    Else
        '判断密码是否正确
        If Trim(mrc!pwd) = Trim(txtpwd.Text) Then
            '登录名和密码正确，登录主窗体
            username = Trim(txtusername.Text)
            frmlogin = True
            a = 0
            '登录成功，调用上机代码
            Call online(username)
        Else
            MsgBox "密码不正确，请重新输入,还剩余" & (2 - a) & "次机会 ！", 0 + 48, 提示
            txtpwd.Text = ""
            txtpwd.SetFocus
            frmlogin = False
            a = a + 1
            '判断登陆次数
            If a > 2 Then
                MsgBox "登陆次数过多，将退出程序！", 0 + 48, 提示
                End
            End If
            Exit Sub
        End If
    End If
End Sub

一般用户登录即上机（上机代码我写到了模块当中，然后在一般用户登录的时候调用）

上机流程图

模块当中的上机代码

'上机
Public Function online(username As String)
    Dim mrc As adodb.Recordset
    Dim mrcbasic As adodb.Recordset
    Dim cardmrc As adodb.Recordset
    Dim txtsql, msgtext As String
    Dim d As Date
    Dim a As Integer
    '获取当前计算机名称
    c = VBA.Environ("computername")

    '查询卡里面的最低金额
    txtsql = "select * from basicdata_info"
    Set mrcbasic = ExecuteSQL(txtsql, msgtext)

    '查询该卡的余额
    txtsql = "select * from card_info where cardno='" & username & "'"
    Set cardmrc = ExecuteSQL(txtsql, msgtext)
   
    '判断卡里面的金额是否低于最低消费金额
    If mrcbasic!limitcash < cardmrc!cash Then
        
        '判断该卡是否正在上机
        txtsql = "select * from line_info where cardno='" & username & "'and status='上机中'"
        Set mrc = ExecuteSQL(txtsql, msgtext)
        
        If mrc.EOF = True And mrc.BOF = True Then
            '数据插入到上下机表中
            txtsql = "insert into line_info (cardno,cardtype,studentno,computer) values ('" & username & "','" & cardmrc!Type _
            & "','" & cardmrc!studentno & "','" & c & "')"
            Set mrc = ExecuteSQL(txtsql, msgtext)
           
            '显示上机时间
            frmcommonuser.txtonlinedate.Text = Now()
            frmcommonuser.Show

            '显示卡号信息
            frmcommonuser.txtcardno.Text = username
            frmcommonuser.txttype.Text = cardmrc!Type
            frmcommonuser.txtsno.Text = cardmrc!studentno
        
            txtsql = "select * from student_info where studentno='" & cardmrc!studentno & "'"
            Set mrc = ExecuteSQL(txtsql, msgtext)
        
            '显示学生信息
            frmcommonuser.txtsex.Text = mrc!sex
            frmcommonuser.txtdepartment.Text = mrc!department
            frmcommonuser.txtname.Text = mrc!studentname
            Exit Function
        Else
            MsgBox "此卡正在上机，请不要重复上机！", 0 + 48, 提示
            flogin.Show
            Exit Function
        End If
    Else
        MsgBox "卡内余额不足，请先充值!", 0 + 48, 提示
        Exit Function
    End If

End Function