form1.frm

vb写的试题库生成系统

VERSION 5.00
Begin VB.Form denglu 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "试题库系统登录"
   ClientHeight    =   5430
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   8205
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5430
   ScaleWidth      =   8205
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取  消"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4920
      TabIndex        =   8
      Top             =   2640
      Width           =   1215
   End
   Begin VB.TextBox txtPassword 
      DataField       =   "Passward"
      DataSource      =   "Data1"
      Height          =   495
      IMEMode         =   3  'DISABLE
      Left            =   1920
      PasswordChar    =   "*"
      TabIndex        =   5
      Top             =   2640
      Width           =   2295
   End
   Begin VB.TextBox txtUserName 
      DataSource      =   "Data1"
      Height          =   495
      IMEMode         =   3  'DISABLE
      Left            =   1920
      TabIndex        =   4
      Top             =   1560
      Width           =   2295
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "登  陆"
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4920
      TabIndex        =   3
      Top             =   1560
      Width           =   1215
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "谭学聪  许汉文"
      Height          =   180
      Left            =   1080
      TabIndex        =   7
      Top             =   4440
      Width           =   1260
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "韶关学院计算机科学系毕业设计"
      Height          =   180
      Left            =   720
      TabIndex        =   6
      Top             =   3840
      Width           =   2520
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   " 密 码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   720
      TabIndex        =   2
      Top             =   2640
      Width           =   960
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "用户名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   720
      TabIndex        =   1
      Top             =   1560
      Width           =   960
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "欢迎使用试题库系统"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   21.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   2040
      TabIndex        =   0
      Top             =   360
      Width           =   3915
   End
End
Attribute VB_Name = "denglu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const MaxLogTimes As Integer = 5     '允许用户验证登录信息最多5次'


Private Sub cmdCancel_Click()
Dim intResult As Integer            '请求用户确认是否退出系统登录’
intResult = MsgBox("是否退出试题库系统登录!", vbYesNo, "登录验证")
If intResult = vbYes Then End        '根据用户选择退出系统登录"'
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, strSQL As String
    
    '建立数据库连接
     objCn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
                                      "Data Source=" & App.Path & "\Access\shitiku.mdb"
     objCn.Open
        
    '执行查询命令,获得用户登录Password
    strSQL = "SELECT Password FROM user WHERE user='" & UserName & "'"
    Set objRs.ActiveConnection = objCn
    objRs.Open (strSQL)
    
    '判断有无查询结果
    If objRs.EOF Then
        Check_PassWord = 0      '没有查询结果，表示该用户为非法用户
    Else
        '检查Password是否正确
        If Password <> Trim(objRs.Fields("Password").Value) Then
            Check_PassWord = 1          'Password不正确
        Else
            Check_PassWord = 2         'Password正确
        End If
    End If
    
    '关闭数据库连接，释放对象
    objCn.Close
    Set objRs = Nothing
    Set objCn = Nothing
    Exit Function
gpError:
MsgBox Err.Description
    Check_PassWord = 255                '验证无法正常完成，返回错误代码
    Set objRs = Nothing
    Set objCn = Nothing
End Function
Private Sub cmdOk_Click()
    Static intLogTimes As Integer       '静态常量intLogTimes用于保存用户请求验证的次数
    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)            '获得user
        strPassword = Trim(txtPassword.Text)        '获得Password
        
        '检验user和Password的合法性，并根据检验返回值执行相应的操作
        Select Case Check_PassWord(strName, strPassword)
            Case 0                                  '用户不是user
                MsgBox "<" & strName & ">不是合法用户,请检查用户名输入是否正确！", _
                       vbCritical, "登录验证"
                txtUserName.SetFocus
                txtUserName.SelStart = 0
                txtUserName.SelLength = Len(txtUserName)
            Case 1                                  'Password错误
                MsgBox "密码错误,请重新输入！", vbCritical, "登录验证"
                txtPassword = ""
                txtPassword.SetFocus
            Case 2                                  'Password正确
                Unload Me                           '卸载登录窗体
                MsgBox "登录成功，将启动系统程序！", vbInformation, "登录验证"
                SystemMain.Show
                
            Case Else
                '登录验证未正常完成
                MsgBox "登录验证未正常完成！请重新运行登录程序，" & vbCrLf _
                       & "如果仍不能登录，请报告系统管理员！", vbCritical, "登录验证"
        End Select
    End If
End Sub