VB版机房收费系统”登录“--02
【摘要】
前言：所有软件一开始第一个功能都是登录，所以登录可以说是用户体验度非常重要的一个环节。假如：你的登录页面做的非常的不好看，而且用户登录的时间还长。这个会大大的影响到用户后面的功能体验，所以登录功能担任的非常重要的角色。
目录
界面：
流程图：
功能代码：
模块：
获取计算机名称:：
权限声明：
程序入口：
...
前言：所有软件一开始第一个功能都是登录，所以登录可以说是用户体验度非常重要的一个环节。假如：你的登录页面做的非常的不好看，而且用户登录的时间还长。这个会大大的影响到用户后面的功能体验，所以登录功能担任的非常重要的角色。
目录
界面：
流程图：
功能代码：
模块：
获取计算机名称:：
-
'用于获得计算机名的api函数
-
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal
-
lpBuffer As String, nSize As Long) As Long '用于获取计算机名
-
Function ComputerName() As String '定义获取当前计算机名的函数
-
Dim CoName As String
-
CoName = String(255, Chr$(0))
-
GetComputerName CoName, 255
-
CoName = Left(CoName, InStr(1, CoName, Chr$(0)) - 1)
-
ComputerName = CoName
-
End Function
权限声明：
Public Userlevel As String '获取用户等级，方便做权限的判断。
程序入口：
-
Sub Main() '程序进口显示登录窗体
-
Dim fLogin As New forlogin '定义窗体对象
-
forlogin.Show vbModal '显示登录窗体实例
-
End Sub
窗体：
登录窗体：
-
通用声明
-
Dim miCount As Integer '记录登录次数
-
Private Sub cmddetermine_Click()
-
'用于连接数据库，进行查询使用。
-
Dim txtSQL As String
-
Dim mrc As ADODB.Recordset '连接数据库
-
Dim Msgtext As String
-
'初始化全局变量
-
UserName = "" '储存全局用户
-
UserPWD = "" '储存密码
-
Userlevel = "" '储存等级
-
'判断用户名是否为空
-
If txtname.Text = "" Then
-
MsgBox "请输入用户名！", vbOKCancel + vbExclamation, "警告"
-
txtname.SetFocus '获取焦点
-
Else
-
txtSQL = "select * from user_Info where userID=' " & txtname.Text & "'" '根据条件查询
-
Set mrc = ExecuteSQL(txtSQL, Msgtext) '执行txtsql
-
'判断用户是否存在
-
If mrc.EOF = True Then
-
MsgBox "用户不存在，请从新输入！", vbOKOnly + vbExclamation, "警告"
-
txtname.Text = "" '清空
-
txtname.SetFocus '获取焦点
-
Else
-
'账号是否已经登录
-
Dim onworksql As String '存储SQL语句
-
Dim onwormrc As ADODB.Recordset '数据集
-
Dim onmsgtext As String '记录信息
-
onworksql = "select * from onwork_Info where userID='" & txtname.Text & "'" '获取正在上级表
-
Set onwormrc = ExecuteSQL(onworksql, onmsgtext) '执行SQL语句
-
-
'判断用户是否已经登录
-
If Trim(onwormrc.EOF = False) Then '如果已经登录
-
MsgBox "此账号已经登录，请从新输入！", vbOKOnly + vbExclamation, "警告"
-
txtname.Text = ""
-
txtname.SetFocus
-
Else '如果没有登录
-
'判断密码是否正确
-
If Trim(mrc.Fields(1)) = Trim(txtpwd.Text) Then
-
'跟全局变量赋值
-
UserName = Trim(txtname.Text)
-
UserPWD = Trim(txtpwd.Text)
-
Userlevel = Trim(mrc.Fields(2)) '等级赋值
-
mrc.Close '关闭数据集
-
Unload forlogin
-
formmain.Show
-
Else
-
MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbExclamation, "警告"
-
txtpwd.SetFocus
-
txtpwd.Text = ""
-
End If
-
End If
-
End If
-
End If
-
'记载输入密码次数
-
miCount = miCount + 1
-
If miCount > 3 Then
-
MsgBox "已经是最后一次机会了！", vbOKOnly + vbExclamation, "警告"
-
End '退出登录
-
End If
-
-
Exit Sub '退出过程
-
End Sub
主窗体：
调用：在窗体加载事件调用
-
Private Sub MDIForm_Load()
-
Call level '调用判断等级过程，实现判断不同用户级别。
-
End Sub
权限判断：
-
'权限判断和更新值班表与工作记录表
-
Private Sub level()
-
'等级判断
-
If Trim(Userlevel = "管理员") Then
-
'所有功能都可以使用
-
Me.generaluser.Enabled = True
-
Me.operator.Enabled = True
-
Me.adminsitrator.Enabled = True
-
Call onupdate '更新表
-
ElseIf Trim(Userlevel = "操作员") Then
-
'只有一般用户和操作员功能可用
-
Me.generaluser.Enabled = True
-
Me.operator.Enabled = True
-
Me.adminsitrator.Enabled = False
-
Call onupdate '更新表
-
Else
-
'只有一般用户可用
-
Me.generaluser.Enabled = True
-
Me.operator.Enabled = False
-
Me.adminsitrator.Enabled = False
-
End If
-
End Sub
数据库更新：
-
'更新正在上机表和上机记录表
-
Private Sub onupdate()
-
'更新值班表
-
Dim onworksql As String
-
Dim onworkmrc As ADODB.Recordset
-
Dim onmsgtext As String
-
onworksql = "select * from onwork_Info" '查询值班表
-
Set onworkmrc = ExecuteSQL(onworksql, onmsgtext) '执行sql
-
onworkmrc.AddNew '添加记录
-
onworkmrc.Fields(0) = Trim(UserName) '用户id
-
onworkmrc.Fields(1) = Trim(Userlevel) '用户等级
-
onworkmrc.Fields(2) = Trim(Date) '登录日期
-
onworkmrc.Fields(3) = Trim(Time) '登录时间
-
onworkmrc.Fields(4) = Trim(ComputerName) '计算机名
-
onworkmrc.Update '更新
-
onworkmrc.Close '关闭
-
'更新工作记录
-
Dim worksql As String
-
Dim workmrc As ADODB.Recordset
-
Dim workmsgtext As String
-
worksql = "select * from worklog_Info" '获取工作记录表
-
Set workmrc = ExecuteSQL(worksql, workmsgtext) '执行sql
-
workmrc.AddNew '添加记录
-
workmrc.Fields(1) = Trim(UserName) '用户id
-
workmrc.Fields(2) = Trim(Userlevel) '用户级别
-
workmrc.Fields(3) = Trim(Date) '登录日期
-
workmrc.Fields(4) = Trim(Time) '登录时间
-
workmrc.Fields(7) = Trim(ComputerName) '计算机名
-
workmrc.Fields(8) = Trim("True") '状态
-
workmrc.Update '更新
-
workmrc.Close '关闭数据集
-
End Sub
文章来源: kangshihang.blog.csdn.net，作者：康世行，版权归原作者所有，如需转载，请联系作者。
原文链接：kangshihang.blog.csdn.net/article/details/100730767
【版权声明】本文为华为云社区用户转载文章，如果您发现本社区中有涉嫌抄袭的内容，欢迎发送邮件进行举报，并提供相关证据，一经查实，本社区将立刻删除涉嫌侵权内容，举报邮箱：
cloudbbs@huaweicloud.com
- 点赞
- 收藏
- 关注作者
评论（0）