1.txt

VB登陆界面代码

Option Explicit 
Dim intTryTimes As Integer 
Dim dbLogin As Database 
Dim rstLogin As Recordset 

Private Sub cmdLoginCancel_Click() 
End 
End Sub 

Private Sub cmdLoginEnter_Click() 
If Me.txtUser = "" Then 
MsgBox "用户名不能为空！", vbCritical, Me.Caption 
Me.txtUser.SetFocus 
GoTo ExitSub 
ElseIf Me.txtPwd = "" Then 
MsgBox "请填写密码！", vbCritical, Me.Caption 
Me.txtPwd.SetFocus 
GoTo ExitSub 
End If 
Set rstLogin = dbLogin.OpenRecordset("select * from User where Username='" + Trim(Me.txtUser) + "'") 
If rstLogin.RecordCount = 0 Then 
MsgBox "用户名填写错误！", vbCritical, "错误" 
Me.txtUser.SetFocus 
Me.txtUser.SelStart = 0 
Me.txtUser.SelLength = Len(Me.txtUser) 
GoTo ExitSub 
End If 
If rstLogin.Fields("Pwd") = Trim(Me.txtPwd) Then 
'登陆成功 
' userName = Trim(Me.txtUser) 
Unload Me 
Form1.Show 
' Call Sound("Login") 
Else 
MsgBox "密码错误！", vbCritical, "错误" 
Me.txtPwd.SetFocus 
Me.txtPwd.SelStart = 0 
Me.txtPwd.SelLength = Len(Me.txtPwd) 
End If 
GoTo ExitSub 
ExitSub: 
intTryTimes = intTryTimes + 1 
If intTryTimes = 4 Then 
MsgBox "密码错误!", vbInformation, Me.Caption 
End 
End If 
End Sub 

Private Sub Form_Load() 
Me.Left = Screen.Width / 2 - Me.Width / 2 
Me.Top = Screen.Height / 2 - Me.Height / 2 
Me.Caption = "登陆" 
intTryTimes = 0 
Set dbLogin = OpenDatabase(App.Path + "\Data.mdb", False, False, "MS Access;pwd=111") 
' Set rstLogin = dbLogin.OpenRecordset("select Username from User") 
' If rstLogin.RecordCount <> 0 Then 
' Me.txtUser = rstLogin.Fields("Username") 
' End If 
Show 
Me.txtUser.SetFocus 
End Sub 

Private Sub Form_Unload(Cancel As Integer) 
Set rstLogin = Nothing 
dbLogin.Close 
End Sub 

Private Sub txtPwd_GotFocus() 
Me.txtPwd.SelStart = 0 
Me.txtPwd.SelLength = Len(Me.txtPwd) 
End Sub 

Private Sub txtPwd_KeyPress(KeyAscii As Integer) 
If KeyAscii = 13 Then 
Call cmdLoginEnter_Click 
End If 
End Sub 

Private Sub txtUser_GotFocus() 
Me.txtUser.SelStart = 0 
Me.txtUser.SelLength = Len(Me.txtUser) 
End Sub 

Private Sub txtUser_KeyPress(KeyAscii As Integer) 
If KeyAscii = 13 Then 
Call cmdLoginEnter_Click 
End If 
End Sub