标题:大家来做个人性化接近完美的登陆程序!
取消只看楼主
罪满天下
Rank: 1
等 级:新手上路
帖 子:25
专家分:0
注 册:2006-3-2
 问题点数:0 回复次数:3 
大家来做个人性化接近完美的登陆程序!

学VB就到这来了,感觉这好!呵呵,
经过几天的学习,总结一下,做点东西,当是自己的作业吧!请大家帮忙完善一下!
才学,所以写的不是很规矩,也很烦杂。

内容:
做个登陆程序,以VB+Access。
功能:
1、验证。验证用户名的正确与否、密码与用户名符合与否
2、人性化设计。
①、输入用户名后,无论是鼠标移动到密码框,还是按“Tab”键到密码框,都搜索用户名的存在与否,但不报错
②、输入密码后,选者状态在“确定”按钮上。
③、确定后检验,用户名为空时,光标停在用户名框,密码空停密码输入框。
控件:
TextBox、CommandButton、PictureBox、Timer、ADO


程序内容:
①:控件
2 TextBox
2 CommandButton
1 PictureBox
1 Timer

②:程序
'form1程序
Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Command2_Click()
Dim ConStr As String
If text_user.Text = "" Then
MsgBox "请输入用户名!", vbOKOnly + vbExclamation, "登陆错误"
text_user.SetFocus
Exit Sub
End If

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\ttj02.Mdb"
cn.Open ConStr
cn.CursorLocation = adUseServer
rs.Open "Select * from dbuser", cn, adOpenKeyset, adLockPessimistic
If rs.RecordCount > 0 Then
If text_user.Text <> "" Then
Set rs1 = New ADODB.Recordset
Dim TextUserName
TextUserName = Left(text_user.Text, 4)
rs1.Open "Select * From dbuser Where User_nb= '" & TextUserName & "'", cn, adOpenKeyset, adLockPessimistic
If rs1.RecordCount > 0 Then
text_user.Text = Left(text_user.Text, 4) & rs1.Fields("user_zhuwu")
Text_password.SetFocus
If Text_password <> "" Then
If rs1.Fields("User_Nb") = TextUserName And rs1.Fields("User_password") = Text_password.Text Then
Form3.Show
Unload Me
Else
MsgBox "密码错误!", vbExclamation + vbOKCancel, "登陆错误"
text_user.Text = ""
Text_password = ""
text_user.SetFocus
End If
Else
MsgBox "请输入密码!", vbExclamation + vbOKCancel, "登陆错误"
End If
Else
MsgBox "沒有用戶信息,請確定!", vbExclamation + vbOKCancel, "登陆错误"
text_user.Text = ""
Text_password = ""
text_user.SetFocus
Exit Sub
End If
rs.Close
End If
End If
End Sub

Private Sub Text_password_LostFocus()
If text_user.Text = "" Then
text_user.SetFocus
Else
If Text_password.Text <> "" Then
Command2.SetFocus
End If
End If
End Sub

Private Sub Text_password_Validate(Cancel As Boolean)
If text_user.Text = "" Then
text_user.SetFocus
Else
If Text_password.Text = "" Then
Text_password.SetFocus
Else
Command2.SetFocus
End If
End If
End Sub

Private Sub text_user_LostFocus()
If text_user.Text <> "" Then
Dim ConStr As String
Set cn = New ADODB.Connection
Set rs2 = New ADODB.Recordset
ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\ttj02.Mdb"
cn.Open ConStr
cn.CursorLocation = adUseServer
rs2.Open "Select * From dbuser Where User_nb= '" & TextUserName & "'", cn, adOpenKeyset, adLockPessimistic
If rs2.RecordCount > 0 Then
text_user.Text = text_user & rs2.Fields("user_zhuwu")
Text_password.SetFocus
rs2.Close
Else
text_user.Text = text_user.Text
Text_password.SetFocus
Exit Sub
End If
Else
text_user.SetFocus
End If
End Sub

Private Sub text_user_Validate(Cancel As Boolean)
Dim ConStr As String
Set cn = New ADODB.Connection
ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\ttj02.Mdb"
cn.Open ConStr
cn.CursorLocation = adUseServer
Dim TextUserName
TextUserName = Left(text_user.Text, 4)
If text_user.Text <> "" Then
Set rs3 = New ADODB.Recordset
rs3.Open "Select * From dbuser Where User_nb= '" & TextUserName & "'", cn, adOpenKeyset, adLockPessimistic
If rs3.RecordCount > 0 Then
text_user.Text = Left(text_user.Text, 4) & rs3.Fields("user_zhuwu")
Text_password.SetFocus
rs3.Close
Else
text_user.Text = Left(text_user.Text, 4)
Text_password.SetFocus
Exit Sub
End If
End If

End Sub

'form2程序
Private Sub Form_Load()
Me.Show
Me.Timer1.Interval = 3000
Me.Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Form1.Show
Unload Me
End Sub

呵呵 没看昏吧?? 大家下下去弄弄!谢谢大家的支持!
推荐新手学习用!

cZ9QRQLq.rar (33.48 KB) 大家来做个人性化接近完美的登陆程序!


搜索更多相关主题的帖子: 人性化 登陆 
2006-03-11 13:40
罪满天下
Rank: 1
等 级:新手上路
帖 子:25
专家分:0
注 册:2006-3-2
得分:0 
呵呵 现学现卖,

大家多教点哦!

完善一下, 我觉的程序中用键盘“Enter”按还没到效果

如果 光标在“用户输入框”按回车到“密码输入框”再按到选定“确定”最后再按再提交,这样就完美了

就想是用回车象用“Tab”

2006-03-11 14:08
罪满天下
Rank: 1
等 级:新手上路
帖 子:25
专家分:0
注 册:2006-3-2
得分:0 

Good

这样的话,Command 的 Default 属性 设置为 False 也没关系了吧!


2006-03-11 14:21
罪满天下
Rank: 1
等 级:新手上路
帖 子:25
专家分:0
注 册:2006-3-2
得分:0 
感谢斑竹加精啊 呵呵

6楼说的 我也发现了 还不能解决这个BUG 汗~``

不过窗口上的 叉叉可以关

2006-03-11 20:05



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-49756-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.114568 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved