frmlogon.frm

能够实现登陆

VERSION 5.00
Begin VB.Form frmLogon 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "系统登陆"
   ClientHeight    =   4455
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   7710
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4455
   ScaleWidth      =   7710
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Default         =   -1  'True
      Height          =   615
      Left            =   4440
      TabIndex        =   5
      Top             =   2880
      Width           =   1815
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   615
      Left            =   1200
      TabIndex        =   4
      Top             =   2880
      Width           =   1815
   End
   Begin VB.TextBox txtPassWord 
      Height          =   615
      IMEMode         =   3  'DISABLE
      Left            =   3000
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   1680
      Width           =   2535
   End
   Begin VB.TextBox txtUserName 
      Height          =   615
      Left            =   3000
      TabIndex        =   0
      Top             =   480
      Width           =   2535
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "口令(&P)"
      Height          =   180
      Left            =   720
      TabIndex        =   3
      Top             =   1800
      Width           =   630
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "用户名(&U)"
      Height          =   180
      Left            =   720
      TabIndex        =   2
      Top             =   480
      Width           =   810
   End
End
Attribute VB_Name = "frmLogon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const MaxLogTimes As Integer = 3
Private Sub cmdCancel_Click()
Dim intResult As Integer
intResult = MsgBox("你选择了退出登陆系统，退出将不能启动管理系统！" & vbCrLf & "是否真的退出", vbYesNo, "登陆验证")
If intResult = vbYes Then End
End Sub
Private Sub cmdOk_Click()
Static intLogTimes As Integer
Dim intChecked As Integer, strName As String, strPassword As String
intLogTimes = intLogTimes + 1
If intLogTimes > MaxLogTimes Then
MsgBox "你已经超过允许验证次数！" & vbCr & "应用程序将结束！", vbCritical, "登陆验证"
End
Else
strName = Trim(txtUserName.Text)
strPassword = Trim(txtPassWord.Text)
Select Case Check_PassWord(strName, strPassword)
Case 0
MsgBox "<" & strName & "不是系统用户，请检查用户名输入是否正确！", vbCritical, "登陆验证"
txtUserName.SetFocus
txtUserName.SelStart = 0
txtUserName.SelLength = Len(txtUserName)
Case 1
MsgBox "口令错误，请重新输入！", vbCritical, "登陆验证"
txtPassWord = ""
txtPassWord.SetFocus
Case 2
Unload Me
MsgBox "登陆成功，将启动系统程序！", vbInformation, "登陆验证"
MDIForm1.Show
Case Else
MsgBox "登陆验证未正常完成！请重新运行登陆程序，" & vbCrLf & "如果仍不能登陆，请报告系统管理员！", vbCritical, "登陆验证"
End Select
End If
End Sub
Private Function Check_PassWord(ByVal UserName As String, ByVal Password As String) As Byte
On Error GoTo gpError
Dim objCn As New Connection, objRs As New Recordset, strCn As String
Dim strSQL As String
objCn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;" & "Data Source =" & App.Path & "\登陆数据库.mdb"
objCn.Open
strSQL = "SELECT 口令 FROM 系统用户 WHERE 用户名 ='" & UserName & "'"
Set objRs.ActiveConnection = objCn
objRs.Open (strSQL)
If objRs.EOF Then
Check_PassWord = 0
Else
If Password <> Trim(objRs.Fields("口令").Value) Then
Check_PassWord = 1
Else
Check_PassWord = 2
End If
End If
objCn.Close
Set objRs = Nothing
Set objCn = Nothing
Exit Function
gpError:
Check_PassWord = 255
Set objRs = Nothing
Set objCn = Nothing
End Function