实现思路
大家在点原机房的时候,有没有发现,当一般用户登录的时候,它还可以上别人的卡号,查询别人的消费记录和余额,于是,我做了两个登录界面,右边界面是一般用户登录界面,一般用户用卡号登录,登录就是上机(需要调用上机代码),左边界面是管理者登录界面(操作员和管理员)。
登录流程图(一般用户和管理者)
一般用户代码展示(管理者类似)
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