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