教程内容：

 

在用户登录时，要使用数据库中的“系统用户”表来完成登录信息验证，使用RecordSet对象的Find方法查找指定的用户名，如果用户名正确，接着验证口令和身份。用户登录信息无误后则启动主窗体。

 

Dim objRs As Recordset

Private Sub cmdCancel_Click()

    '请求用户确认是否真的退出系统登录

    n = MsgBox("你选择了退出系统登录，退出将不能启动管理系统！" & vbCrLf _

              & "是否真的退出？", vbYesNo, "登录验证")

    If n = vbYes Then

        Unload Me               '卸载登录窗体

    End If

End Sub

 

Private Sub cmdOk_Click()

    On Error GoTo DealError

    '检查是否存在指定身份用户

    objRs.MoveFirst

    objRs.Find "用户名='" & txtUserName & "'"

    If objRs.EOF Then

        MsgBox "用户名错误！", vbOKOnly + vbCritical, "系统登录"

        txtUserName.SetFocus

    Else

        '检查密码是否正确

        If objRs!口令 <> txtPassWord Then

            MsgBox "口令错误！", vbOKOnly + vbCritical, "系统登录"

            txtPassWord.SetFocus

        Else

            '检查身份是否正确

            If objRs!身份 <> cmbStatus Then

                MsgBox "身份错误！", vbOKOnly + vbCritical, "系统登录"

                cmbStatus.SetFocus

            Else

                ThisUserName = txtUserName

                ThisPassword = txtPassWord

                ThisStatus = cmbStatus

                Unload Me               '卸载登录窗体

                Form1.Show

            End If

        End If

    End If

     Exit Sub

DealError:

    msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description

    ShowError msg

End Sub

 

Private Sub Form_Load()

'    On Error GoTo DealError

    Dim objCn As New Connection

    '建立数据库连接

    strcn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _

                    "Data Source=" & App.Path & "\数据库\工资管理.mdb"

     objCn.ConnectionString = strcn

     objCn.Open

       

    '创建RecordSet对象，获取系统用户信息

    Set objRs = New Recordset

    Set objRs.ActiveConnection = objCn

    objRs.CursorLocation = adUseClient

    strsql = "SELECT * FROM 系统用户"

    objRs.Open strsql

    objRs.ActiveConnection = Nothing    '取消数据库连接

    objCn.Close                         '关闭数据库连接

    Set objCn = Nothing                 '释放连接对象

   

    '设置默认身份

    cmbStatus.ListIndex = 0

    Exit Sub

DealError:

    msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description

    ShowError msg

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

    Set objRs = Nothing

End Sub

 

 

 

 

 

 

Public ThisUserName As String       '用于保存用户名

Public ThisPassword As String       '用于保存密码

Public ThisStatus As String         '用于保存身份

 

Public Sub ShowError(ByVal msg As String)

    MsgBox msg, vbCritical + vbOKOnly, "工资管理系统"

End Sub