OOP User authorisation class wanted (1 Viewer)

spikepl

Eledittingent Beliped
Local time
Today, 13:38
Joined
Nov 3, 2010
Messages
6,144
Making a class for user authorisation/login would seem pretty smart, so the thing could keep it's appearance no matter what extra features where needed, and so the features could be added ad libitum.

I've searched but did not find any VBA-based examples. If you know of one please provide some code examples or links.

TIA
 

spikepl

Eledittingent Beliped
Local time
Today, 13:38
Joined
Nov 3, 2010
Messages
6,144
Bump.

Anybody ? Hints appreciated.
 

Frothingslosh

Premier Pale Stale Ale
Local time
Today, 08:38
Joined
Oct 17, 2012
Messages
3,276
If I had one, I'd share it, man. :(
 

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 12:38
Joined
Sep 12, 2006
Messages
15,614
a class doesn't add anything to what you could do without a class, does it?

you need a form, a control for a username, and a control for a password, and then you need code to validate the username and password.
 

spikepl

Eledittingent Beliped
Local time
Today, 13:38
Joined
Nov 3, 2010
Messages
6,144
@Dave

That is not the issue. The programming world kept turning quite happily even before OOP so most - if not all - of progamming could still be carried out without it.

The point is that a properly designed and implemented class like that would illustrate a considerable share of the OOP techniques and concepts in a way that would allow one to learn from it and to build on top of it.
 

Mile-O

Back once again...
Local time
Today, 12:38
Joined
Dec 10, 2002
Messages
11,316
Here's a take on what I've done recently. Any questions, ask away.

First, some tables:

tblPermissions
PermissionID
Permission
PermissionCategoryID
PermissionCode
DateCreated
UserCreated
DateUpdated
UserUpdated
DateExpired
UserExpired

tblPermissionCategories
PermissionCategoryID
PermissionCategory
DateCreated
UserCreated
DateUpdated
UserUpdated
DateExpired
UserExpired

tblUsers
UserID
WindowsCode
Forename
Surname
Email
User
UserLevelID
DateCreated
UserCreated
DateUpdated
UserUpdated
DateExpired
UserExpired

tblUserLevels
UserLevelID
UserLevel
DateCreated
UserCreated
DateUpdated
UserUpdated
DateExpired
UserExpired

tblPermissionsToUserLevels
UserLevelID
PermissionlID
DateCreated
UserCreated
DateUpdated
UserUpdated
DateExpired
UserExpired​

A query called qryCurrentUser, that refers to Dev Ashish's fOSUsername() function (get it here).

Code:
SELECT tblUsers.UserID, 
           tblUsers.Code, 
           tblUsers.Forename, 
           tblUsers.Surname, 
           tblUsers.Email, 
           tblUserLevels.UserLevel
FROM tblUsers INNER JOIN tblUserLevels ON 
         tblUsers.UserLevelID = tblUserLevels.UserLevelID
WHERE tblUsers.Code = fOSUsername();


Also, a query called qryUserPermissions:

Code:
PARAMETERS [User Level] Text ( 255 ), [Permission Code] Text ( 255 );

SELECT tblPermissions.PermissionID, 
           tblPermissions.Permission, 
           tblPermissions.Description

FROM tblUserLevels INNER JOIN (tblPermissionsToUserLevels INNER JOIN tblPermissions ON 
tblPermissionsToUserLevels.PermissionID = tblPermissions.PermissionID) ON
tblUserLevels.UserLevelID = tblPermissionsToUserLevels.UserLevelID

WHERE tblPermissionsToUserLevels.DateExpired > Now() AND 
          tblUserLevels.UserLevel = [User Level] AND
          tblPermissions.PermissionCode = [Permission Code];


Then the User class:

Code:
Option Explicit
Option Compare Database

    Private rsUser As DAO.Recordset

    Public Permissions As clsPermissions

    Private prvlngID As Long
    Private prvstrWindowsCode As String
    Private prvstrForename As String
    Private prvstrSurname As String
    Private prvstrEmail As String
    Private prvstrUserLevel As String

    Private Const cstrCurrentUser As String = "qryCurrentUser"

    Public Property Get ID() As Long
        ID = prvlngID
    End Property ' ID

    Public Property Let ID(ByRef param_ID As Long)
        prvlngID = param_ID
    End Property ' ID
    
    Public Property Get WindowsCode() As String
        WindowsCode = prvstrWindowsCode
    End Property ' WindowsCode

    Public Property Let WindowsCode(ByRef param_WindowsCode As String)
        prvstrWindowsCode = param_WindowsCode
    End Property ' WindowsCode
    
    Public Property Get Name() As String
        Name = Me.Forename & " " & Me.Surname
    End Property ' Forename

    Public Property Get Forename() As String
        Forename = prvstrForename
    End Property ' Forename

    Public Property Let Forename(ByRef param_Forename As String)
        prvstrForename = param_Forename
    End Property ' Forename

    Public Property Get Surname() As String
        Surname = prvstrSurname
    End Property ' Surname

    Public Property Let Surname(ByRef param_Surname As String)
        prvstrSurname = param_Surname
    End Property ' Surname

    Public Property Get Email() As String
        Email = prvstrEmail
    End Property ' Email

    Public Property Let Email(ByRef param_Email As String)
        prvstrEmail = param_Email
    End Property ' Email
    
    Public Property Get UserLevel() As String
        UserLevel = prvstrUserLevel
    End Property ' UserLevel

    Public Property Let UserLevel(ByRef param_UserLevel As String)
        prvstrUserLevel = param_UserLevel
    End Property ' UserLevel

    Private Sub Class_Initialize()

        Set rsUser = CurrentDb.OpenRecordset(cstrCurrentUser)
        
        If rsUser.RecordCount = 0 Then
        
            Me.ID = 0
            Me.WndowsCode = vbNullString
            Me.Forename = vbNullString
            Me.Surname = vbNullString
            Me.Email = vbNullString
            Me.UserLevel = vbNullString
        
        Else
            
            Me.ID = rsUser.Fields("UserID")     
            Me.Code = rsUser.Fields("WindowsCode")
            Me.Forename = rsUser.Fields("Forename")
            Me.Surname = rsUser.Fields("Surname")
            Me.Email = rsUser.Fields("Email")
            Me.UserLevel = rsUser.Fields("UserLevel")
                   
        End If

        Set Permissions = New clsUserPermissions

    End Sub

And a UserPermissions class:

Code:
Option Compare Database
Option Explicit

Private prvbooCanAddDepartments As Boolean
Private prvbooCanEditDepartments As Boolean
Private prvbooCanDeleteDepartments As Boolean

Private Const cstrUserPermissions As String = "qryUserPermissions"

Public Property Get CanAddDepartments() As Boolean
    CanAddDepartments = prvbooCanAddDepartments
End Property ' CanAddDepartments

Public Property Let CanAddDepartments(ByRef param_CanAddDepartments As Boolean)
    prvbooCanAddDepartments = param_CanAddDepartments
End Property ' CanAddDepartments

Public Property Get CanEditDepartments() As Boolean
    CanEditDepartments = prvbooCanEditDepartments
End Property ' CanEditDepartments

Public Property Let CanEditDepartments(ByRef param_CanEditDepartments As Boolean)
    prvbooCanEditDepartments = param_CanEditDepartments
End Property ' CanEditDepartments

Public Property Get CanDeleteDepartments() As Boolean
    CanDeleteDepartments = prvbooCanDeleteDepartments
End Property ' CanDeleteDepartments

Public Property Let CanDeleteDepartments(ByRef param_CanDeleteDepartments As Boolean)
    prvbooCanDeleteDepartments = param_CanDeleteDepartments
End Property ' CanDeleteDepartments

Private Sub Class_Initialize()

    Me.CanAddDepartments = HasProperty(User.UserLevel, "DepartmentAdd")
    Me.CanEditDepartments = HasProperty(User.UserLevel, "DepartmentEdit")
    Me.CanDeleteDepartments = HasProperty(User.UserLevel, "DepartmentDelete")

End Sub ' Class_Initialize

    Public Function HasProperty(ByRef strUserLevel As String, ByRef strCode As String) As Boolean
        
        ' create a DAO.Recordset object
        Dim rsPerm As DAO.Recordset
        
        ' create a DAO.QueryDef object
        Dim qdPerm As DAO.QueryDef
        
        ' align the DAO.QueryDef with the permissions query
        Set qdPerm = ThisApp.DB.QueryDefs(cstrUserPermissions)
        
        ' Populate the parameters for the DAO.QueryDef object
        qdPerm.Parameters(0) = Nz(strUserLevel)
        qdPerm.Parameters(1) = Nz(strCode)
        
        ' Open the recordset with parameters applied
        Set rsPerm = qdPerm.OpenRecordset
        
        ' if there are records, the user does has the property
        If rsPerm.RecordCount <> 0 Then
            HasProperty = True
        End If
        
    End Function ' HasProperty
 

jdraw

Super Moderator
Staff member
Local time
Today, 08:38
Joined
Jan 23, 2006
Messages
15,364
Mile-O,

Thanks for posting. I do not use classes to any real extent. I have dabbled a little.
As I see your code, it is specific to Department. Do you see a generic means to possibly deal with a Role type table that identified permissions for multiple tables?
Where a user is assigned a role and the role has permissions Create, Read, Modify, Delete related to identified tables?

Just a thought for a generalized approach.
 

Mile-O

Back once again...
Local time
Today, 12:38
Joined
Dec 10, 2002
Messages
11,316
My example mentions Department, but it's just an example. You can create whatever you want in the Permissions table. Then you can align them with any User Level in the junction table.

I have created many more permissions in my actual database (CanViewReportMenu, CanViewAdminMenu, CanDeleteUserComment, etc.


Just in the code, it may come down to:

Code:
Me.cmdAdd.Enabled = ThisUser.CanAddDepartment

So, effectively, you can have

Code:
If ThisUser.CanModify Then....
 

Users who are viewing this thread

Top Bottom