you make a login form with text boxes for UserID, Password, Domain.
I have a tUser table to store the IDs of those allowed in the system.(it does not store passwords)
1.check if user is in the tUser table
2.check with windows authentication. If they pass both, show the menu, else quit.
Code:
public gvUserID , gvUSerGroup
'form code
'-------------
Private Sub btnLogin_Click()
'-------------
Dim sUser As String, sPass As String, sDom As String
dim vDbID
sUser = txtUser
sPass = txtPass
sDom = txtDom
gvUserID = Environ("Username")
vDbID = Dlookup("[userId]","tUsers","[UserID]='" & vID & "'"
gvUSerGroup = Dlookup("[Group]","tUsers","[UserID]='" & vID & "'"
if ucase(gvUserID) = ucase(vDbID) then
If WindowsLogin(sUser, sPass, sDom) and vID = vDbID Then
mbSafe = True
DoCmd.OpenForm "frmMainMenu"
DoCmd.OpenForm "frmLogin"
DoCmd.Close
Else
MsgBox "LOGIN INCORRECT", vbCritical, "Bad userid or password"
End If
else
MsgBox "You are not registered for this db.", vbCritical, "Contact Admin"
endif
End Sub
'-------------
Public Function WindowsLogin(ByVal strUserName As String, ByVal strpassword As String, ByVal strDomain As String) As Boolean
'-------------
'Authenticates user and password entered with Active Directory.
On Error GoTo IncorrectPassword
Dim oADsObject, oADsNamespace As Object
Dim strADsPath As String
strADsPath = "WinNT://" & strDomain
Set oADsObject = GetObject(strADsPath)
Set oADsNamespace = GetObject("WinNT:")
Set oADsObject = oADsNamespace.OpenDSObject(strADsPath, strDomain & "\" & strUserName, strpassword, 0)
WindowsLogin = True 'ACCESS GRANTED
ExitSub:
Exit Function
IncorrectPassword:
WindowsLogin = False 'ACCESS DENIED
Resume ExitSub
End Function
once the user gets thru the login screen, the main menu (or other form) opens then
turn /on off buttons depending on the group.
An invisible text box is set to the user group so now all queries for that form pull only data.
Here UserGroup 'A' = admin, who has rights to see everything.
The queries would look at the txt box to allow only that group.
Code:
sub form_load()
txtGroup = gvUserGroup
btnAdmin.enabled = gvUserGroup = "A"
if gvUserGroup = "A" then
me.recordsource = "qsDataAll"
else
me.recordsource = "qsDataByGroup"
endif
end sub