Вот какую функцию я написал для проверки роли текущего пользователя:
Function CheckCurUserRole(ByVal Doc_ID, ByVal Role_ID)
'Doc_ID - ИД документа
'Role_ID - ИД проверяемой роли
Dim SingleDoc, Users, WGroups, ShowGrpAction, Filter
Dim Role_Name, User_Name
Role_Name = GetRoleName(Role_ID)
User_Name = TCSApp.LoginUserName
Set SingleDoc = TCSApp.SingleDoc(2, Doc_ID) ' По ИД
Call SingleDoc.Refresh
'
Set Users = SingleDoc.Properties("USERS").AsIDispatch
If Not Users.IsEmpty Then
If Users.Locate("NAME", TCSAPP.LoginUserName, 0) Then
If Users.Properties("OFFICER_ID").AsInteger = Role_ID Then
CheckCurUserRole = True
Set Users = Nothing
Set SingleDoc = Nothing
'Дальше искать нет смысла - роль, указанная в доступе отдельных пользователей имеет преимущество
' перед теми, что заданы в доступе групп
Exit Function
Else
CheckCurUserRole = False
Exit Function
End If
End If
End If
Set Users = Nothing
'
Set WGroups = SingleDoc.ChildModules.ModuleByName("PrjVerRights").AsIDispatch
If Not WGroups Is Nothing Then
If WGroups.IsEmpty Then
CheckCurUserRole = False
Else
Set ShowGrpAction = WGroups.ActionList.ActionByName("ShowGrpAction")
If Not ShowGrpAction Is Nothing Then ShowGrpAction.Execute
'Создаём фильтр
Set Filter = WGroups.Filter
Call Filter.ClearFilter
Call Filter.NewFilterItem(WGroups.Properties("USER_NAME"),0,User_Name) 'По пользователю
Call Filter.NewFilterItem(WGroups.Properties("OFFICER_NAME"),0, Role_Name) 'По роли
Call Filter.ApplyFilter
WGRoups.Refresh
If WGRoups.IsEmpty Then
CheckCurUserRole = False
Else
CheckCurUserRole = True
End If
Call Filter.ClearFilter
Set Filter = Nothing
Set ShowGrpAction = Nothing
End If
End If
'CheckCurUserRole = False
Set WGroups = Nothing
Set SingleDoc = Nothing
End Function
Здесь использована ещё одна моя функция GetRoleName:
Function GetRoleName(ByVal Role_ID) ' Название роли по её ID
Dim Roles
Set Roles = TCSApp.Roles
If Not Roles Is Nothing Then
If Roles.Locate("ID", Role_ID, 0) Then
GetRoleName=Roles.Properties("NAME").AsSafeString
Else
GetRoleName=""
End If
End If
Set Roles = Nothing
End Function
Может быть, кому-нибуть это пригодится :)