前言：所有软件一开始第一个功能都是登录，所以登录可以说是用户体验度非常重要的一个环节。假如：你的登录页面做的非常的不好看，而且用户登录的时间还长。这个会大大的影响到用户后面的功能体验，所以登录功能担任的非常重要的角色。
目录
界面：
获取计算机名称:：
'用于获得计算机名的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
