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 '//打开记录集
用户登录界面设计代码html
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, _

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。