How to implement Login Screen?

[shovels]

Hi,
Can anyone tell me how to implement a login screen using ADO controls. The Username and Password values will are stored in one of my DB tables. The users need to be able to change their own passwords.
cheers..

[Chris]

'On your CmdLogin_Click event of the login screen.

Private Sub CmdLogin_Click()

Select Case ValidateUser(txtUser(0), txtUser(1))
Case 0
Msgbox "Login Success."
Case 1
Msgbox "Invalid User ID."
txtUser(0).SetFocus
Case 2
Msgbox "Invalid User Password."
txtUser(0).SetFocus
End select
End Sub

Private Function ValidateUser (ByVal lpUserID As String, ByVal lpUserPwd As String) As

Integer
Dim Conn as New ADODB.Connection
Dim Rst as New ADODB.Recordset

On Error GoTo Validate_Err
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "<Your Database>" & ";Jet OLEDBatabase Password=

<Your Password>"
With cRst
.Open <Your Table Name>, Conn, adOpenKeyset, adLockOptimistic
.Index = "UserID"
.Seek "=", lpUserID
If Not .NoMatch Then
If StrComp(lpPassword, .Fields("UserPwd"), vbBinaryCompare) <> 0 Then
ValidateUser = 2
Else
ValidateUser = 0
End If
Else
ValidateUser = 1
End If
End With

Set cRst = Nothing
Set cDb = Nothing
Exit Function
Validate_Err:
ValidateUser = 0
End Function

'To Allow User to Change Password you need another Form which do almost the same this, But

this time you seek for the User ID and then use the Edit & Update command to update the new
password into the database. Then just return a value so that you can tell the user whether
the new password is update successful or invalid old password occur. like below:

'Change password Button on the change password form
Private Sub CmdAction_Click()
Select Case ChangePassword(SysUser.UserID, txtPassword(0), txtPassword(1),

txtPassword(2))
Case 1 'Verified fail
MsgBox "Fail to verified new password.", vbExclamation + vbOKOnly, ""
txtPassword(2).SetFocus
Case 2 'User Not found
MsgBox "Invalid User ID.", vbExclamation + vbOKOnly, ""
txtPassword(2).SetFocus
Case 3 'Invalid old password
MsgBox "Invalid old password.", vbExclamation + vbOKOnly, ""
txtPassword(0).SetFocus
Case 4 'Successful
MsgBox "Password successful updated", vbInformation + vbOKOnly, ""
Unload Me
End Select
End Sub

Public Function ChangePassword(ByVal lpUserID As String, ByVal lpOldPassword As String, _
ByVal lpNewPassword As String, ByVal lpVerified As String) As

Integer

Dim Conn as New ADODB.Connection
Dim Rst as New ADODB.Recordset

If StrComp(lpNewPassword, lpVerified, vbBinaryCompare) = 0 Then
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "<Your Database>" & ";Jet OLEDBatabase Password=

<Your Password>"
With cRst
.Open <Your Table Name>, Conn, adOpenKeyset, adLockOptimistic
.FindFirst "UserID='" & lpUserID & "'"
If Not .NoMatch Then
If StrComp(lpOldPassword, .Fields("UserPwd"), vbBinaryCompare) = 0 Then
.Edit
.Fields("UserPwd") = lpNewPassword
.Update
ChangePassword = 4 'Successful
Else
ChangePassword = 3 'Invalid old password
End If
Else
ChangePassword = 2 'User not found
End If
End With

Set cRst = Nothing
Set cDb = Nothing
Else
ChangePassword = 1 'Varified password fail
End If

End Function

'Note:
It is better for you to encrypt the password before you save it into the database. it

more secure.

Hope this is what you looking for.

[Edited by Chris on 03-22-2000 at 03:33 AM]