Implementing Authorization functionality on Dyn. Elements (Click Events)

[herberto]

At Dynamic Elements (i.e. Text Buttons) authorization groups can be configured (so only a user with the appropriate rights can operate the element).
If only VBA Click-Events (like LeftClickUp, LeftClickDown, RightClickUp, ... aso) are configured the standard authorization mechanism doesn't work (this is intended). At the standard authorization mechanism then a message is displayed like "You are not entitled to execute this function" or the temporary login dialog is displayed (if activated).

Find below a VBA Code which compares the authorization group of the clicked element and the authorization group of the current logged-in user:

'this macro is executed if the left mouse button is released
'this macro is linked to the element via "LeftClickUp"
Public Sub LeftClickUp_SetLow(obElem As Element)

    'perform the validation check (-> does the current user have sufficient rights to operate the clicked element?)
    If CheckUserLevel(obElem.PasswordLevel) = True Then
        '-> ok.. the user has sufficient rights (perform the action you want)
        Debug.Print "Current user is allowed to perform the action"
    Else
        '-> not sufficient rights
        Debug.Print "Current user is NOT allowed to perform the action"
        'show the login dialog (name of the login function: fct_LoginUser)
        thisProject.RtFunctions.Item("fct_LoginUser").Start
    End If    
    
    'release the text button
    obElem.LeftClickUp
    
End Sub
  
'this function checks if the current user has the proper rights to operate the clicked element
Public Function CheckUserLevel(ByVal UserLevel As Integer) As Boolean
    Select Case UserLevel
        Case 0 To 30
            CheckUserLevel = CBool(thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser).Level And 2 ^ UserLevel)
        Case 31
            CheckUserLevel = CBool(thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser).Level < 0)
        Case 32 To 62
            CheckUserLevel = CBool(thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser).Level1 And 2 ^ (UserLevel - 32))
        Case 63
            CheckUserLevel = CBool(thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser).Level1 < 0)
        Case 64 To 94
            CheckUserLevel = CBool(thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser).Level2 And 2 ^ (UserLevel - 64))
        Case 95
            CheckUserLevel = CBool(thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser).Level2 < 0)
        Case 96 To 126
            CheckUserLevel = CBool(thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser).Level3 And 2 ^ (UserLevel - 96))
        Case 127
            CheckUserLevel = CBool(thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser).Level3 < 0)
    End Select
End Function

[brenner]

Hallo Herberto

Solange ich die Berechtigungsebenen einzeln vergebe funktioniert die Auswertung per VBA.
Verwende ich aber die Benutzergruppen zum Zuweisen der Berechtigungsebenen werden zwar die Systemvariablen richtig aktualisiert, jedoch die Berechtigungsprüfung per VBA schlägt fehl.

Wie muss der Code angepasst werden um die Berechtigungsebenen auch via Benutzergruppen auswerten / prüfen zu können?

[markclemens]

In diesem Fall muss für jeden Benutzer zusätzlich geprüft werden, zu welchen Gruppen der Benutzer gehört, und ob einer diesen Gruppen die Berechtigungsebene besitzt die erforderlich ist.

Die Funktion "CheckUserLevel" lässt sich wie folgt erweitern:

'this function checks if the current user has the proper rights to operate the clicked element
Public Function CheckUserLevel(ByVal UserLevel As Integer) As Boolean
Dim i
Dim MyUser As User
Dim Groups

Set MyUser = thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser)
If Not MyUser Is Nothing Then
Groups = Split(MyUser.DynProperties("UserGroupsImExpo"), ";")
    Select Case UserLevel
        Case 0 To 30
            CheckUserLevel = CBool(MyUser.Level And 2 ^ UserLevel)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(CStr(Groups(i))).DynProperties("UserGroupLevel0") And 2 ^ UserLevel)
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 31
            CheckUserLevel = CBool(MyUser.Level < 0)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(CStr(Groups(i))).DynProperties("UserGroupLevel0") < 0)
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 32 To 62
            CheckUserLevel = CBool(MyUser.Level1 And 2 ^ (UserLevel - 32))
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(CStr(Groups(i))).DynProperties("UserGroupLevel1") And 2 ^ (UserLevel - 32))
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 63
            CheckUserLevel = CBool(MyUser.Level1 < 0)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(CStr(Groups(i))).DynProperties("UserGroupLevel1") < 0)
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 64 To 94
            CheckUserLevel = CBool(MyUser.Level2 And 2 ^ (UserLevel - 64))
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(CStr(Groups(i))).DynProperties("UserGroupLevel2") And 2 ^ (UserLevel - 64))
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 95
            CheckUserLevel = CBool(MyUser.Level2 < 0)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(CStr(Groups(i))).DynProperties("UserGroupLevel2") > 0)
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 96 To 126
            CheckUserLevel = CBool(MyUser.Level3 And 2 ^ (UserLevel - 96))
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(CStr(Groups(i))).DynProperties("UserGroupLevel3") And 2 ^ (UserLevel - 96))
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 127
            CheckUserLevel = CBool(MyUser.Level3 < 0)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(CStr(Groups(i))).DynProperties("UserGroupLevel3") > 0)
                    If CheckUserLevel Then Exit For
                Next i
            End If
    End Select
End If
End Function

Alternativ könnte man auch die Systemtreibervariablen "Aktuelle Berechtigungsgruppe 1" -- "Aktuelle Berechtigungsgruppe 4" für für die Prüfung verwenden. Diese Variablen zeigen die kumulierten Berechtigungsebenen. (direkt beim Benutzer vergeben und über die Gruppe(n) erworben)

[herberto]

nice code!

[markclemens]

nice code!

Thanks *bows to the master*

[hare1268]

Nach Aufruf :

CkeckUserLevel(31)

stürtzt bei mir das Script immer an diese Stelle

[
Case 31
CheckUserLevel= CBool(MyUser.Level <0)

ab.
Jemand eine Idee den Fehler zu umgehen ?
(Zenon 7.0)

[markclemens]

Hallo,

Es scheint sich hier generell etwas geändert zu haben, ohne dass die Änderung in den Release Notes dokumentiert wurde

Ab der Version 7 gibt es das Dynproperty "UserGroupsImExpo" nicht länger, stattdessen gibt es das Dynproperty "UserGroupsOrderImExpo", was allerdings nicht den gleichen String zurück gibt.

Version 6.51:
debug.Print MyUser.DynProperties("UserGroupsImExpo")
dreissig;1;zwei;

Version 7.00:
debug.Print MyUser.DynProperties("UserGroupsOrderImExpo")
dreissig|0;1|0;zwei|0;

Der Teilstring "|0" gibt in der Version 7 die Position des Benutzers in der Liste der Benutzer für die Benutzergruppe an (relevant für Message Control wenn eine Nachricht an eine Gruppe gesendet wird)

Die Funktion "CheckUserLevel" lässt sich entsprechend erweitern, damit der String zugeschnitten wird.

So funktioniert es bei mir auch in der Version 7:

'this function checks if the current user has the proper rights to operate the clicked element
Public Function CheckUserLevel(ByVal UserLevel As Integer) As Boolean
Dim i
Dim MyUser As User
Dim Groups
Dim GroupString As String

 
Set MyUser = thisProject.Passwords.ItemUser(thisProject.Passwords.LoggedUser)
If Not MyUser Is Nothing Then
Groups = Split(MyUser.DynProperties("UserGroupsOrderImExpo"), ";")
    Select Case UserLevel
        Case 0 To 30
            CheckUserLevel = CBool(MyUser.Level And 2 ^ UserLevel)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    GroupString = CStr(Groups(i))
                    GroupString = Left(GroupString, (InStrRev(GroupString, "|") - 1))
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(GroupString).DynProperties("UserGroupLevel0") And 2 ^ UserLevel)
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 31
            CheckUserLevel = CBool(MyUser.Level < 0)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    GroupString = CStr(Groups(i))
                    GroupString = Left(GroupString, (InStrRev(GroupString, "|") - 1))
                    CheckUserLevel = CBool(CLng(thisProject.Passwords.ItemUserGroup(GroupString).DynProperties("UserGroupLevel0")) < 0)
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 32 To 62
            CheckUserLevel = CBool(MyUser.Level1 And 2 ^ (UserLevel - 32))
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    GroupString = CStr(Groups(i))
                    GroupString = Left(GroupString, (InStrRev(GroupString, "|") - 1))
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(GroupString).DynProperties("UserGroupLevel1") And 2 ^ (UserLevel - 32))
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 63
            CheckUserLevel = CBool(MyUser.Level1 < 0)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    GroupString = CStr(Groups(i))
                    GroupString = Left(GroupString, (InStrRev(GroupString, "|") - 1))
                    CheckUserLevel = CBool(CLng(thisProject.Passwords.ItemUserGroup(GroupString).DynProperties("UserGroupLevel1")) < 0)
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 64 To 94
            CheckUserLevel = CBool(MyUser.Level2 And 2 ^ (UserLevel - 64))
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    GroupString = CStr(Groups(i))
                    GroupString = Left(GroupString, (InStrRev(GroupString, "|") - 1))
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(GroupString).DynProperties("UserGroupLevel2") And 2 ^ (UserLevel - 64))
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 95
            CheckUserLevel = CBool(MyUser.Level2 < 0)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    GroupString = CStr(Groups(i))
                    GroupString = Left(GroupString, (InStrRev(GroupString, "|") - 1))
                    CheckUserLevel = CBool(CLng(thisProject.Passwords.ItemUserGroup(GroupString).DynProperties("UserGroupLevel2")) > 0)
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 96 To 126
            CheckUserLevel = CBool(MyUser.Level3 And 2 ^ (UserLevel - 96))
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    GroupString = CStr(Groups(i))
                    GroupString = Left(GroupString, (InStrRev(GroupString, "|") - 1))
                    CheckUserLevel = CBool(thisProject.Passwords.ItemUserGroup(GroupString).DynProperties("UserGroupLevel3") And 2 ^ (UserLevel - 96))
                    If CheckUserLevel Then Exit For
                Next i
            End If
        Case 127
            CheckUserLevel = CBool(MyUser.Level3 < 0)
            If Not CheckUserLevel Then
                For i = 0 To UBound(Groups) - 1
                    GroupString = CStr(Groups(i))
                    GroupString = Left(GroupString, (InStrRev(GroupString, "|") - 1))
                    CheckUserLevel = CBool(CLng(thisProject.Passwords.ItemUserGroup(GroupString).DynProperties("UserGroupLevel3")) > 0)
                    If CheckUserLevel Then Exit For
                Next i
            End If
    End Select
End If
End Function

[hare1268]

Bei leider nicht.
Es fängt schon bei diese Zeile an
Dim MyUser As User
Fehler beim Kompilieren
Ein Modul hat einen unzulässigen Typ

Es geht nur so
Dim MyUser

das für aber wahrscheinlich an diese Stelle zum Fehler

Case 31
CheckUserLevel = CBool(MyUser.Level < 0)

Laufzeitfehler '458'
Variavle verwendet einen in Visual Basic nicht unterstütztem Typ der Automatisirung

[markclemens]

Eventuel muss die Funktion "CheckUserLevel" unter Modules in ein eigenes (neues) Modul eingefügt werden:

[hare1268]

Yep das was.
Modul hat auch User geheisen. (Man sieht wieder nicht den Wald nicht von lauter Bäumen)

Dank.

Hätte auch noch einen kleinen Verbesserungsvorschlag.
Die Zeile ergänzen wenn kein User eingelogt ist.


If Not MyUser Is Nothing And MyUser.Identification <> "0000" Then