PossedeRole

[oguruma]

[syntax="ls"]Function PossedeRole (Role As String) As Integer
'//=============================================
'// = détection d'un rôle

'//=============================================
Const Cmd ="@UserRoles"
Dim EstRole As Integer
Dim ListeRoles As Variant
EstRole=False
ListeRoles=Evaluate(Cmd)
Forall R In ListeRoles
If Ucase$(R)=Ucase$(Role) Then
EstRole=True
Exit Forall
End If
End Forall
PossedeRole=EstRole
End Function[/syntax]

c'est un peu à la hache sur la boucle mais elle fonctionne depuis plus de 5 ans

[Michael DELIQUE]

Une Autre Version inspiré par le Maitre

[syntax="ls"] ]Function HasRole(wRole As String) As Integer

'wRole = "[Role1]:[Role]" liste des roles autorisés

'declaration Variable
Dim vrValue As Variant

On Error Goto ErreurHasRole

HasRole = False
If Trim(wRole) <> "" Then
vrValue = Evaluate({@UserRoles})
Select Case Datatype(vrValue)
Case 0,1,9 ' EMPTY, NULL ,OLE object or NOTHING
'on fait rien
Case Else
Forall Value In vrValue
If Trim(Cstr(Value)) <> "" Then
If Instr(Ucase(Trim(wRole)),Ucase(Trim(Value))) > 0 Then
HasRole = True
vrValue = Null
Exit Function
End If
End If
End Forall

End Select
vrValue = Null
End If

Exit Function
ErreurHasRole:
Msgbox "(HasRole) Erreur " + Str(Err) + " : " + Cstr(Error)+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
HasRole = False
Exit Function
End Function[/syntax]

[Aquanotes]

Une autre pour tester 1 seul rôle :
[syntax="ls"]
Function IsMemberRole(sRole As String) As Variant
Dim vEval As Variant
vEval = Evaluate({@ismember("}+sRole+{";@userroles)})
IsMemberRole = vEval(0)
End Function
[/syntax][/code]