Открытие доступа к объекту

Option explicit

call main(ThisObject)

sub main(obj)
' процедура назначения пользователей на роль
' выбирается из диалога пользователя или группы
dim usersDlg
dim selectedUsers, selectedGroups
dim user, group
dim usersTable
dim objRoles
dim eBody
obj.Permissions = SysAdminPermissions
set objRoles = obj.Roles

' диалог выбора
set usersDlg = ThisApplication.Dialogs.SelectUserDlg
usersDlg.Show
if usersDlg.Groups.Count > 0 then
' если выбрали хоть одну группу
set selectedGroups = usersDlg.Groups
' для каждой группы
for each group in selectedGroups
' добавить роль на группу
eBody = ""
call addRole(objRoles, group.SysName, eBody)
if eBody <> "" then
eBody = eBody + " группе пользователей "
call SendmailMsg(group, obj, eBody)
end if 
next
end if

if usersDlg.Users.Count > 0 then
' если выбрали хоть одного пользователя
set selectedUsers = usersDlg.Users
' для каждого пользователя
for each user in selectedUsers
' добавить этих пользователей
eBody = ""
call addRole(objRoles, user.SysName, eBody)
if eBody <> "" then
eBody = eBody + " пользователю "
call SendMailMsg(user, obj, eBody)
end if
next
end if
end sub

Function roleExists(objRoles, roleName, userName)
dim role

roleExists = False
for each role in objRoles
if role.User is nothing then
roleExists = roleExists or ((role.RoleDef.SysName = roleName) and _
(role.Group.SysName = userName))
else
roleExists = roleExists or ((role.RoleDef.SysName = roleName) and _
(role.User.SysName = userName))
end if
next
End Function


Sub addRole(objRoles, userName, eBody)

dim role, roleName, dsRole
dim arr(), rearr
dim slDlg
dim slRoles, i

set slRoles = ThisApplication.RoleDefs

i = 0
for each role in slRoles
i = i + 1 
ReDim Preserve arr(i)
set arr(i) = role
next
set slDlg = ThisApplication.Dialogs.SelectDlg
slDlg.SelectFrom = arr
if slDlg.Show = False then
Exit sub
else
rearr = slDlg.Objects
if ubound(slDlg.Objects) = 0 then
set role = rearr(0)
roleName = role.sysname
dsRole = role.Description 
else if ubound(slDlg.Objects) > 0 then
msgbox("выбрано слишком много ролей")
Exit sub
end if
end if
end if

if not roleExists(objRoles, roleName, userName) then
set role = objRoles.create(roleName, userName)
eBody = "Назначена роль " & Chr(34) & dsRole & Chr(34)
else MsgBox "Такая роль уже существует на объекте!", vbExclamation
end if

End Sub

sub SendMailMsg(mList, mObj, eBody)

dim objMail

Set objMail = ThisApplication.CreateMessage
' Заполняем свойства сообщения
objMail.Subject = "Назначение роли" 'тема сообщения
eBody = eBody & Chr(34) & mList.Description & Chr(34) & " на объект " & Chr(34) & mObj.Description & Chr(34)
objMail.Body = eBody 'тело письма
objMail.To = mList 'кому отправляем
objMail.Attachments.Add(mObj) 'прибиваем объект к письму, чтобы долго не искать потом что же за объект
' Отсылаем сообщение
objMail.Send
end sub