Программирование на языке VBScript в системе TechnologiCS
Администрирование прав запуска макросов
Для администрирования запуска макросов хорошо зарекомендовали себя рабочие группы. Если создать рабочую группу "Расчет себестоимости" и добавить пользователей которы осуществляют данную функцию с ролью "Разработка", то
добавив
'1030 -ID рабочей группы "Расчет себестоимости"
WorkGroupID = 0
WorkGroupID = Admin.Work_group(WorkGroupID)
If WorkGroupID <> 0 Then
If WorkGroupID = 1030 Then
...............................................................
End if
End if
Функция обработки где пользователь имеет роль "Разработка"
Function Work_group(WorkGroupID)
Dim UsrGm1
Dim wg
Dim wg_count
Set UsrGm1 = TCSApp.CreateUserGModule( "WorkGroup" )
Call UsrGm1.ClearProps
Call UsrGm1.ClearScripCommands
UsrGm1.ReadOnlyUserMode = False
Call UsrGm1.AddProp( "ID", "Идентификатор", 3, False, False, 0 )
Call UsrGm1.AddProp( "NAME", "Рабочая группа", 1, True, False, 0 )
Call UsrGm1.AddProp( "NOTE", "Права", 1, True, False, 0 )
If TCSApp.Users.Locate("NAME", TCSApp.LoginUserName, 0) Then
Set wg = TCSApp.Users.Properties("WorkGroups").AsIDispatch
wg.First
I = 1
wg_count = 0
While Not wg.EOF
If wg.Properties("OFFICER_NAME").AsString = "Разработка" Then
Call UsrGm1.CreateNew
UsrGm1.Properties("ID").AsInteger = wg.Properties("ID").Value
UsrGm1.Properties("NAME").AsString = wg.Properties("NOTE").Value
UsrGm1.Properties("NOTE").AsString = wg.Properties("OFFICER_NAME").Value
Call UsrGm1.SaveChanges
wg_count = wg_count + 1
End If
wg.Next
I = I + 1
Wend
End If
UsrGm1.First
If wg_count = 1 Then
WorkGroupID = UsrGm1.Properties("ID").AsInteger
Else
Id = UsrGm1.RunModuleForSelect( "Выбирете рабочую группу",False )
For cnt = 0 To UsrGm1.SelectedRowsCount - 1
If UsrGm1.GotoSelectedRow(cnt) Then
WorkGroupID = UsrGm1.Properties("ID").AsInteger
End If
Next
End If
Work_group = WorkGroupID
End Function
Пример функции, возвращающей фамилию Начальника ТБ цеха. При этом подразумевается, что пользователь, получающий отчет, выполняет роль Разработчик в рабочей группе цеха.
Public Function GetNachTB(IsD, DopIsD, Ms) As String
Dim Usr ' справочник пользователей
Dim WrkGroup_Usr ' Рабочие группы - где задействован пользователь
Dim Id ' Просто Integer
Dim WRK_GROUP_ID ' Идентификатор рабочей группы
Dim UsersWrk ' Пользователи рабочей группы
Dim Wrkgr ' Справочник рабочих групп
Set Usr = TCSApp.Users
Usr.UserModuleName = Usr.UniqueUserModuleName
WRK_GROUP_ID = 0
If Usr.Locate("NAME", TCSApp.LoginUserName, 0) Then
Set WrkGroup_Usr = Usr.Properties("WORKGROUPS").AsIDispatch
WrkGroup_Usr.UserModuleName = WrkGroup_Usr.UniqueUserModuleName
Do While Not WrkGroup_Usr.EOF
If Not (WrkGroup_Usr.Properties("FIRED").AsBoolean) And (InStr(WrkGroup_Usr.Properties("OFFICER_NAME").asstring, "Разработчик") > 0) Then
WRK_GROUP_ID = WrkGroup_Usr.Properties("ID").asInteger
End If
WrkGroup_Usr.Next
Loop
End If
Set Wrkgr = TCSApp.WorkGroups
Wrkgr.UserModuleName = Wrkgr.UniqueUserModuleName
If WRK_GROUP_ID > 0 Then
If Wrkgr.Locate("ID", WRK_GROUP_ID, 0) Then
Set UsersWrk = Wrkgr.Properties("USERS").AsIDispatch
UsersWrk.UserModuleName = UsersWrk.UniqueUserModuleName
If UsersWrk.Locate("OFFICER_NAME", "Начальник ТБ цеха", 0) Then
GetNachTB = UsersWrk.Properties("USER_NAME").asstring
Else
GetNachTB = ""
End If
Call TCSApp.DeleteModuleByUserModuleName(UsersWrk.UserModuleName)
End If
End If
Call TCSApp.DeleteModuleByUserModuleName(Wrkgr.UserModuleName)
Call TCSApp.DeleteModuleByUserModuleName(WrkGroup_Usr.UserModuleName)
Call TCSApp.DeleteModuleByUserModuleName(Usr.UserModuleName)
End Function
Организация универсальной функции при работе с документами. Данная процедура подготавливает данные из разных модулей системы для обработки универсальной функцией.
Sub Add_Doc_Mod(TCSActiveModule, DocNote, DocName, Docs)
If Flag_module_arhiv = "Nom" Then
DocNote = TCSActiveModule.Properties("NOTE").Value
DocName = TCSActiveModule.Properties("NAME").Value
Set Docs = TCSActiveModule.Properties("NomenclatureDocuments").AsIDispatch
Docs.UserModuleName = Docs.UniqueUserModuleName
End If
'-------------------------------------------
If Flag_module_arhiv = "Itog_Spec" Then
DocNote = TCSActiveModule.Properties("NMK_NOTE").Value
DocName = TCSActiveModule.Properties("NMK_NAME").Value
Set Docs = TCSActiveModule.Properties("NomenclatureDocuments").AsIDispatch
Docs.UserModuleName = Docs.UniqueUserModuleName
End If
'---------------------------------------
If Flag_module_arhiv = "Spec" Then
DocNote = TCSActiveModule.Properties("NMK_NOTE").Value
DocName = TCSActiveModule.Properties("NMK_NAME").Value
Set NMK_Sign = TCSApp.SingleNmkFromId(TCSActiveModule.Properties("NMK_ID").Value)
Set Docs = NMK_Sign.Properties("NomenclatureDocuments").AsIDispatch
Docs.UserModuleName = Docs.UniqueUserModuleName
End If
End Sub