Function LSL_USERS_SERVICES(@Service, @Params) /*********************************************************************************************************************** Name : LSL_USERS_Services Description : Handler program for all module related services. Notes : Service module to support environmental state issues. Environmental refers to the state of the operating system, which includes version, client vs. server, and path to critical systems. Parameters : Service [in] -- Name of the service being requested Param1-10 [in/out] -- Additional request parameter holders Response [out] -- Response to be sent back to the Controller (MCP) or requesting procedure Metadata : History : (Date, Initials, Notes) 04/27/2020 jro Original programmer. ***********************************************************************************************************************/ #pragma precomp SRP_PreCompiler $insert LOGICAL $insert SERVICE_SETUP $Insert LSL_USERS_EQU $Insert RLIST_EQUATES $Insert NOTIFICATION_EQUATES $Insert SEC_GROUPS_EQUATES equ crlf$ to \0D0A\ equ tab$ to char(09) equ comma$ to char(44) equ space$ to char(32) equ record$ to char(00) equ scolon$ to char(59) EQU MONDAY$ to 1 EQU TUESDAY$ to 2 EQU WEDNESDAY$ to 3 EQU THURSDAY$ to 4 EQU FRIDAY$ to 5 EQU SATURDAY$ to 6 EQU SUNDAY$ to 7 Declare Function Get.RecCount, SRP_Datetime, Datetime, SRP_MATH, Lsl_Users_Services, Active_Directory_Services Declare Function DCount, Database_Services, Environment_Services, SRP_Array, Logging_Services Declare subroutine Btree.Extract, Logging_Services LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\LSLUsers' LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' Notification Groups Update Log.csv' Headers = 'Logging DTM' : @FM : 'Notification ID' : @FM : 'Notes' objNotificationLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$) LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' Security Groups Update Log.csv' Headers = 'Logging DTM' : @FM : 'Notification ID' : @FM : 'Notes' objSecGroupsLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$) LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM GoToService else Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' services module.') userFileName = "C:\users\mesouellette\Desktop\user.csv" OSOpen userFileName To hUserFile then OSBWrite 'test failed' On hUserFile at 0 OSClose hUserFile end end Return Response OR '' //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Services //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //---------------------------------------------------------------------------------------------------------------------- // Export Users //---------------------------------------------------------------------------------------------------------------------- Service ExportUsers() hSysLists = Database_Services('GetTableHandle', 'SYSLISTS') Lock hSysLists, ServiceKeyID then userFileName = '\\10.95.104.24\App_Data\user.csv' OSOpen userFileName To hUserFile then Open "APP_INFO" To USER_AD_TABLE Else status = Set_FSError() Return End lastByte = 0 ReadV ADNames FROM USER_AD_TABLE, "AD_TO_LSL_USER_MAP",1 then Count = count(ADNames, @VM) + 1 ReadV OINames FROM USER_AD_TABLE, "AD_TO_LSL_USER_MAP",2 then For index = 1 To Count ADName = Field(ADNames, @VM, index) OIName = Field(OINames, @VM, index) fNAME = Xlate("LSL_USERS", OIName, "FIRST", "X") lNAME = Xlate("LSL_USERS", OIName, "LAST", "X") ActiveStatus = Xlate("LSL_USERS", OIName, "Active", "X") Groups = Xlate("LSL_USERS", OIName, "GROUPS", "X") Tables = Xlate("LSL_USERS", OIName, "Tables", "X") swap @vm with scolon$ in Groups swap @vm with scolon$ in Tables line = ADName:",":OIName:",":fNAME:",":lNAME:",":ActiveStatus:",":Groups:",":Tables : CRLF$ OSBWrite line On hUserFile At lastByte lastByte = lastByte + Len(line) Next end end osclose hUserFile end Unlock hSysLists, ServiceKeyID else Null end end service Service GetGroups() Groups = '' Sentence = 'SELECT SEC_GROUPS BY GROUP' rv = Set_Status(0) RList(Sentence, TARGET_ACTIVELIST$, '', '', '') If (@List_Active EQ 3) AND (@RecCount GT 0) then EOF = False$ Loop Readnext GroupID else EOF = True$ Until EOF EQ True$ Groups := GroupID : @FM Repeat end Groups[-1, 1] = '' Response = Groups end service Service GetMembersInGroup(GroupList) Members = '' If GroupList NE '' then GroupsToSearch = 'GROUPS' for each Group in GroupList using @FM GroupsToSearch := @VM : Group Next Group GroupsToSearch := @FM Keys = '' Table = 'LSL_USERS' DictVar = Database_Services('GetTableHandle', 'DICT.LSL_USERS') Btree.Extract(GroupsToSearch, Table, DictVar, Keys, '', Flag) IF Flag EQ 0 then for each UserName in Keys using @VM UserRec = Database_Services('ReadDataRow', 'LSL_USERS', UserName) FullName = UserRec : ' ' : UserRec Members := UserName : @VM : FullName : @FM Next Key Members[-1,1] = '' end else Error_Services('Add', 'Error calling Btree Extract in ' : Service : ' service.') end end else Error_Services('Add', 'GroupList was missing in the ' : Service : ' service.') end response = Members end service Service GetOnShiftUsersByClass(Class, IncludeNextShift) DatetimeNow = OConv(SRP_DateTime("Now"), 'DT') NextShiftTime = OConv(SRP_Datetime('AddHours', Datetime(), 12) , 'DT') CurrentShift = Lsl_Users_Services('GetShiftByDate', DatetimeNow) IF IncludeNextShift then CurrentShift := @VM : Lsl_Users_Services('GetShiftByDate', NextShiftTime) end Open 'DICT.LSL_USERS' to DictLSLUsers then SearchString = '' SearchString := 'CLASSIFICATION':@VM:Class:@FM SearchString := 'SHIFT' For each Shift in CurrentShift using @VM setting vPos SearchString := @VM : Shift Next Shift SearchString := @VM : '' : @FM ; // Include office personnel (i.e. no shift assigned) SearchString := 'ACTIVE' : @VM : True$ : @FM LSLUsersKeys = '' Btree.Extract(SearchString, 'LSL_USERS', DictLSLUsers, LSLUsersKeys, '', '') ErrCode = '' IF Get_Status(ErrCode) then ErrorMsg = 'Error in ':Service:' service. Error calling Btree.Extract. Error code ':ErrCode:'.' end Response = LSLUsersKeys end else ErrorMsg = 'Error in ':Service:' service. Error opening LSL_USERS dictionary.' end end service Service GetOnShiftUsers() DatetimeNow = OConv(SRP_DateTime("Now"), 'DT') CurrentShift = Lsl_Users_Services('GetShiftByDate', DatetimeNow) Open 'DICT.LSL_USERS' to DictLSLUsers then SearchString = '' SearchString := 'SHIFT' : @VM : CurrentShift : @VM : '' : @FM ; // Include office personnel (i.e. no shift assigned) SearchString := 'ACTIVE' : @VM : True$ : @FM LSLUsersKeys = '' Btree.Extract(SearchString, 'LSL_USERS', DictLSLUsers, LSLUsersKeys, '', '') ErrCode = '' IF Get_Status(ErrCode) then ErrorMsg = 'Error in ':Service:' service. Error calling Btree.Extract. Error code ':ErrCode:'.' end Response = LSLUsersKeys end else ErrorMsg = 'Error in ':Service:' service. Error opening LSL_USERS dictionary.' end end service Service GetShiftByDate(Date, GenerateFlag) OnShift = ''; *Return Value if Date EQ '' then Error_Services('Add', 'Error in LSL_USERS_SERVICES. No Date Supplied.') return end DateConv = Iconv(Date, "DT") CalStartDate = 19005; *Arbitrary Start Date to base calendar off of. Jan 12, 2020 Beginning of short shift 1 DaysSinceStart = SRP_DateTime("DaySpan", CalStartDate, DateConv, 0) WeeksSinceStart = SRP_Math("FLOOR", DaysSinceStart / 7) WeekType = '' /* There are two different types of week the pattern goes 1 week is a long week for shift 1 and the next is a long week for shift 3(The two day shifts) */ if SRP_Math("EVEN", WeeksSinceStart) AND WeeksSinceStart GE 1 then WeekType = 'Long1' end else WeekType = 'Long3' end WeekDay = SRP_DateTime("DayOfWeek", DateConv) ShiftTime = SRP_DateTime("Time", DateConv) IF ShiftTime GE 21600 AND ShiftTime LT 64800 then; //6AM and 6PM DayOrNight = 'Day' end else DayOrNight = 'Night' end /* We set up profiles for what a long 1 week has for shift schedules and what a long 3 week has for shift schedules. This does not change. */ Begin Case Case WeekType = 'Long1' Begin Case Case Weekday EQ SUNDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'A' Case DayOrNight EQ 'Night' OnShift = 'B' End Case Case Weekday EQ MONDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'A' Case DayOrNight EQ 'Night' OnShift = 'B' End Case Case Weekday EQ TUESDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'A' Case DayOrNight EQ 'Night' OnShift = 'B' End Case Case Weekday EQ WEDNESDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'A' Case DayOrNight EQ 'Night' if ShiftTime LT 21600 then OnShift = 'B' end else OnShift = 'D' end End Case Case Weekday EQ THURSDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'C' Case DayOrNight EQ 'Night' OnShift = 'D' End Case Case Weekday EQ FRIDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'C' Case DayOrNight EQ 'Night' OnShift = 'D' End Case Case Weekday EQ SATURDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'C' Case DayOrNight EQ 'Night' OnShift = 'D' End Case End Case Case WeekType = 'Long3' Begin Case Case Weekday EQ SUNDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'A' Case DayOrNight EQ 'Night' if ShiftTime LT 21600 then OnShift = 'D' end else OnShift = 'B' end End Case Case Weekday EQ MONDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'A' Case DayOrNight EQ 'Night' OnShift = 'B' End Case Case Weekday EQ TUESDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'A' Case DayOrNight EQ 'Night' OnShift = 'B' End Case Case Weekday EQ WEDNESDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'C' Case DayOrNight EQ 'Night' if ShiftTime LT 21600 then OnShift = 'B' end else OnShift = 'D' end End Case Case Weekday EQ THURSDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'C' Case DayOrNight EQ 'Night' OnShift = 'D' End Case Case Weekday EQ FRIDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'C' Case DayOrNight EQ 'Night' OnShift = 'D' End Case Case Weekday EQ SATURDAY$ Begin Case Case DayOrNight EQ 'Day' OnShift = 'C' Case DayOrNight EQ 'Night' if ShiftTime LT 21600 then OnShift = 'D' end else OnShift = 'B' end End Case End Case End Case Response = OnShift end service Service UpdateNotificationGroups() hSysLists = Database_Services('GetTableHandle', 'SYSLISTS') Lock hSysLists, ServiceKeyID then Open 'NOTIFICATION' to hTable then EOF = False$ Select hTable Loop ReadNext KeyId else EOF = True$ Until EOF Lock hTable, KeyId then Read Rec from hTable, KeyId then UseAD = Rec If UseAD then LSLUserList = '' // Update LSL_User list based on current members in Active Directory groups ADGroups = Rec For each GroupName in ADGroups using @VM MemberList = Active_Directory_Services('GetADGroupMembersByGroupName', GroupName, 'INFINEON') MemberList = SRP_Array('Rotate', MemberList, @FM, @VM) ADUserNames = MemberList<1> LSLUserNames = '' LSLNames = '' Open 'DICT.LSL_USERS' to hDict then For each ADUserName in ADUserNames using @VM setting vPos Query = 'DOMAIN_USERNAME':@VM:ADUserName:@FM:'ACTIVE':@VM:True$:@FM Flag = '' LSLUsername = '' Btree.Extract(Query, 'LSL_USERS', hDict, LSLUsername, '', Flag) If Flag EQ 0 then If LSLUsername NE '' then LSLUserList<0, -1> = LSLUsername end else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'No LSL_USERS record found for active directory member "':ADUserName:'".' Logging_Services('AppendLog', objNotficationLog, LogData, @RM, @FM) end end else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'Btree.Extract call failed for DOMAIN_USERNAME "':ADUserName:'".' Logging_Services('AppendLog', objNotficationLog, LogData, @RM, @FM) end Next ADUserName end Next GroupName LSLUserList = SRP_Array('Clean', LSLUserList, 'TrimAndMakeUnique', @VM) LSLUserList = SRP_Array('SortSimpleList', LSLUserList, 'AscendingText', @VM) Rec = LSLUserList Write Rec on hTable, KeyId else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'Failed to write record during update.' Logging_Services('AppendLog', objNotficationLog, LogData, @RM, @FM) end end end else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'Failed to read record during update.' Logging_Services('AppendLog', objNotficationLog, LogData, @RM, @FM) end Unlock hTable, KeyId else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'Failed to unlock record during update.' Logging_Services('AppendLog', objNotficationLog, LogData, @RM, @FM) end end Repeat end Unlock hSysLists, ServiceKeyID else Null end end service Service UpdateSecurityGroups() hSysLists = Database_Services('GetTableHandle', 'SYSLISTS') Lock hSysLists, ServiceKeyID then Open 'SEC_GROUPS' to hTable then EOF = False$ Select hTable Loop ReadNext KeyId else EOF = True$ Until EOF Lock hTable, KeyId then Read Rec from hTable, KeyId then UseAD = Rec If UseAD then LSLUserList = '' // Update LSL_User list based on current members in Active Directory groups ADGroups = Rec For each GroupName in ADGroups using @VM MemberList = Active_Directory_Services('GetADGroupMembersByGroupName', GroupName, 'INFINEON') MemberList = SRP_Array('Rotate', MemberList, @FM, @VM) ADUserNames = MemberList<1> LSLUserNames = '' LSLNames = '' Open 'DICT.LSL_USERS' to hDict then For each ADUserName in ADUserNames using @VM setting vPos Query = 'DOMAIN_USERNAME':@VM:ADUserName:@FM:'ACTIVE':@VM:True$:@FM Flag = '' LSLUsername = '' Btree.Extract(Query, 'LSL_USERS', hDict, LSLUsername, '', Flag) If Flag EQ 0 then If LSLUsername NE '' then LSLUserList<0, -1> = LSLUsername end else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'No LSL_USERS record found for active directory member "':ADUserName:'".' Logging_Services('AppendLog', objSecGroupsLog, LogData, @RM, @FM) end end else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'Btree.Extract call failed for DOMAIN_USERNAME "':ADUserName:'".' Logging_Services('AppendLog', objSecGroupsLog, LogData, @RM, @FM) end Next ADUserName end Next GroupName LSLUserList = SRP_Array('Clean', LSLUserList, 'TrimAndMakeUnique', @VM) LSLUserList = SRP_Array('SortSimpleList', LSLUserList, 'AscendingText', @VM) Rec = LSLUserList Write Rec on hTable, KeyId else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'Failed to write record during update.' Logging_Services('AppendLog', objSecGroupsLog, LogData, @RM, @FM) end end end else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'Failed to read record during update.' Logging_Services('AppendLog', objSecGroupsLog, LogData, @RM, @FM) end Unlock hTable, KeyId else LogData = '' LogData<1> = LoggingDtm LogData<2> = KeyId LogData<3> = 'Failed to unlock record during update.' Logging_Services('AppendLog', objSecGroupsLog, LogData, @RM, @FM) end end Repeat end Unlock hSysLists, ServiceKeyID else Null end end service