VB制作系统登录界面，包括用户名，密码和错误校验及效果全代码

第十讲：教你用VB制作系统登录界面，包括用户名，密码和错误校验及效果全代码 以下代码均为个人学习心得，经过测试并且无误，可以嵌入大型程序中作为身份认证的功能作用。 其中有一些窗体名和效果代码，不必复制，否则会出现错误，请仔细阅读核心代码理解即可。 红色代码部份为实现用户检测的关键代码，必需要有后台数据库用来存放用户信息，通过 conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\HISDB.mdb"来连接，然后用If rs.EOF = True Then进行判断中是否存在用户信息即可。 Option Explicit Dim Cnum As Integer Private Sub CmdCancel_Click() '//结束 End End Sub Private Sub CmdLogin_Click()       Dim UserName As String             Dim PassWord As String       Dim conn As New ADODB.Connection       Dim rs As New ADODB.Recordset           Dim StrSQL As String           conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\HISDB.mdb"             UserName = Trim(TxtUserName.Text)    '//将文本框内的值赋给定义好的全局变量       PassWord = Trim(TxtPassword.Text) If UserName = "" Or PassWord = "" Then     MsgBox "对不起，用户或密码不能为空！请重新输入！！", vbCritical, "错误"     ElseIf UserName <> Empty And PassWord <> Empty Then     '//用户名与密码是否为空         Cnum = Cnum + 1         StrSQL = "select * from 用户信息表 where 用户名称= '" & UserName & "'and 用户口令 ='" & PassWord & "'"     rs.Open StrSQL, conn, adOpenKeyset, adLockPessimistic '//打开集         If rs.EOF = True Then     MsgBox "对不起，无此用户或者密码不正确！请重新输入！！", vbCritical, "错误"     TxtUserName.Text = ""     TxtPassword.Text = ""     TxtUserName.SetFocus     rs.Close             If Cnum >= 3 Then     MsgBox "对不起，您已经多次失败，无权操作本系统！", vbCritical, "无权限"     Unload Me     Exit Sub     End If              Else '登陆成功,以下为权限验证 If rs.Fields("用户权限").Value = "系统管理" Then Frmmdimain.Show Unload Me ElseIf rs.Fields("用户权限").Value = "挂号" Then Frmregistration2.Show Unload Me ElseIf rs.Fields("用户权限").Value = "诊断" Then Frmdiagnose2.Show Unload Me ElseIf rs.Fields("用户权限").Value = "收费" Then Frmcharges2.Show Unload Me ElseIf rs.Fields("用户权限").Value = "发药" Then Frmmedicine2.Show Unload Me End If rs.Close End If End If End Sub Private Sub Form_Load() '//加载主窗时给文本框赋值 TxtUserName.Text = "Admin" TxtPassword.Text = "123" Cnum = 0 End Sub Private Sub TmrChangeColor_Timer() '//调用定义好的改变颜色过程, Call changecolor(LblWelcome(0), 0, 1, 2, 3, 4, 5, 6, 7) End Sub Private Sub TmrMoveText1_Timer() '//移动LblShaSi LblShaSi(0).Move LblShaSi(0).Left + 20 LblShaSi(1).Move LblShaSi(1).Left + 20 End Sub Private Sub TmrMoveText2_Timer() '//移动LblShaSi If LblShaSi(0).Left + LblShaSi(0).Width >= Me.Width + LblShaSi(0).Width Then     LblShaSi(0).Move -1500 End If If LblShaSi(1).Left + LblShaSi(1).Width >= Me.Width + LblShaSi(1).Width Then     LblShaSi(1).Move -1500 End If End Sub '//定义一个改变颜色的过程,下面的control就是我们所说的控件 Sub changecolor(LCnt As Control, color1 As Integer, _                 color2 As Integer, color3 As Integer, _                 color4 As Integer, color5 As Integer, _                 color6 As Integer, color7 As Integer, _                 color8 As Integer)     Dim tmep As Integer     tmep = Val(LCnt.Tag)    '//将返回包含于字符串内的数字赋给TEMP     Select Case tmep     Case color1         LCnt.Tag = color2     Case color2         LCnt.Tag = color3     Case color3         LCnt.Tag = color4     Case color4         LCnt.Tag = color5     Case color5         LCnt.Tag = color6     Case color6         LCnt.Tag = color7     Case color7         LCnt.Tag = color8     Case color8         LCnt.Tag = color1     End Select     LCnt.ForeColor = QBColor(LCnt.Tag) '//给控件LCnt中的字体赋予颜色,注意QBColor是将一值                                         '//转换为三色,MSDN详解,我也是在那查的````哈 End Sub