系统登录对话框的特点：

（1）界面简单

（2）基于数据库验证

1、首先需要设计窗体 如图所示“系统登录”

2、需要自己创建数据库。

代码：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 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 & "\数据库\实例1.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




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 & ">不是系统用户，请检查用户名输入是否正确！","登录验证"
Txtusername.SetFocus
Txtusername.SelStart = 0
Txtusername.SelLength = Len(Txtusername)
Case 1 '口令错误
MsgBox "口令错误，请重新输入！","登录验证"
Txtpassword = ""
Txtpassword.SetFocus
Case 2 '口令正确
Unload Me '卸载登陆窗体
MsgBox "登陆成功，将启动系统程序！",vbInformation,"登录验证"
'通常在此放置显示系统主窗体的语句，例如
'frmmain.show
Case Else '登录验证未正常完成
MsgBox "登录验证未正常完成！请重新运行登陆程序，" & vbCrLf & "如果仍不能登录，请报告系统管理员"
End Select

End If
End Sub