frmsyslogon.frm

这是一个在某本书上获得的一个小区物业管理系统

VERSION 5.00
Begin VB.Form SystemLogon 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "用户登录"
   ClientHeight    =   1965
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4050
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   1965
   ScaleWidth      =   4050
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   300
      Left            =   2280
      TabIndex        =   5
      Top             =   1440
      Width           =   735
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   300
      Left            =   960
      TabIndex        =   4
      Top             =   1440
      Width           =   735
   End
   Begin VB.TextBox txtLog 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Index           =   1
      Left            =   1320
      MaxLength       =   6
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   840
      Width           =   1815
   End
   Begin VB.TextBox txtLog 
      Height          =   270
      Index           =   0
      Left            =   1320
      MaxLength       =   15
      TabIndex        =   2
      Top             =   240
      Width           =   1815
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "口  令"
      Height          =   180
      Left            =   600
      TabIndex        =   1
      Top             =   930
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "用户名"
      Height          =   180
      Left            =   600
      TabIndex        =   0
      Top             =   330
      Width           =   540
   End
End
Attribute VB_Name = "SystemLogon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Const MaxLogTimes As Integer = 3    '定义允许用户验证登录信息的最大次数

Private Sub cmdCancel_Click()
    '请求用户确认是否真的退出系统登录
    If MsgBox("你选择了退出系统登录，退出将不能启动管理系统！" & vbCrLf _
              & "是否真的退出？", vbYesNo, "登录验证") = vbYes Then
        Unload Me               '卸载登录窗体
    End If
End Sub

Private Sub cmdOk_Click()
    '静态常量intLogTimes用于保存用户请求验证的次数
    Static intLogTimes As Integer
    intLogTimes = intLogTimes + 1     '保存登录次数
    If intLogTimes > MaxLogTimes Then
        '超过允许的登录次数，显示提示信息
        MsgBox "你已经超过允许的登录验证次数！" & vbCr _
               & "应用程序将结束！", vbCritical, "登录验证"
        End         '结束应用程序
    Else
        '检验用户名和口令的合法性，并根据检验返回值执行相应的操作
        Select Case Check_PassWord()
            Case 0
                '用户不是系统用户
                MsgBox txtLog(0) & " 不是系统用户," _
                       & "请检查用户名输入是否正确！", _
                       vbCritical, "登录验证"
                txtLog(0).SetFocus
                txtLog(0).SelStart = 0
                txtLog(0).SelLength = Len(txtLog(0))
            Case 1
                '口令错误
                MsgBox "口令错误,请重新输入！", vbCritical, "登录验证"
                txtLog(1) = ""
                txtLog(1).SetFocus
            Case 2
                 '口令正确
                Unload Me           '卸载登录窗体
                MsgBox "登录成功，将启动系统管理程序！", _
                       vbInformation, "登录验证"
                frmSysMain.Show    '显示系统主窗体
            Case Else
                '登录验证未正常完成
                MsgBox "登录验证未正常完成！请重新运行登录程序，" _
                      & vbCrLf & "如果仍不能登录，请报告系统管理员！", _
                       vbCritical, "登录验证"
        End Select
    End If
End Sub

Private Function Check_PassWord() As Byte
    On Error GoTo gpError
    Dim objCn As New Connection, objRs As New Recordset
    Dim strCn As String, strSQL As String
    '建立数据库连接
    strCn = "Provider=MSDASQL.1;Persist Security Info=False;" & _
             "Data Source=物管数据DSN"
    objCn.ConnectionString = strCn
    objCn.ConnectionTimeout = 30
    objCn.Open
    '执行查询命令,获得用户登录口令
    strSQL = "SELECT * FROM 系统用户 WHERE 用户名='" & txtLog(0) & "'"
    Set objRs.ActiveConnection = objCn
    objRs.Open (strSQL)
    '判断有无查询结果
    If objRs.EOF Then
        Check_PassWord = 0      '没有查询结果，表示该用户为非法用户
    Else
        '检查口令是否正确
        If txtLog(1) <> Trim(objRs.Fields("口令")) Then
            Check_PassWord = 1                      '口令不正确
        Else
            Check_PassWord = 2                      '口令正确
            '保存用户信息
            CurrentUserName = objRs.Fields("用户名").Value
            CurrentUserPassword = objRs.Fields("口令").Value
            CurrentUserStatus = objRs.Fields("身份").Value
        End If
    End If
    '关闭数据库连接，释放对象
    objCn.Close
    Set objRs = Nothing
    Set objCn = Nothing
    Exit Function
gpError:
    Check_PassWord = 255
End Function