<%@ Language=VBScript %> <% Response.Buffer = TRUE %> <% ' Script Name : aspWebCalendar ' File Name : calendar.asp ' Version : 3.5 ' Release Date : 5/16/2003 ' ' Copyright (c) 2003 by Full Revolution, Inc., All Rights Reserved %> <% Dim MiniOutput If Session("ConfigLoaded") <> "YES" then Call LoadConfig End If User1 = Session("User1") User2 = Session("User2") User3 = Session("User3") User4 = Session("User4") User5 = Session("User5") SiteTitle = Session("SiteTitle") RequireLogin = Session("RequireLogin") PopupBackColor = Session("PopupBackColor") TimeZoneBias = Session("TimeZoneBias") MiniSundayName = Session("MiniSundayName") MiniMondayName = Session("MiniMondayName") MiniTuesdayName = Session("MiniTuesdayName") MiniWednesdayName = Session("MiniWednesdayName") MiniThursdayName = Session("MiniThursdayName") MiniFridayName = Session("MiniFridayName") MiniSaturdayName = Session("MiniSaturdayName") SkinFolder = Session("SkinFolder") LanguageFolder = Session("LanguageFolder") ScriptLCID = Session("ScriptLCID") CountryCode = Session("CountryCode") EmailComponent = Session("EmailComponent") EmailHost = Session("EmailHost") SendFromEmailAddress = Session("SendFromEmailAddress") DateFormat = CountryCode Session.LCID = ScriptLCID Session("DateFormat") = CountryCode PageHeader = "" & SiteTitle & "" MonthSundayName = WeekDayName(1) MonthMondayName = WeekDayName(2) MonthTuesdayName = WeekDayName(3) MonthWednesdayName = WeekDayName(4) MonthThursdayName = WeekDayName(5) MonthFridayName = WeekDayName(6) MonthSaturdayName = WeekDayName(7) '******* Added for 3.5 release ************************************ UseEmailFunctions = "YES" UseInviteFunction = "NO" StartDaysAtEight = "YES" ServerAddress = request.ServerVariables("HTTP_HOST") CalendarURL2 = request.ServerVariables("URL") FullURL = "http://" & ServerAddress & left(CalendarURL2, len(CalendarURL2) - 19) & "/calendar.asp" PathToCalendar = "http://" & ServerAddress & left(CalendarURL2, len(CalendarURL2) - 12) ShowRollInfo = "YES" TimeFormatToUse = "12" 'Set to 12 or 24 '******* Pull In Config From DB ************************************ Sub LoadConfig If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Config" Else SQL = "SELECT * FROM Cal_Config" End If Set RS=dbc.execute(SQL) Session("User1") = RS("Cal_ConfigUserField1") Session("User2") = RS("Cal_ConfigUserField2") Session("User3") = RS("Cal_ConfigUserField3") Session("User4") = RS("Cal_ConfigUserField4") Session("User5") = RS("Cal_ConfigUserField5") Session("SiteTitle") = RS("Cal_ConfigSiteTitle") Session("RequireLogin") = RS("Cal_ConfigRequireLogin") Session("PopupBackColor") = RS("Cal_ConfigPopupBackColor") Session("TimeZoneBias") = RS("Cal_ConfigTimeZone") Session("MiniSundayName") = RS("Cal_ConfigMiniSundayName") Session("MiniMondayName") = RS("Cal_ConfigMiniMondayName") Session("MiniTuesdayName") = RS("Cal_ConfigMiniTuesdayName") Session("MiniWednesdayName") = RS("Cal_ConfigMiniWednesdayName") Session("MiniThursdayName") = RS("Cal_ConfigMiniThursdayName") Session("MiniFridayName") = RS("Cal_ConfigMiniFridayName") Session("MiniSaturdayName") = RS("Cal_ConfigMiniSaturdayName") Session("SkinFolder") = RS("Cal_ConfigSkinFolder") Session("LanguageFolder") = RS("Cal_ConfigLanguageFolder") Session("ScriptLCID") = RS("Cal_ConfigLCID") Session("CountryCode") = RS("Cal_ConfigCountryCode") Session("ConfigLoaded") = "YES" Session("EmailComponent") = RS("Cal_ConfigEmailComponent") Session("EmailHost") = RS("Cal_ConfigEmailHost") Session("SendFromEmailAddress") = RS("Cal_ConfigSendFromAddress") RS.Close Set RS=Nothing End Sub '****** Some Java Functions and Page Header ************************************************* If request.querystring("action") <> "eventlist" AND request.querystring("action") <> "embedmini" and request.querystring("action") <> "vcalexport" then response.write PageHeader %> <% End If '********* Include the CSS from the current skin ******************************** If request.querystring("action") <> "eventlist" AND request.querystring("action") <> "embedmini" and request.querystring("action") <> "vcalexport" then SkinFile= SkinFolder & "calendar.css" Call ReadSkinFile(SkinFile) SUB ReadSkinFile(FileToRead) SkinFile=server.mappath(FileToRead) Set fs = CreateObject("Scripting.FileSystemObject") Set thisfile = fs.OpenTextFile(Skinfile, 1, False) tempSTR=thisfile.readall response.write replace(tempSTR, "$$SKINFOLDER", SkinFolder) thisfile.Close set thisfile=nothing set fs=nothing END SUB %> <% End If '******** Find out what we should be doing ************************************** '----------- Figure out the current view information ----------------------------- 'If request.querystring("view") <> "" and request.querystring("view") <> "0" then ' Session("Cal_CurrentView") = cint(request.querystring("view")) ' SQL = "SELECT * FROM Cal_Views WHERE Cal_ViewID = " & request.querystring("view") ' Set RS=dbc.execute(SQL) ' CalendarType = RS("Cal_ViewCalType") ' Session("Cal_ShowSideBar") = RS("Cal_ViewSideBar") ' Session("Cal_FilterGroups") = RS("Cal_ViewGroups") ' RS.Close ' Set RS=Nothing 'End If If request.querystring("expandlegend") <> "" then Session("Cal_ExpandLegend") = request.querystring("expandlegend") End If If request.querystring("expandfilter") <> "" then Session("Cal_ExpandFilter") = request.querystring("expandfilter") End If If request.querystring("expandlinks") <> "" then Session("Cal_ExpandLinks") = request.querystring("expandlinks") End If If request.querystring("view") = "" or request.querystring("view") = "0" and request.querystring("caltype") = "" then CalendarType = "month" Session("Cal_ShowSideBar") = "YES" End If If request.querystring("date") = "" then theDate = Date() Else theDate = cDate(request.querystring("date")) End If If request.querystring("sidebar") <> "" then Session("Cal_ShowSideBar") = request.querystring("sidebar") End If If Session("Cal_User_ID") = "" then Session("Cal_User_AllGroups") = GetGroupArray("Cal_Group_Type", "PUBLIC") Session("Cal_User_PublicGroups") = Session("Cal_User_AllGroups") If Session("Cal_FilterGroups") = "" then Session("Cal_FilterGroups") = Session("Cal_User_PublicGroups") End If End If If request.querystring("view") = "0" then Session("Cal_CurrentView") = "" Session("Cal_FilterGroups") = Session("Cal_User_AllGroups") End If If request.querystring("filter") <> "" then Session("Cal_FilterGroups") = request.querystring("filter") End If ScriptAction = request.querystring("action") If RequireLogin = "YES" and Session("Cal_User_ID") = "" and request.querystring("action") <> "login" then If request.querystring("action") <> "embedmini" or request.querystring("action") <> "eventlist" then Call MustLogin End If End If If request.querystring("caltype") <> "" then CalendarType = request.querystring("caltype") End If SELECT CASE ScriptAction CASE "" If RequireLogin = "YES" and Session("Cal_User_ID") <> "" OR RequireLogin = "NO" then If CalendarType = "month" or request.querystring("caltype") = "month" then CalendarType = "month" Call WriteHeaderOrFooter("cal_header.asp") Call DrawHeaderBar Call DrawContainerStart Call DrawMonthCalendar(theDate) Call DrawContainerEnd Call WriteHeaderOrFooter("cal_footer.asp") End If If request.querystring("caltype") = "day" or CalendarType = "day" then CalendarType = "day" Call WriteHeaderOrFooter("cal_header.asp") Call DrawHeaderBar Call DrawContainerStart Call DrawDayCalendar(theDate) Call DrawContainerEnd Call WriteHeaderOrFooter("cal_footer.asp") End If If request.querystring("caltype") = "mini" then CalendarType = "mini" Call DrawMiniCalendar(theDate) End If If request.querystring("caltype") = "week" or CalendarType = "week" then CalendarType = "week" Call WriteHeaderOrFooter("cal_header.asp") Call DrawHeaderBar Call DrawContainerStart Call DrawWeekCalendar(theDate) Call DrawContainerEnd Call WriteHeaderOrFooter("cal_footer.asp") End If If request.querystring("caltype") = "year" or CalendarType = "year" then CalendarType = "year" Call WriteHeaderOrFooter("cal_header.asp") Call DrawHeaderBar Call DrawContainerStart Call DrawYearCalendar(theDate) Call DrawContainerEnd Call WriteHeaderOrFooter("cal_footer.asp") End If If request.querystring("caltype") = "listing" or CalendarType = "listing" then CalendarType = "listing" Call WriteHeaderOrFooter("cal_header.asp") Call DrawHeaderBar Call DrawContainerStart Call DrawEventListView(theDate) Call DrawContainerEnd Call WriteHeaderOrFooter("cal_footer.asp") End If End If CASE "summary" Sum_Message = request.querystring("message") Sum_LinkType = request.querystring("linktype") Sum_From = request.querystring("from") Call DrawSummary(Sum_Message, Sum_LinkType, Sum_From) CASE "login" Call DrawLoginPage CASE "processlogin" Call ProcessLogin Case "logoff" Call Logoff CASE "viewoptions" Call ViewOptions CASE "eventdetail" Call DrawEventPopup CASE "eventlist" Call DrawEventListing(request.querystring("date"), request.querystring("range"), request.querystring("type")) CASE "embedmini" Call DrawMiniCalendar(theDate) CASE "processinvites" Call ProcessInvites CASE "processfilter" Call ProcessFilter CASE "vcalexport" Call ExportVCal(theDate, request.querystring("caltype")) CASE "emailuser" Call SendUserEmail CASE "emailuserprocess" SendFromEmailAddress = Session("Cal_User_EmailAddress") Call SendUserEmailProcess CASE ELSE END SELECT '********************************************************************************* '********************************************************************************* '********************************************************************************* '********************************************************************************* '************************* Routines Below Here Only ****************************** '********************************************************************************* '********************************************************************************* '********************************************************************************* '********************************************************************************* '********************************************************************************* '********************************************************************************* '******** Draw Container Table Start ********************************************* '********************************************************************************* Sub DrawContainerStart If Session("Cal_ShowSideBar") = "YES" then response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" End Sub '********************************************************************************* '******** Draw Week View ********************************************************* '********************************************************************************* Sub DrawWeekCalendar(theDate) If Session("DateFormat") = "US" then ThisMonthsFirstDay = cDate(Month(theDate) & "/1/" & Year(theDate)) Else ThisMonthsFirstDay = cDate("1/" & Month(theDate) & "/" & Year(theDate)) End If NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) WeekDayTitleName = Weekday(theDate, 2) HeaderInfo = Sub3Var1 & DateAdd("w", 1-WeekDayTitleName, theDate) DateToSend = DateAdd("w", 1-WeekDayTitleName, theDate) DayNameNumber = Weekday(theDate, 2) response.write "
" Call DrawSideBar response.write "" Else response.write "" response.write "" response.write "" response.write "" response.write "
" End If End Sub '********************************************************************************* '******** Draw Container Table End *********************************************** '********************************************************************************* Sub DrawContainerEnd response.write "
" End Sub '********************************************************************************* '******** Draw Side Bar ********************************************************** '********************************************************************************* Sub DrawSideBar response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write "" response.write "" response.write "
" response.write "" If Session("Cal_ExpandFilter") = "NO" then response.write " " Else response.write " " End If response.write Sub1Var24 response.write "
" If Session("Cal_ExpandFilter") <> "NO" then 'Call DrawViews Call DrawFilter End If response.write "
" response.write "" response.write "" response.write "" response.write "
" response.write "" If Session("Cal_ExpandLegend") = "NO" then response.write " " Else response.write " " End If response.write Sub1Var19 response.write "
" If Session("Cal_ExpandLegend") <> "NO" then Call DrawLegend End If response.write "
" response.write "" response.write "" response.write "" response.write "
" response.write "" If Session("Cal_ExpandLinks") = "NO" then response.write " " Else response.write " " End If response.write Sub1Var29 response.write "
" If Session("Cal_ExpandLinks") <> "NO" then Call DrawQuickLinks End If response.write "
" End Sub '********************************************************************************* '******** Draw Views ************************************************************* '********************************************************************************* Sub DrawViews response.write "" response.write "" response.write "" response.write "
" response.write "" response.write Sub1Var25 response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" SQL = "SELECT * FROM Cal_Views WHERE Cal_ViewUserID = 0 ORDER BY Cal_ViewName" Set RS=dbc.execute(SQL) If RS.EOF then response.write Sub1Var27 End If response.write " onclick="window.location.href='calendar.asp?view=0'"<% response.write "> " & Sub1Var32 & "
" Do While NOT RS.EOF response.write " onclick="window.location.href='calendar.asp?view=<%=RS("Cal_ViewID")%>'"<% response.write "> " & RS("Cal_ViewName") & "" response.write "
" RS.MoveNext Loop RS.Close Set RS=Nothing response.write "
" If Session("Cal_User_ID") <> "" then response.write "" response.write "" response.write "" response.write "
" response.write "" response.write Sub1Var26 response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" SQL = "SELECT * FROM Cal_Views WHERE Cal_ViewUserID = " & Session("Cal_User_ID") & " ORDER BY Cal_ViewName" Set RS=dbc.execute(SQL) If RS.EOF then response.write Sub1Var28 End If Do While NOT RS.EOF response.write " " & RS("Cal_ViewName") & "
" RS.MoveNext Loop RS.Close Set RS=Nothing response.write "
" End If End Sub '********************************************************************************* '******** Draw Quick Links ******************************************************* '********************************************************************************* Sub DrawQuickLinks response.write "" response.write "" response.write "" response.write "
" response.write "" response.write Sub1Var30 response.write "
" ThePreviousMonth = DateAdd("m", -1, theDate) TheNextMonth = DateAdd("m", 1, theDate) response.write "
" response.write "" response.write "" response.write "" response.write "
" Call DrawMiniCalendar(ThePreviousMonth) response.write "
" response.write "
" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write Sub1Var31 response.write "
" response.write "
" response.write "" response.write "" response.write "" response.write "
" Call DrawMiniCalendar(TheNextMonth) response.write "
" response.write "
" End Sub '********************************************************************************* '******** Draw Legend ************************************************************ '********************************************************************************* Sub DrawLegend LegendColCounter = 1 FilterGroups = Session("Cal_User_AllGroups") response.write "" If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Group WHERE Cal_Group_ID IN("& FilterGroups &") ORDER BY Cal_Group_Name" Else SQL = "SELECT * FROM Cal_Group WHERE Cal_Group_ID IN("& FilterGroups &") ORDER BY Cal_Group_Name" End If Set RS=dbc.execute(SQL) Do While NOT RS.EOF If RS("Cal_Group_ID") <> 2 then GroupColor = RS("Cal_Group_Color") GroupName = RS("Cal_Group_Name") Else GroupColor = Session("Cal_User_EventColor") GroupName = RS("Cal_Group_Name") End If If LegendColCounter = 1 then response.write "" End If response.write "" If LegendColCounter = 2 then response.write "" LegendColCounter = 1 Else LegendColCounter = 2 End If RS.MoveNext Loop response.write "
" response.write "" response.write "" & GroupName & "
" response.write "
" End Sub '********************************************************************************* '******** Draw Filter ************************************************************ '********************************************************************************* Sub DrawFilter LegendColCounter = 1 FilterGroups = Session("Cal_User_AllGroups") response.write "" response.write "" If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Group WHERE Cal_Group_ID IN("& FilterGroups &") ORDER BY Cal_Group_Name" Else SQL = "SELECT * FROM Cal_Group WHERE Cal_Group_ID IN("& FilterGroups &") ORDER BY Cal_Group_Name" End If Set RS=dbc.execute(SQL) Do While NOT RS.EOF If RS("Cal_Group_ID") <> 2 then GroupColor = RS("Cal_Group_Color") GroupName = RS("Cal_Group_Name") Else GroupColor = Session("Cal_User_EventColor") GroupName = RS("Cal_Group_Name") End If If LegendColCounter = 1 then response.write "" End If response.write "" If LegendColCounter = 2 then response.write "" LegendColCounter = 1 Else LegendColCounter = 2 End If RS.MoveNext Loop response.write "" response.write "" response.write "
" response.write "" response.write "" response.write "" & GroupName & "
" End Sub '********************************************************************************* '******** Draw Header Bar ******************************************************** '********************************************************************************* Sub DrawHeaderBar HeaderText = CalendarType SELECT CASE HeaderText CASE "month" HeaderInfo = MonthName(Month(theDate)) & " " & Year(theDate) If Month(theDate) > 1 then PrevMonth = Month(theDate) - 1 PrevYear = Year(theDate) Else PrevMonth = 12 PrevYear = Year(theDate) - 1 End If If Month(theDate) < 12 then NextMonth = Month(theDate) + 1 NextYear = Year(theDate) Else NextMonth = 1 NextYear = Year(theDate) + 1 End If If Session("DateFormat") = "US" then PrevDate = PrevMonth & "/" & 1 & "/" & PrevYear NextDate = NextMonth & "/" & 1 & "/" & NextYear Else PrevDate = 1 & "/" & PrevMonth & "/" & PrevYear NextDate = 1 & "/" & NextMonth & "/" & NextYear End If CASE "day" HeaderInfo = FormatDateTime(theDate,1) PrevDate = cDate(theDate) - 1 NextDate = cDate(theDate) + 1 CASE "week" WeekDayTitleName = Weekday(theDate, 2) WeekDayTitleName = "Week of " & DateAdd("w", 1-WeekDayTitleName, theDate) HeaderInfo = WeekDayTitleName PrevDate = DateAdd("ww", -1, theDate) NextDate = DateAdd("ww", 1, theDate) CASE "workweek" WeekDayTitleName = Weekday(theDate, 2) WeekDayTitleName = "Work Week of " & DateAdd("w", 1-WeekDayTitleName, theDate) HeaderInfo = WeekDayTitleName PrevDate = DateAdd("ww", -1, theDate) NextDate = DateAdd("ww", 1, theDate) CASE "year" PrevDate = DateAdd("yyyy", -1, theDate) NextDate = DateAdd("yyyy", 1, theDate) HeaderInfo = "Year View of " & Year(theDate) CASE "listing" PrevDate = DateAdd("m", -1, theDate) NextDate = DateAdd("m", 1, theDate) HeaderInfo = MonthName(Month(theDate)) & " " & Year(theDate) & " - " & MonthName(Month(DateAdd("m", 2, theDate))) & " " & Year(DateAdd("m", 2, theDate)) END SELECT %> <% If request.querystring("print") = "YES" then response.write "" End If response.write "" response.write "" response.write "" response.write "" response.write "" If StartDaysAtEight = "YES" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "" If StartDaysAtEight = "YES" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "" 'response.write "" If request.querystring("print") <> "YES" then response.write "" Else response.write "" End If %><% response.write "" If Session("Cal_User_ID") <> "" then %><% End If If UseEmailFunctions <> "NO" then %><% End If If Session("Cal_ShowSideBar") <> "YES" then response.write "" Else response.write "" End If If Session("Cal_User_ID") = "" then %><% End If response.write "" If Session("Cal_User_ID") <> "" Then If Session("Cal_User_RightsLevel") = 1 then response.write "" %><% %><% %><% %><% %><% response.write "" End If response.write "" End If response.write "" End Sub '********************************************************************************* '******** Draw Day View ******************************************************** '********************************************************************************* Sub DrawDayCalendar(theDate) If Session("DateFormat") = "US" then ThisMonthsFirstDay = cDate(Month(theDate) & "/1/" & Year(theDate)) Else ThisMonthsFirstDay = cDate("1/" & Month(theDate) & "/" & Year(theDate)) End If NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) response.write "
Previous
" response.write HeaderInfo response.write "
Next" & Sub1Var2 & "" & Sub1Var2 & "" & Sub1Var3 & "" & Sub1Var4 & "" & Sub1Var5 & "" & Sub1Var6 & "" & Sub1Var6 & "" & Sub1Var7 & "" & Sub1Var8 & "" & Sub1Var9 & "" & Sub1Var9 & "" & Sub1Var9 & "&date=<%=theDate%>" onclick="NewWindow(this.href,'aspWebCalendar','400','350','no');return false"><%=Sub1Var10%><%=Sub1Var11%><%=Sub1Var20%>" & Sub1Var22 & "" & Sub1Var23 & "<%=Sub1Var13%><%=Sub1Var14%><%=Sub1Var21%><%=Sub1Var15%><%=Sub1Var16%><%=Sub1Var17%>" & Sub1Var18 & "
" response.write "" response.write "" response.write "" response.write "
" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "
" 'response.write "All Day" 'response.write " " 'response.write "
 " 'response.write "
" If BrowserType <> "OTHER" then response.write "
" Else response.write "
" End If If TimeFormatToUse = "12" then response.write "" Call WriteAgendaRow("12", "am") For I = 1 to 11 Call WriteAgendaRow(I,"00") Next Call WriteAgendaRow("12", "pm") For I = 1 to 11 Call WriteAgendaRow(I, "OO") Next response.write "
" Call WriteEvent(theDate, "DAY") Else response.write "" Call WriteAgendaRow("00", "00") For I = 1 to 9 Call WriteAgendaRow("0" & I,"00") Next For I = 10 to 23 Call WriteAgendaRow(I,"00") Next response.write "
" Call WriteEvent(theDate, "DAY") End If response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write " " & Sub1Var36 & "" response.write "
" Call DrawEventListing(theDate, "TODAY", "inside") response.write "
" response.write "
" End Sub '------ Write Agenda Row -------------------------------------------------------- Sub WriteAgendaRow(TimeToWrite1, TimeToWrite2) response.write "
" If TimeToWrite1 = 8 then response.write "" End If response.write "" & TimeToWrite1 & " " & TimeToWrite2 & "" response.write " " response.write "
 " response.write "
" response.write "" Call DrawWeekDayBlock(theDate, 1, "33%") Call DrawWeekDayBlock(theDate, 4, "33%") response.write "" response.write "" Call DrawWeekDayBlock(theDate, 2, "33%") Call DrawWeekDayBlock(theDate, 5, "33%") response.write "" response.write "" Call DrawWeekDayBlock(theDate, 3, "33%") Call DrawWeekDayBlock(theDate, 6, "17%") response.write "" response.write "" Call DrawWeekDayBlock(theDate, 7, "16%") response.write "" response.write "
" End Sub '------ Draw Week Day Block ------------------------------------------------------ Sub DrawWeekDayBlock(theDate, WeekDayNumber, DayHeight) DayNameNumber = Weekday(theDate, 2) DateLink = FormatDateTime(DateAdd("w", WeekDayNumber-DayNameNumber, theDate), 2) DateToShow = FormatDateTime(DateAdd("w", WeekDayNumber-DayNameNumber, theDate), 1) If WeekDayNumber = 3 then SpanValue = " ROWSPAN=2 " Else SpanValue = " " End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" If StartDaysAtEight = "YES" then response.write "" Else response.write "" End If response.write DateToShow If Session("Cal_User_ID") <> "" then %><%=Sub1Var34%><% End If response.write "" response.write "
" response.write "
" Call WriteEvent(DateLink, "WEEK") response.write "
" response.write "" End Sub '********************************************************************************* '******** Draw Month View ******************************************************** '********************************************************************************* Sub DrawMonthCalendar(theDate) Dim ThisMonthsFirstDay Dim NextMonthsFirstDay Dim ThisMonthsLastDay Dim LastMonthsLastDay Dim StartDate Dim Counter '------- Setup some information about the month ----------------- If Session("DateFormat") = "US" then ThisMonthsFirstDay = cDate(Month(theDate) & "/1/" & Year(theDate)) Else ThisMonthsFirstDay = cDate("1/" & Month(theDate) & "/" & Year(theDate)) End If NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) '------- Draw the beginning of the calendar ---------------------- response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" & MonthSundayName & "" & MonthMondayName & "" & MonthTuesdayName & "" & MonthWednesdayName & "" & MonthThursdayName & "" & MonthFridayName & "" & MonthSaturdayName & "
" '-------- Main Calendar Table ------------------------------------- response.write "" response.write "" '-------- If the first day is not sunday -------------------------- If weekday(ThisMonthsFirstDay) > 1 then For Counter = day(StartDate) to day(LastMonthsLastDay) Call DrawOtherMonthDay (Counter) Next End if '-------- Draw normal days after Saturday, start a new row -------- For Counter = 1 to day(ThisMonthsLastDay) If Session("DateFormat") = "US" then DateToUse = cDate(Month(theDate) & "/" & Counter & "/" & Year(theDate)) Else DateToUse = cDate(Counter & "/" & Month(theDate) & "/" & Year(theDate)) End If DrawMonthNormalDay (Counter) If weekday(DateToUse) = 7 then response.write "" If Counter <> day(ThisMonthsLastDay) then response.write "" End If End if Next '-------- If last day is not saturday ----------------------------- If weekday(ThisMonthsLastDay) < 7 then For Counter = 1 to 7 - weekday(ThisMonthsLastDay) DrawOtherMonthDay (Counter) Next End if '-------- Draw the last row of the calendar ----------------------- response.write "" response.write "
" End Sub Sub DrawMonthNormalDay(DayNumber) '----------------------------------- Draw a Normal Day If Session("DateFormat") = "US" then DateToUse = Month(theDate) & "/" & DayNumber & "/" & Year(theDate) Else DateToUse = DayNumber & "/" & Month(theDate) & "/" & Year(theDate) End If If Date() = cDate(DateToUse) then MonthCalDayClass = "TableMonthDayCellToday" Else MonthCalDayClass = "TableMonthDayCell" End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" If StartDaysAtEight = "YES" then response.write "" Else response.write "" End If response.write DayNumber response.write "  " %><% If Session("Cal_User_ID") <> "" then %><%=Sub1Var34%><% End If response.write "
" If BrowserType <> "OTHER" then If request.querystring("print") = "YES" then response.write "
" Else response.write "
" End If End If Call WriteEvent(DateToUse, "MONTH") If BrowserType <> "OTHER" then response.write "
" End If response.write "" End Sub Sub DrawOtherMonthDay(DayNumber) '--------------------------------------- Draw Other Day response.write "" response.write "" End Sub '********************************************************************************* '******** Draw Year Calendar ***************************************************** '********************************************************************************* Sub DrawYearCalendar(theDate) If Session("DateFormat") = "US" then ThisMonthsFirstDay = cDate(Month(theDate) & "/1/" & Year(theDate)) Else ThisMonthsFirstDay = cDate("1/" & Month(theDate) & "/" & Year(theDate)) End If NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) WeekDayTitleName = Weekday(theDate, 2) HeaderInfo = Sub5Var1 & DateAdd("w", 1-WeekDayTitleName, theDate) DayNameNumber = Weekday(theDate, 2) If Session("DateFormat") = "US" then DateToSend = Month(theDate) & "/1/" & Year(theDate) MonthA = "1/1/" & Year(theDate) MonthB = "2/1/" & Year(theDate) MonthC = "3/1/" & Year(theDate) MonthD = "4/1/" & Year(theDate) MonthE = "5/1/" & Year(theDate) MonthF = "6/1/" & Year(theDate) MonthG = "7/1/" & Year(theDate) MonthH = "8/1/" & Year(theDate) MonthI = "9/1/" & Year(theDate) MonthJ = "10/1/" & Year(theDate) MonthK = "11/1/" & Year(theDate) MonthL = "12/1/" & Year(theDate) Else DateToSend = "1/" & Month(theDate) & "/" & Year(theDate) MonthA = "1/1/" & Year(theDate) MonthB = "1/2/" & Year(theDate) MonthC = "1/3/" & Year(theDate) MonthD = "1/4/" & Year(theDate) MonthE = "1/5/" & Year(theDate) MonthF = "1/6/" & Year(theDate) MonthG = "1/7/" & Year(theDate) MonthH = "1/8/" & Year(theDate) MonthI = "1/9/" & Year(theDate) MonthJ = "1/10/" & Year(theDate) MonthK = "1/11/" & Year(theDate) MonthL = "1/12/" & Year(theDate) End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write Sub5Var2 & ": " & Year(theDate) & "" response.write "" response.write "" response.write "" response.write Sub5Var3 & ": " & MonthName(Month(DateToSend)) & " " & Year(DateToSend) & "" response.write "" response.write "
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" Call DrawMiniCalendar(MonthA) response.write "" Call DrawMiniCalendar(MonthB) response.write "" Call DrawMiniCalendar(MonthC) response.write "
" Call DrawMiniCalendar(MonthD) response.write "" Call DrawMiniCalendar(MonthE) response.write "" Call DrawMiniCalendar(MonthF) response.write "
" Call DrawMiniCalendar(MonthG) response.write "" Call DrawMiniCalendar(MonthH) response.write "" Call DrawMiniCalendar(MonthI) response.write "
" Call DrawMiniCalendar(MonthJ) response.write "" Call DrawMiniCalendar(MonthK) response.write "" Call DrawMiniCalendar(MonthL) response.write "
" response.write "
" response.write "
" response.write "
" Call DrawEventListing(DateToSend, "MONTH", "inside") response.write "
" response.write "
" End Sub '********************************************************************************* '******** Draw Mini Calendar ***************************************************** '********************************************************************************* Sub DrawMiniCalendar(theDate) Dim ThisMonthsFirstDay Dim NextMonthsFirstDay Dim ThisMonthsLastDay Dim LastMonthsLastDay Dim StartDate Dim Counter '------- Setup some information about the month ----------------- If Session("DateFormat") = "US" then ThisMonthsFirstDay = cDate(Month(theDate) & "/1/" & Year(theDate)) Else ThisMonthsFirstDay = cDate("1/" & Month(theDate) & "/" & Year(theDate)) End If NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) '------- Containter for whole mini calendar ---------------------- MiniOutput = "" MiniOutput = MiniOutput & "
" '------- Draw the month heading ---------------------------------- MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" If request.querystring("action") = "embedmini" then MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" If request.querystring("action") = "embedmini" then MiniOutput = MiniOutput & "" Else MiniOutput = MiniOutput & "" End If MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "
" Else MiniOutput = MiniOutput & "" End If If request.querystring("caltype") = "year" then MiniOutput = MiniOutput & "" End If MiniOutput = MiniOutput & MonthName(Month(theDate)) & " " & Year(theDate) If request.querystring("caltype") = "year" then MiniOutput = MiniOutput & "" End If MiniOutput = MiniOutput & "
" '------- Draw the beginning of the calendar ---------------------- MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "
" & MiniSundayName & "" & MiniMondayName & "" & MiniTuesdayName & "" & MiniWednesdayName & "" & MiniThursdayName & "" & MiniFridayName & "" & MiniSaturdayName & "
" '-------- Main Calendar Table ------------------------------------- MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" '-------- If the first day is not sunday -------------------------- If weekday(ThisMonthsFirstDay) > 1 then For Counter = day(StartDate) to day(LastMonthsLastDay) Call DrawOtherMiniDay (Counter) Next End if '-------- Draw normal days after Saturday, start a new row -------- For Counter = 1 to day(ThisMonthsLastDay) If Session("DateFormat") = "US" then DateToUse = cDate(Month(theDate) & "/" & Counter & "/" & Year(theDate)) Else DateToUse = cDate(Counter & "/" & Month(theDate) & "/" & Year(theDate)) End If Call DrawMiniNormalDay (Counter, DateToUse) If weekday(DateToUse) = 7 then MiniOutput = MiniOutput & "" If Counter <> day(ThisMonthsLastDay) then MiniOutput = MiniOutput & "" End If End if Next '-------- If last day is not saturday ----------------------------- If weekday(ThisMonthsLastDay) < 7 then For Counter = 1 to 7 - weekday(ThisMonthsLastDay) DrawOtherMiniDay (Counter) Next End if '-------- Draw the last row of the calendar ----------------------- MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "
" '-------- End of Container ---------------------------------------- MiniOutput = MiniOutput & "
" If request.querystring("action") <> "embedmini" then response.write MiniOutput Else MiniOutput = Replace(MiniOutput, "'", "\'") %> function ShowMiniCal() { var tmpStr; tmpStr = ('<%=MiniOutput%>'); document.write(tmpStr); } <% End If End Sub Sub DrawMiniNormalDay(DayNumber, theDate) '----------------------------------- Draw a Normal Day If Session("DateFormat") = "US" then DateToUse = Month(theDate) & "/" & DayNumber & "/" & Year(theDate) Else DateToUse = DayNumber & "/" & Month(theDate) & "/" & Year(theDate) End If If Date() = cDate(DateToUse) then MonthCalDayClass = "TableMiniDayCellToday" Else MonthCalDayClass = "TableMiniDayCell" End If IsThereAnEvent = CheckForEvent(DateToUse) If IsThereAnEvent = "YES" then MonthCalDayClass = "TableMiniDayCellWithEvent" End If MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" If request.querystring("action") = "embedmini" then If StartDaysAtEight = "YES" then MiniOutput = MiniOutput & "" Else MiniOutput = MiniOutput & "" End If Else If StartDaysAtEight = "YES" then MiniOutput = MiniOutput & "" Else MiniOutput = MiniOutput & "" End If End If MiniOutput = MiniOutput & DayNumber MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" End Sub Sub DrawOtherMiniDay(DayNumber) '--------------------------------------- Draw Other Day MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & " " MiniOutput = MiniOutput & "" End Sub '********************************************************************************* '******** Write Event List ******************************************************* '********************************************************************************* Sub DrawEventListView(theDate) If Session("DateFormat") = "US" then ThisMonthsFirstDay = cDate(Month(theDate) & "/1/" & Year(theDate)) Else ThisMonthsFirstDay = cDate("1/" & Month(theDate) & "/" & Year(theDate)) End If FirstDate = ThisMonthsFirstDay SecondDate = DateAdd("m", 1, ThisMonthsFirstDay) ThirdDate = DateAdd("m", 2, ThisMonthsFirstDay) response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write Sub7Var1 & ": " & MonthName(Month(FirstDate)) & " " & Year(FirstDate) & "" response.write "" response.write "" response.write "" response.write Sub7Var1 & ": " & MonthName(Month(SecondDate)) & " " & Year(SecondDate) & "" response.write "" response.write "" response.write "" response.write Sub7Var1 & ": " & MonthName(Month(ThirdDate)) & " " & Year(ThirdDate) & "" response.write "" response.write "
" response.write "
" Call DrawEventListing(FirstDate, "MONTH", "inside") response.write "
" response.write "
" response.write "
" Call DrawEventListing(SecondDate, "MONTH", "inside") response.write "
" response.write "
" response.write "
" Call DrawEventListing(ThirdDate, "MONTH", "inside") response.write "
" response.write "
" End Sub '********************************************************************************* '******** Write Event Month ****************************************************** '********************************************************************************* Sub WriteEvent(DateToUse, CalViewType) If Session("Cal_User_ID") = "" then GroupArray = GetGroupArray("Cal_Group_Type", "PUBLIC") If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= '" & FormatDateFix(DateToUse) & "' AND Cal_EventEndDate >= '" & FormatDateFix(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= #" & FormatDateFix(DateToUse) & "# AND Cal_EventEndDate >= #" & FormatDateFix(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" End If set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic Else UserGroupArray1 = Session("Cal_User_NormalGroups") UserGroupArray2 = Session("Cal_User_AdminGroups") UserGroupArray = Session("Cal_User_AllGroups") If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= '" & FormatDateFix(DateToUse) & "' AND Cal_EventEndDate >= '" & FormatDateFix(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= #" & FormatDateFix(DateToUse) & "# AND Cal_EventEndDate >= #" & FormatDateFix(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" End If set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic End If If CalViewType <> "DAY" then Do While NOT RS.EOF If RS("Cal_EventGroupID") = 2 then If UseSQLServer = "YES" then SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID") Else SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID") End If Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_User_EventColor") RSc.Close Set RSc=Nothing Else If UseSQLServer = "YES" then SQLc = "SELECT Cal_Group_Color, Cal_Group_Icon FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID") Else SQLc = "SELECT Cal_Group_Color, Cal_Group_Icon FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID") End If Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_Group_Color") GroupIcon = RSc("Cal_Group_Icon") RSc.Close Set RSc=Nothing End If If RS("Cal_EventGroupID") <> 2 OR RS("Cal_EventGroupID") = 2 AND RS("Cal_EventUserID") = Session("Cal_User_ID") then IsVisible = IsEventVisible(RS("Cal_EventGroupID")) If IsVisible = "TRUE" then If RS("Cal_EventAllDay") <> "TRUE" then response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
  " If Session("DateFormat") = "US" then response.write FormatTime(RS("Cal_EventStartTime")) Else TempTime = FormatTime(RS("Cal_EventStartTime")) response.write FormatTimeFix(TempTime, "MONTH") End If response.write "" %>" onclick="NewWindow(this.href,'aspWebCalendar','430','500','yes');return false"><% response.write RS("Cal_EventTitle") & "" If RS("Cal_EventRecurrID") <> "" then response.write " " & Sub8Var1 & "" End If If ShowRollInfo = "YES" then response.write " "
            response.write RS("Cal_EventTitle") & Chr(13) & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & Chr(13) & "-------------------------" & Chr(13) & RS("Cal_EventBody")
            response.write "" End If response.write "
" response.write "
" Else response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write "
" %>" onclick="NewWindow(this.href,'aspWebCalendar','430','500','yes');return false"><% response.write RS("Cal_EventTitle") & "" If RS("Cal_EventRecurrID") <> "" then response.write " " & Sub8Var1 & "" End If If ShowRollInfo = "YES" then response.write " "
            response.write RS("Cal_EventTitle") & Chr(13) & "ALL DAY EVENT" & Chr(13) & "-------------------------" & Chr(13) & RS("Cal_EventBody")
            response.write "" End If response.write "
" response.write "
" End If End If End If RS.MoveNext Loop Else If RS.RecordCount >= 1 then RS.MoveFirst EventCounter = 0 End If Do While NOT RS.EOF If RS("Cal_EventGroupID") <> 2 OR RS("Cal_EventGroupID") = 2 AND RS("Cal_EventUserID") = Session("Cal_User_ID") then IsVisible = IsEventVisible(RS("Cal_EventGroupID")) If IsVisible = "TRUE" then If RS("Cal_EventAllDay") <> "TRUE" then If EventCounter > 0 then If RS.RecordCount <= 4 then AddtoLeft = 110 Else AddtoLeft = (800 / RS.RecordCount) + 5 End If EventLeft = EventLeft + AddtoLeft Else EventLeft = 80 End If If RS.RecordCount <= 4 then EventWidth = 100 Else EventWidth = (800 / RS.RecordCount) End If If Session("DateFormat") = "US" then StartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3) EndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3) Else StartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3) EndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3) StartTime = FormatTimeFix(StartTime, "") EndTime = FormatTimeFix(EndTime, "") End If EventHeight = DateDiff("n", StartTime, EndTime) EventTop = DateDiff("n", "12:00a", StartTime) 'EventHeight = ((EventHeight * 19) * 2) / 60 + 1 'EventTop = (((EventTop * 19) * 2)) / 60 EventHeight = ((EventHeight * 29) * 2) / 60 + 1 EventTop = (((EventTop * 29) * 2)) / 60 If RS("Cal_EventGroupID") = 2 then If UseSQLServer = "YES" then SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID") Else SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID") End If Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_User_EventColor") RSc.Close Set RSc=Nothing Else If UseSQLServer = "YES" then SQLc = "SELECT Cal_Group_Color FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID") Else SQLc = "SELECT Cal_Group_Color FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID") End If Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_Group_Color") RSc.Close Set RSc=Nothing End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
 " %>" onclick="NewWindow(this.href,'aspWebCalendar','430','500','yes');return false"><% response.write RS("Cal_EventTitle") & "
" EventCounter = EventCounter + 1 End If End If End If RS.MoveNext Loop End If End Sub '********************************************************************************* '******** Write Event Listing **************************************************** '********************************************************************************* Sub DrawEventListing(DateToUse, Range, CalType) If DateToUse = "" then DateToUse = Date() Else DateToUse = cDate(DateToUse) End If If Range = "" then NumOfTimes = 1 Else If Range = "TODAY" then NumOfTimes = 1 End If If Range = "WEEK" then NumOfTimes = 7 End If If Range = "MONTH" then NumOfTimes = 31 End If End If For I = 1 to NumOfTimes If I > 1 then DateToUse = DateAdd("d", DateToUse, 1) End If If Session("Cal_User_ID") = "" then GroupArray = GetGroupArray("Cal_Group_Type", "PUBLIC") If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= '" & FormatDateFix(DateToUse) & "' AND Cal_EventEndDate >= '" & FormatDateFix(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= #" & FormatDateFix(DateToUse) & "# AND Cal_EventEndDate >= #" & FormatDateFix(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" End If Set RS=dbc.execute(SQL) Else UserGroupArray1 = Session("Cal_User_NormalGroups") UserGroupArray2 = Session("Cal_User_AdminGroups") UserGroupArray = Session("Cal_User_AllGroups") If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= '" & FormatDateFix(DateToUse) & "' AND Cal_EventEndDate >= '" & FormatDateFix(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= #" & FormatDateFix(DateToUse) & "# AND Cal_EventEndDate >= #" & FormatDateFix(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" End If Set RS=dbc.execute(SQL) End If Do While NOT RS.EOF If RS("Cal_EventGroupID") = 2 then If UseSQLServer = "YES" then SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID") Else SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID") End If Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_User_EventColor") RSc.Close Set RSc=Nothing Else If UseSQLServer = "YES" then SQLc = "SELECT Cal_Group_Color FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID") Else SQLc = "SELECT Cal_Group_Color FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID") End If Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_Group_Color") RSc.Close Set RSc=Nothing End If If RS("Cal_EventGroupID") <> 2 OR RS("Cal_EventGroupID") = 2 AND RS("Cal_EventUserID") = Session("Cal_User_ID") then IsVisible = IsEventVisible(RS("Cal_EventGroupID")) If IsVisible = "TRUE" then FoundEvent = "YES" TempOutput = "
" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "
  " If CalType = "outside" then If StartDaysAtEight = "YES" then TempOutput = TempOutput & "" Else TempOutput = TempOutput & "" End If Else TempOutput = TempOutput & "" End If TitleToWrite = RS("Cal_EventTitle") TempOutput = TempOutput & TitleToWrite & "" If RS("Cal_EventRecurrID") <> "" then TempOutput = TempOutput & "  " & Sub9Var1 & "" End If If CanUserModify(RS("Cal_EventGroupID")) = "TRUE" then TempOutput = TempOutput & " " If CalType = "outside" then TempOutput = TempOutput & "" & Sub9Var2 & "" Else TempOutput = TempOutput & "" & Sub9Var2 & "" End If TempOutput = TempOutput & "" TempOutput = TempOutput & " " If CalType = "outside" then TempOutput = TempOutput & "" & Sub9Var3 & "" Else TempOutput = TempOutput & "" & Sub9Var3 & "" End If TempOutput = TempOutput & "" End If TempOutput = TempOutput & "
  " If RS("Cal_EventAllDay") <> "TRUE" then If Session("DateFormat") = "US" then TempOutput = TempOutput & "" & DateToUse & " | " & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) Else TempStartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3) TempStartTime = FormatTimeFix(TempStartTime,"") TempEndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3) TempEndTime = FormatTimeFix(TempEndTime,"") TempOutput = TempOutput & "" & DateToUse & " | " & TempStartTime & " - " & TempEndTime End If Else TempOutput = TempOutput & "" & DateToUse & " | ALL DAY EVENT" End If TempOutput = TempOutput & "
  " BodyToWrite = Replace(RS("Cal_EventBody"), vbcrlf, "
") 'TempOutput = TempOutput & Replace(RS("Cal_EventBody"), vbcrlf, "
" & vbcrlf) TempOutput = TempOutput & BodyToWrite TempOutput = TempOutput & "
" TempOutput = TempOutput & "
" If CalType = "inside" then response.write TempOutput End If FinalOutput = FinalOutput & TempOutput End If End If RS.MoveNext Loop Next If FoundEvent <> "YES" then FinalOutput = "" & Sub1Var33 & "" If CalType = "inside" then response.write FinalOutput End If End If FinalOutput = Replace(FinalOutput, "'", "\'") If CalType = "outside" then %> function ShowListing() { var tmpStr; tmpStr = ('<%=FinalOutput%>'); document.write(tmpStr); } <% End If End Sub '********************************************************************************* '******** Draw Event Popup ******************************************************* '********************************************************************************* Sub DrawEventPopup If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventID") Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventID") End If Set RS=dbc.execute(SQL) If NOT RS.EOF then response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "

" & Sub10Var1 & "

    " & Sub10Var2 & "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventGroupID") = 2 then If UseSQLServer = "YES" then SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID") Else SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID") End If Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_User_EventColor") EventGroup = "Personal" RSc.Close Set RSc=Nothing Else If UseSQLServer = "YES" then SQLc = "SELECT Cal_Group_Color, Cal_Group_Name FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID") Else SQLc = "SELECT Cal_Group_Color, Cal_Group_Name FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID") End If Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_Group_Color") EventGroup = RSc("Cal_Group_Name") RSc.Close Set RSc=Nothing End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If User1 <> "" then response.write "" response.write "" response.write "" response.write "" End If If User2 <> "" then response.write "" response.write "" response.write "" response.write "" End If If User3 <> "" then response.write "" response.write "" response.write "" response.write "" End If If User4 <> "" then response.write "" response.write "" response.write "" response.write "" End If If User5 <> "" then response.write "" response.write "" response.write "" response.write "" End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" & Sub10Var3 & ":" %><%=RS("Cal_EventTitle")%><% If RS("Cal_EventRecurrID") <> "" then response.write " " & Sub10Var4 & "" End If If RS("Cal_EventLink") <> "" then response.write "" response.write "" End If response.write "
" response.write "" & Sub10Var16 & ":" If CanUserModify(RS("Cal_EventGroupID")) = "TRUE" then %> " onclick="NewWindow(this.href,'aspWebCalendar2','500','440','no');return false"><% response.write "" & Sub10Var17 & "" response.write "" %> " onclick="NewWindow(this.href,'aspWebCalendar2','500','440','no');return false"><% response.write "" & Sub10Var17 & "" response.write "" End If %> " onclick="NewWindow(this.href,'aspWebCalendar2','500','440','no');return false"><% response.write "" & Sub10Var21 & "" response.write "" SQLc = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & RS("Cal_EventUserID") Set RSc=dbc.execute(SQLc) If NOT RSc.EOF then CreatorEmail = RSc("Cal_User_EmailAddress") End If RSc.Close Set RSc=Nothing %> <% response.write "" & Sub10Var19 & "" response.write "" response.write "
" response.write "" & Sub10Var7 & ":" If RS("Cal_EventStartDate") <> RS("Cal_EventEndDate") then response.write "" & RS("Cal_EventStartDate") & " - " & RS("Cal_EventEndDate") & "" Else response.write "" & RS("Cal_EventStartDate") & "" End If response.write "
" response.write "" & Sub10Var8 & ":" If RS("Cal_EventAllDay") <> "TRUE" then If Session("DateFormat") = "US" then response.write "" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & "" Else TempStartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3) TempStartTime = FormatTimeFix(TempStartTime,"") TempEndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3) TempEndTime = FormatTimeFix(TempEndTime,"") response.write "" & TempStartTime & " - " & TempEndTime & "" End If Else response.write "" & Sub10Var9 & "" End If response.write "
" response.write "" & Sub10Var10 & ":" response.write "" & EventGroup & "" response.write "
" response.write "" & Sub10Var11 & ":" response.write "" & Replace(RS("Cal_EventBody"), vbcrlf, "
" & vbcrlf) & "
" response.write "
" response.write "" & User1 & ":" response.write "" & RS("Cal_EventUser1") & "" response.write "
" response.write "" & User2 & ":" response.write "" & RS("Cal_EventUser2") & "" response.write "
" response.write "" & User3 & ":" response.write "" & RS("Cal_EventUser3") & "" response.write "
" response.write "" & User4 & ":" response.write "" & RS("Cal_EventUser4") & "" response.write "
" response.write "" & User5 & ":" response.write "" & RS("Cal_EventUser5") & "" response.write "
" response.write "" & Sub10Var12 & ":" response.write "" & RS("Cal_EventImage") & "" response.write "
" response.write "
" response.write "" response.write "
" response.write "
" Else response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "

" & Sub10Var1 & "

    " & Sub10Var2 & "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "










" & Sub10Var14 & ":
" response.write "










" & Sub10Var15 & "
" %><% response.write "
" response.write " " response.write "







 
" response.write "
" response.write "
" response.write "" response.write "
" response.write "
" End If RS.Close Set RS=Nothing End Sub '********************************************************************************* '******** Draw Login Page ******************************************************** '********************************************************************************* Sub DrawLoginPage response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "

" & Sub11Var1 & "

    " & Sub11Var2 & "
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" & Sub11Var3 & ":" If request.querystring("error") = "nouser" then response.write "
* " & Sub11Var4 & "." End If response.write "
" response.write "" & Sub11Var5 & ":" If request.querystring("error") = "wrongpassword" then response.write "
* " & Sub11Var6 & "." End If response.write "
 
" response.write "" & Sub11Var8 & "
" response.write "
" response.write "
" End Sub '********************************************************************************* '******** Process The Login ****************************************************** '********************************************************************************* Sub ProcessLogin If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_User WHERE Cal_User_UserName = '" & request.form("txtUserName") & "'" Else SQL = "SELECT * FROM Cal_User WHERE Cal_User_UserName = '" & request.form("txtUserName") & "'" End If Set RS=dbc.execute(SQL) If NOT RS.EOF then If RS("Cal_User_Password") = request.form("txtPassword") then Session("Cal_User_ID") = RS("Cal_User_ID") Session("Cal_User_UserName") = RS("Cal_User_UserName") Session("Cal_User_FirstName") = RS("Cal_User_FirstName") Session("Cal_User_LastName") = RS("Cal_User_LastName") Session("Cal_User_EmailAddress") = RS("Cal_User_EmailAddress") Session("Cal_User_RightsLevel") = RS("Cal_User_RightsLevel") Session("Cal_User_RequireApproval") = RS("Cal_User_RequireApproval") Session("Cal_User_EventColor") = RS("Cal_User_EventColor") Session("Cal_User_NormalGroups") = GetUserGroupArray("NORMAL") Session("Cal_User_AdminGroups") = GetUserGroupArray("ADMIN") Session("Cal_User_AllGroups") = Session("Cal_User_NormalGroups") & ", " & Session("Cal_User_PublicGroups") & "," & Session("Cal_User_AdminGroups") & ", 2" If RS("Cal_User_LastFilter") <> "" then Session("Cal_FilterGroups") = RS("Cal_User_LastFilter") Else Session("Cal_FilterGroups") = Session("Cal_User_AllGroups") End If response.redirect "calendar.asp?action=summary&message=" & Sub12Var1 & "&linktype=window&from=loginscreen" Else response.redirect "calendar.asp?action=login&error=wrongpassword" End If Else response.redirect "calendar.asp?action=login&error=nouser" End If End Sub '********************************************************************************* '******** Draw View Options Page ************************************************* '********************************************************************************* Sub ViewOptions response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "

" & Sub13Var1 & "

    " & Sub13Var2 & "
" response.write "
" response.write "" FilterGroups = Session("Cal_User_AllGroups") RowCounter = 1 If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Group WHERE Cal_Group_ID IN("& FilterGroups &") ORDER BY Cal_Group_Name" Else SQL = "SELECT * FROM Cal_Group WHERE Cal_Group_ID IN("& FilterGroups &") ORDER BY Cal_Group_Name" End If Set RS=dbc.execute(SQL) Do While NOT RS.EOF If RS("Cal_Group_ID") <> 2 then GroupColor = RS("Cal_Group_Color") Else GroupColor = Session("Cal_User_EventColor") End If If RowCounter = 1 then response.write "" response.write "" RowCounter = 2 Else response.write "" response.write "" RowCounter = 1 End If RS.MoveNext Loop If RowCounter = 2 then response.write "" response.write "" End If response.write "" response.write "" response.write "" response.write "
" response.write "" response.write "" & RS("Cal_Group_Name") & "" response.write "" response.write "" & RS("Cal_Group_Name") & "
" response.write "

" response.write "
" response.write "
" End Sub '********************************************************************************* '******** Process Logoff ********************************************************* '********************************************************************************* Sub Logoff Session.Abandon response.redirect "calendar.asp" End Sub '********************************************************************************* '******** Draw the Summary Page ************************************************** '********************************************************************************* Sub DrawSummary(Sum_Message, Sum_LinkType, Sum_From) SELECT CASE Sum_From CASE "loginscreen" TopIconImage = SkinFolder & "popup_head_login.gif" TopMessage = Sub14Var1 TopMessage2 = "    " & Sub14Var2 & ":" CASE "filterview" TopIconImage = SkinFolder & "popup_head_filter.gif" TopMessage = Sub14Var3 TopMessage2 = "    " & Sub14Var2 CASE "emailuser" TopIconImage = SkinFolder & "popup_head_email.gif" TopMessage = Sub14Var9 TopMessage2 = "    " & Sub14Var10 CASE ELSE END SELECT response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "

" & TopMessage & "

" & TopMessage2 & "
" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" If Sum_From <> "loginscreen" or UseInviteFunction = "NO" then response.write "" & Sum_Message & "

" If Sum_LinkType = "window" then response.write "" Else response.write "Continue" End If Else Set RS=Server.CreateObject("ADODB.RecordSet") If UseSQLServer = "YES" then RS.Open "SELECT * FROM Cal_Events WHERE Cal_EventUserID = " & Session("Cal_User_ID") & " AND Cal_EventStatus = 'INVITE'", dbc, adOpenDynamic, adLockPessimistic, adCMDText Else RS.Open "SELECT * FROM Cal_Events WHERE Cal_EventUserID = " & Session("Cal_User_ID") & " AND Cal_EventStatus = 'INVITE'", dbc, adOpenDynamic, adLockPessimistic, adCMDText End If response.write "" response.write "" response.write "" response.write "" response.write "" End If RS.CLOSE SET RS=Nothing response.write "" response.write "" response.write "
" & Sub14Var5 & "

" If NOT RS.EOF then response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" Do While NOT RS.EOF response.write "" response.write "" response.write "" response.write "" Set RSa=Server.CreateObject("ADODB.RecordSet") If UseSQLServer = "YES" then RSa.Open "SELECT Cal_User_FirstName, Cal_User_LastName FROM Cal_User WHERE Cal_User_ID = " & RS("Cal_EventInviteByID"), dbc, adOpenDynamic, adLockPessimistic, adCMDText Else RSa.Open "SELECT Cal_User_FirstName, Cal_User_LastName FROM Cal_User WHERE Cal_User_ID = " & RS("Cal_EventInviteByID"), dbc, adOpenDynamic, adLockPessimistic, adCMDText End If InviteUser = RSa("Cal_User_FirstName") & " " & RSa("Cal_User_LastName") RSa.Close Set RSa=Nothing response.write "" response.write "" RS.MoveNext Loop response.write "" response.write "" response.write "" response.write "
A  |  DTitleDateFrom
" %>" onclick="NewWindow(this.href,'aspWebCalendarPOPUP','400','500','no');return false"><% response.write RS("Cal_EventTitle") & "" & RS("Cal_EventStartDate") & "" & InviteUser & "
" response.write "
" Else response.write "
" & Sub14Var7 & "

" If Sum_LinkType = "window" then response.write "" Else response.write "" & Sub14Var8 & "" End If End If response.write "
" response.write "
" End Sub '********************************************************************************* '******** Must Login ************************************************************* '********************************************************************************* Sub MustLogin response.write "





" & Sub15Var1 & "

" %><%=Sub15Var2%><% response.write "
" End Sub '********************************************************************************* '******** Process Invites ******************************************************** '********************************************************************************* Sub ProcessInvites If request.form("txtApproveInvites") <> "" then SendEmailToUsers = split(request.form("txtApproveInvites")) For I = 0 to Ubound(SendEmailToUsers) '---- Send Email to Invitees ---------- If UseSQLServer = "YES" then SQLu = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & int(SendEmailToUsers(I)) Else SQLu = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & int(SendEmailToUsers(I)) End If Set RSu = dbc.execute(SQLu) SendFromUserID = RSu("Cal_EventInviteByID") Cal_EventTitle = RSu("Cal_EventTitle") Cal_EventStartDate = RSu("Cal_EventStartDate") Cal_EventStartTime = RSu("Cal_EventStartTime") Cal_EventEndTime = RSu("Cal_EventEndTime") Cal_EventBody = RSu("Cal_EventBody") RSu.Close Set RSu=Nothing If UseSQLServer = "YES" then SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & SendFromUserID Else SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & SendFromUserID End If Set RSe=dbc.execute(SQLe) SendTo = RSe("Cal_User_EmailAddress") EmailSubject = Sub49Var2 RSe.Close Set RSe=Nothing If Cal_EventAllDay <> "TRUE" then MessageToSend = Session("Cal_User_FirstName") & " " & Session("Cal_User_LastName")& " " & Sub49Var3 & ":

" & Cal_EventTitle & " - " & Cal_EventStartDate & " | " & FormatTime(Cal_EventStartTime) & "-" & FormatTime(Cal_EventEndTime) MessageToSend = MessageToSend & "
" & Sub49Var4 & ": " & Cal_EventBody & "

" Else MessageToSend = Session("Cal_User_FirstName") & " " & Session("Cal_User_LastName")& " " & Sub49Var3 & ":

" & Cal_EventTitle & " - " & Cal_EventStartDate & " | " & Sub38Var6 MessageToSend = MessageToSend & "
" & Sub49Var4 & ": " & Cal_EventBody & "

" End If If UseEmailFunctions <> "NO" then Call SendAnEmail(SendTo, EmailSubject, MessageToSend) End If '-------------------------------------- Next If UseSQLServer = "YES" then SQL = "UPDATE Cal_Events SET Cal_EventStatus = 'APPROVED' WHERE Cal_EventID IN("&request.form("txtApproveInvites")&")" Else SQL = "UPDATE Cal_Events SET Cal_EventStatus = 'APPROVED' WHERE Cal_EventID IN("&request.form("txtApproveInvites")&")" End If Set RS = dbc.Execute(SQL) End If If request.form("txtDeclineInvites") <> "" then SendEmailToUsers = split(request.form("txtDeclineInvites")) For I = 0 to Ubound(SendEmailToUsers) '---- Send Email to Invitees ---------- If UseSQLServer = "YES" then SQLu = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & int(SendEmailToUsers(I)) Else SQLu = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & int(SendEmailToUsers(I)) End If Set RSu = dbc.execute(SQLu) SendFromUserID = RSu("Cal_EventInviteByID") Cal_EventTitle = RSu("Cal_EventTitle") Cal_EventStartDate = RSu("Cal_EventStartDate") Cal_EventStartTime = RSu("Cal_EventStartTime") Cal_EventEndTime = RSu("Cal_EventEndTime") Cal_EventBody = RSu("Cal_EventBody") RSu.Close Set RSu=Nothing If UseSQLServer = "YES" then SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & SendFromUserID Else SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & SendFromUserID End If Set RSe=dbc.execute(SQLe) SendTo = RSe("Cal_User_EmailAddress") EmailSubject = Sub49Var2 RSe.Close Set RSe=Nothing If Cal_EventAllDay <> "TRUE" then MessageToSend = Session("Cal_User_FirstName") & " " & Session("Cal_User_LastName")& " " & Sub49Var5 & ":

" & Cal_EventTitle & " - " & Cal_EventStartDate & " | " & FormatTime(Cal_EventStartTime) & "-" & FormatTime(Cal_EventEndTime) MessageToSend = MessageToSend & "
" & Sub49Var4 & ": " & Cal_EventBody & "

" Else MessageToSend = Session("Cal_User_FirstName") & " " & Session("Cal_User_LastName")& " " & Sub49Var5 & ":

" & Cal_EventTitle & " - " & Cal_EventStartDate & " | " & Sub38Var6 MessageToSend = MessageToSend & "
" & Sub49Var4 & ": " & Cal_EventBody & "

" End If If UseEmailFunctions <> "NO" then Call SendAnEmail(SendTo, EmailSubject, MessageToSend) End If '-------------------------------------- Next If UseSQLServer = "YES" then SQL = "DELETE FROM Cal_Events WHERE Cal_EventID IN("& request.form("txtDeclineInvites") &")" Else SQL = "DELETE FROM Cal_Events WHERE Cal_EventID IN("& request.form("txtDeclineInvites") &")" End If Set RS = dbc.Execute(SQL) End If response.redirect "calendar.asp?action=summary&message=" & Sub15Var3 & "&linktype=window&from=loginscreen" End Sub '********************************************************************************* '******** Process Filter ********************************************************* '********************************************************************************* Sub ProcessFilter Session("Cal_FilterGroups") = request.form("txtGroupFilter") If UseSQLServer = "YES" then SQL="UPDATE Cal_User SET " Else SQL="UPDATE Cal_User SET " End If If Session("Cal_User_ID") <> "" then SQL = SQL & "Cal_User_LastFilter = '" & Session("Cal_FilterGroups") & "' " SQL = SQL & " WHERE [Cal_User_ID] ="& Session("Cal_User_ID") dbc.Execute(SQL) End If response.redirect "calendar.asp?date=" & request.querystring("date") & "&caltype=" & request.querystring("caltype") End Sub '********************************************************************************* '******** Send An Email ********************************************************** '********************************************************************************* Sub SendAnEmail(SendTo, EmailSubject, MessageToSend) '------ Fill the Variables -------------------------- txtSendTo = SendTo txtSendFrom = SendFromEmailAddress txtSubject = EmailSubject txtBody = MessageToSend If EmailComponent = "CDONTS" then Set sMail = Server.CreateObject("CDONTS.NewMail") sMail.BodyFormat = 0 sMail.MailFormat = 0 sMail.From = txtSendFrom sMail.To = txtSendTo sMail.Subject = txtSubject sMail.Body = txtBody sMail.Send( ) End If If EmailComponent = "ASPEmail" then Set sMail = Server.CreateObject("Persits.MailSender") sMail.Host = EmailHost sMail.From = txtSendFrom sMail.FromName = txtSendFrom sMail.AddReplyTo txtSendFrom sMail.AddAddress txtSendTo 'This needs to be changed to handle multiples!!! sMail.Subject = txtSubject sMail.Body = txtBody sMail.Send End If If EmailComponent = "JMail" then Set sMail = Server.CreateObject("JMail.Message") sMail.Logging = true sMail.silent = true sMail.From = txtSendFrom sMail.FromName = txtSendFrom sMail.AddRecipient txtSendTo 'This needs to be changed to handle multiples!!! sMail.Subject = txtSubject sMail.Body = txtBody sMail.Send(EmailHost) End If If EmailComponent = "ASPMail" then Set sMail = Server.CreateObject("SMTPsvg.Mailer") sMail.RemoteHost = EmailHost sMail.FromAddress = txtSendFrom sMail.FromName = txtSendFrom sMail.AddRecipient txtEmailUser, txtSendTo 'This needs to be changed to handle multiples!!! sMail.ContentType = "text/html" sMail.Subject = txtSubject sMail.BodyText = txtBody sMail.SendMail End If End Sub '********************************************************************************* '******** Export To VCAL ********************************************************* '********************************************************************************* Sub ExportVCal(DateToUse, CalType) If DateToUse = "" then DateToUse = Date() Else DateToUse = cDate(DateToUse) End If If CalType = "" then NumOfTimes = 31 Else If CalType = "day" then NumOfTimes = 1 End If If CalType = "week" then NumOfTimes = 7 WeekDayTitleName = Weekday(theDate, 2) DateToUse = DateAdd("w", 1-WeekDayTitleName, DateToUse) End If If CalType = "month" then NumOfTimes = 31 If Session("DateFormat") = "US" then DateToUse = Month(DateToUse) & "/1/" & Year(DateToUse) DateToUse = cDate(DateToUse) Else DateToUse = "/1/" & Month(DateToUse) & Year(DateToUse) DateToUse = cDate(DateToUse) End If End If End If EventToUse = request.querystring("eventid") If EventToUse <> "" then NumOfTimes = 1 End If VCalTemp = "" VCalTemp = VCalTemp & "BEGIN:VCALENDAR" & vbCrLF VCalTemp = VCalTemp & "VERSION:1.0" & vbCrLF For I = 1 to NumOfTimes If I > 1 then DateToUse = DateAdd("d", DateToUse, 1) End If If EventToUse = "" then If Session("Cal_User_ID") = "" then GroupArray = GetGroupArray("Cal_Group_Type", "PUBLIC") If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= '" & CDate(DateToUse) & "' AND Cal_EventEndDate >= '" & CDate(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= #" & CDate(DateToUse) & "# AND Cal_EventEndDate >= #" & CDate(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" End If Set RS=dbc.execute(SQL) Else UserGroupArray1 = Session("Cal_User_NormalGroups") UserGroupArray2 = Session("Cal_User_AdminGroups") UserGroupArray = Session("Cal_User_AllGroups") If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= '" & CDate(DateToUse) & "' AND Cal_EventEndDate >= '" & CDate(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= #" & CDate(DateToUse) & "# AND Cal_EventEndDate >= #" & CDate(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" End If Set RS=dbc.execute(SQL) End If Else If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & EventToUse Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & EventToUse End If Set RS=dbc.execute(SQL) End If Do While NOT RS.EOF If RS("Cal_EventGroupID") <> 2 OR RS("Cal_EventGroupID") = 2 AND RS("Cal_EventUserID") = Session("Cal_User_ID") then IsVisible = IsEventVisible(RS("Cal_EventGroupID")) If IsVisible = "TRUE" then TimeZoneBias = TimeZoneBias * (-1) If RS("Cal_EventAllDay") = "TRUE" then FixStartDay = Day(RS("Cal_EventStartDate")) If len(FixStartDay) = 1 then FixStartDay = "0" & FixStartDay End If FixStartMonth = Month(RS("Cal_EventStartDate")) If len(FixStartMonth) = 1 then FixStartMonth = "0" & FixStartMonth End If FixEndDay = Day(RS("Cal_EventEndDate")) If len(FixEndDay) = 1 then FixEndDay = "0" & FixEndDay End If FixEndMonth = Month(RS("Cal_EventEndDate")) If len(FixEndMonth) = 1 then FixEndMonth = "0" & FixEndMonth End If EventStartDate = Year(RS("Cal_EventStartDate")) & FixStartMonth & FixStartDay EventEndDate = Year(RS("Cal_EventEndDate")) & FixEndMonth & FixEndDay 'EventStartDate = Year(RS("Cal_EventStartDate")) & Month(RS("Cal_EventStartDate")) & Day(RS("Cal_EventStartDate")) 'EventEndDate = Year(RS("Cal_EventEndDate")) & Month(RS("Cal_EventEndDate")) & Day(RS("Cal_EventEndDate")) VCalEventStart = EventStartDate & "T050000Z" VCalEventEnd = EventEndDate & "T050000Z" Else FixStartDay = Day(RS("Cal_EventStartDate")) If len(FixStartDay) = 1 then FixStartDay = "0" & FixStartDay End If FixStartMonth = Month(RS("Cal_EventStartDate")) If len(FixStartMonth) = 1 then FixStartMonth = "0" & FixStartMonth End If FixEndDay = Day(RS("Cal_EventEndDate")) If len(FixEndDay) = 1 then FixEndDay = "0" & FixEndDay End If FixEndMonth = Month(RS("Cal_EventEndDate")) If len(FixEndMonth) = 1 then FixEndMonth = "0" & FixEndMonth End If EventStartDate = Year(RS("Cal_EventStartDate")) & FixStartMonth & FixStartDay EventEndDate = Year(RS("Cal_EventEndDate")) & FixEndMonth & FixEndDay 'EventStartDate = Year(RS("Cal_EventStartDate")) & Month(RS("Cal_EventStartDate")) & Day(RS("Cal_EventStartDate")) 'EventEndDate = Year(RS("Cal_EventEndDate")) & Month(RS("Cal_EventEndDate")) & Day(RS("Cal_EventEndDate")) EventStartTime = FormatDateTime(RS("Cal_EventStartTime"), 4) EventStartTime = Replace(EventStartTime, ":", "") EventEndTime = FormatDateTime(RS("Cal_EventEndTime"), 4) EventEndTime = Replace(EventEndTime, ":", "") VCalEventStart = EventStartDate & "T" & EventStartTime & "00" VCalEventEnd = EventEndDate & "T" & EventEndTime & "00" End If FixedBody = replace(RS("Cal_EventBody"), "
", "") FixedBody = replace(FixedBody, vbcrlf, "") VCalTemp = VCalTemp & "BEGIN: VEVENT" & vbCrLF VCalTemp = VCalTemp & "DTStart:" & VCalEventStart & vbCrLF VCalTemp = VCalTemp & "DTEnd:" & VCalEventEnd & vbCrLF VCalTemp = VCalTemp & "Location;ENCODING=QUOTED-PRINTABLE:" & EventLocation & vbCrLF VCalTemp = VCalTemp & "SUMMARY;ENCODING=QUOTED-PRINTABLE:" & RS("Cal_EventTitle") & vbCrLF VCalTemp = VCalTemp & "DESCRIPTION;ENCODING=QUOTED-PRINTABLE:" & FixedBody & vbCrLF VCalTemp = VCalTemp & "UID:" & VCalEventStart & VCalEventEnd & RS("Cal_EventTitle") & vbCrLF VCalTemp = VCalTemp & "PRIORITY:3" & vbCrLF VCalTemp = VCalTemp & "End:VEVENT" & vbCrLF End If End If RS.MoveNext Loop Next VCalTemp = VCalTemp & "End:VCALENDAR" & chr(13) '------ Write Stream to a file and send it to the browser... then delete the file... ------------------ 'Dim objStream 'Set objStream = Server.CreateObject("ADODB.Stream") 'objStream.Open 'objStream.Type = 2 'objStream.Charset = "ascii" 'objStream.WriteText VCalTemp 'objStream.SaveToFile Server.MapPath("calendar\eventimages\vcalexport.vcs"), 2 'objStream.Close 'Set objStream = Nothing Set FSO = Server.CreateObject("Scripting.FileSystemObject") Dim objTextStream Set objTextStream = FSO.OpenTextFile(Server.MapPath("calendar\eventimages\vcalexport.vcs"), 8, True) objTextStream.Write VCalTemp objTextStream.Close Set objTextStream = Nothing Dim objStream Set objStream = Server.CreateObject("ADODB.Stream") Response.ContentType = "application/octet-stream" Response.AddHeader "Content-Disposition", "attachment;filename=vcalexport.vcs" objStream.Type = 1 objStream.Open objStream.LoadFromFile Server.MapPath("calendar\eventimages\vcalexport.vcs") Response.BinaryWrite objStream.Read objStream.Close Set objStream = Nothing If FSO.FileExists(Server.MapPath("calendar\eventimages\vcalexport.vcs")) then FSO.DeleteFile(Server.MapPath("calendar\eventimages\vcalexport.vcs")) Else response.write "THIS FILE DOESN'T EXISTS" End If Set FSO = Nothing '-------- Old method use this if you cant write to the file for permission reasons ---------------- 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "

" & Sub17Var1 & "

    " & Sub17Var2 & "
" 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write "
" 'response.write "" 'response.write "" & Sub17Var3 & "

" 'response.write "

" 'response.write "" 'response.write "" 'response.write "
" 'response.write "
" End Sub '********************************************************************************* '******** Email A User ********************************************************** '********************************************************************************* Sub SendUserEmail response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "

" & Sub50Var1 & "

    " & Sub50Var2 & "
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" & Sub50Var5 & ":" response.write "" response.write "
" response.write "" & Sub50Var3 & ":" response.write "
" response.write "" & Sub50Var4 & ":" response.write "
 
" response.write " 
" response.write "
" response.write "
" End Sub '********************************************************************************* '******** Email A User ********************************************************** '********************************************************************************* Sub SendUserEmailProcess SendTo = request.form("txtEmailUser") EmailSubject = request.form("txtEmailSubject") MessageToSend = request.form("txtEmailBody") Call SendAnEmail(SendTo, EmailSubject, MessageToSend) response.redirect "calendar.asp?action=summary&message=" & Sub51Var1 & "&linktype=window&from=emailuser" End Sub '********************************************************************************* '********************************************************************************* '********************************************************************************* '************************* Functions Below Here Only ***************************** '********************************************************************************* '********************************************************************************* '********************************************************************************* '********************************************************************************* '********************************************************************************* '********* Write the page header or footer ************************************** SUB WriteHeaderOrFooter(FileToRead) HFFile=server.mappath(FileToRead) Set fs = CreateObject("Scripting.FileSystemObject") Set thisfile = fs.OpenTextFile(HFFile, 1, False) tempSTR=thisfile.readall response.write tempSTR thisfile.Close set thisfile=nothing set fs=nothing END SUB '******* Can User Modify Event *************************************************** Function CanUserModify(EventGroup) CanModify = Split(Session("Cal_User_AdminGroups")) For I = 0 to Ubound(CanModify) If cint(EventGroup) = cint(CanModify(I)) then Return = "TRUE" End If Next CanUserModify = Return End Function '******* Should We Show The Event ************************************************ Function IsEventVisible(EventGroup) EventsVisible = Split(Session("Cal_FilterGroups")) For I = 0 to Ubound(EventsVisible) If cint(EventGroup) = cint(EventsVisible(I)) then Return = "TRUE" End If Next IsEventVisible = Return End Function '******* Check Day For Event ***************************************************** Function CheckForEvent(DateToUse) If Session("Cal_User_ID") = "" then GroupArray = GetGroupArray("Cal_Group_Type", "PUBLIC") If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= '" & FormatDateFix(DateToUse) & "' AND Cal_EventEndDate >= '" & FormatDateFix(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= #" & FormatDateFix(DateToUse) & "# AND Cal_EventEndDate >= #" & FormatDateFix(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" End If Set RS=dbc.execute(SQL) Else UserGroupArray1 = Session("Cal_User_NormalGroups") UserGroupArray2 = Session("Cal_User_AdminGroups") UserGroupArray = Session("Cal_User_AllGroups") If UseSQLServer = "YES" then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= '" & FormatDateFix(DateToUse) & "' AND Cal_EventEndDate >= '" & FormatDateFix(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= #" & FormatDateFix(DateToUse) & "# AND Cal_EventEndDate >= #" & FormatDateFix(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime" End If Set RS=dbc.execute(SQL) 'RS.Filter = "Cal_EventUserID = " & Session("Cal_User_ID") End If Do While NOT RS.EOF If RS("Cal_EventGroupID") <> 2 OR RS("Cal_EventGroupID") = 2 AND RS("Cal_EventUserID") = Session("Cal_User_ID") then If IsEventVisible(RS("Cal_EventGroupID")) = "TRUE" then Return = "YES" Exit Do End If End If Return = "NO" RS.MoveNext Loop CheckForEvent = Return End Function '******* Get Group Array Function ************************************************ Function GetGroupArray(GroupField, GroupValue) If UseSQLServer = "YES" then SQLg = "SELECT Cal_Group_ID FROM Cal_Group WHERE " & GroupField & " = '" & GroupValue & "'" Else SQLg = "SELECT Cal_Group_ID FROM Cal_Group WHERE " & GroupField & " = '" & GroupValue & "'" End If Set RSg=dbc.execute(SQLg) Do While NOT RSg.EOF GroupArray = GroupArray & RSg("Cal_Group_ID") GroupArray = GroupArray & ", " RSg.MoveNext Loop RSg.Close Set RSg=Nothing GroupArray = Left(GroupArray, len(GroupArray) -2) GetGroupArray = GroupArray End Function '******* Get User Group Array Function ******************************************** Function GetUserGroupArray(RightsType) If UseSQLServer = "YES" then SQLg = "SELECT Cal_UG_Link_GroupID FROM Cal_UG_Link WHERE Cal_UG_Link_Type = '" & RightsType & "' AND Cal_UG_Link_UserID = " & Session("Cal_User_ID") Else SQLg = "SELECT Cal_UG_Link_GroupID FROM Cal_UG_Link WHERE Cal_UG_Link_Type = '" & RightsType & "' AND Cal_UG_Link_UserID = " & Session("Cal_User_ID") End If Set RSg=dbc.execute(SQLg) Do While NOT RSg.EOF If RSg("Cal_UG_Link_GroupID") = "9999" then InAll = "YES" End If UserGroupArray = UserGroupArray & RSg("Cal_UG_Link_GroupID") UserGroupArray = UserGroupArray & ", " RSg.MoveNext Loop RSg.Close Set RSg=Nothing If InAll = "YES" then UserGroupArray = "" If UseSQLServer = "YES" then SQLg = "SELECT Cal_Group_ID FROM Cal_Group" Else SQLg = "SELECT Cal_Group_ID FROM Cal_Group" End If Set RSg=dbc.execute(SQLg) Do While NOT RSg.EOF UserGroupArray = UserGroupArray & RSg("Cal_Group_ID") UserGroupArray = UserGroupArray & ", " RSg.MoveNext Loop RSg.Close Set RSg=Nothing End If UserGroupArray = Left(UserGroupArray, len(UserGroupArray) -2) UserGroupArray = UserGroupArray & ", 2" GetUserGroupArray = UserGroupArray End Function '******* Format Time Function **************************************************** Function FormatTime(timeValue) Dim timeReturn If UseSQLServer = "YES" then timeReturnAMPM = right(timeValue, 2) If Len(timeValue) = 6 or Len(timeValue) = 10 then timeValue = left(timeValue,4) timeValue = timeValue + timeReturnAMPM Else timeValue = left(timeValue,5) timeValue = timeValue + timeReturnAMPM End If FormatTime = timeValue Else timeReturnAMPM = right(timeValue, 2) If Len(timeValue) = 10 then timeValue = left(timeValue,4) timeValue = timeValue + timeReturnAMPM Else timeValue = left(timeValue,5) timeValue = timeValue + timeReturnAMPM End If FormatTime = timeValue End If End Function '******* Fix String Function ***************************************************** Function FixString(strSource) strSource = Replace(strSource, "'", "''") strSource = Replace(strSource, "''''", "''") FixString = Replace(strSource, "'''", "''") End Function '******* Format Date Function for European Fix *********************************** Function FormatDateFix(DateValue) DateValueMonth = Month(DateValue) DateValueDay = Day(DateValue) DateValueYear = Year(DateValue) DateValueFix = DateValueMonth & "/" & DateValueDay & "/" & DateValueYear FormatDateFix = DateValueFix End Function '******* Format Time Function 24 or 12 hour ************************************** Function FormatTimeFix(TimeValue, FromArea) Dim Hour Dim Minute Dim ClockTime If TimeFormatToUse = "12" then Hour = DatePart("h", TimeValue) Minute = DatePart("n", TimeValue) If Minute < 10 then Minute = "0" & Minute End If If cDate(TimeValue) > #11:59am# and cDate(TimeValue) =< #12:59pm# then If FromArea = "MONTH" then Clocktime = Hour & ":" & Minute & "PM" Else Clocktime = Hour & ":" & Minute & " PM" End If Else If cDate(TimeValue) => #1:00pm# and cDate(TimeValue) =< #11:59pm# then If FromArea = "MONTH" then Clocktime = cInt(Hour) - 12 & ":" & Minute & "PM" Else Clocktime = cInt(Hour) - 12 & ":" & Minute & " PM" End If Else If cDate(TimeValue) => #12:00am# and cDate(TimeValue) < #1:00am# then If FromArea = "MONTH" then Clocktime = cInt(Hour) + 12 & ":" & Minute & "AM" Else Clocktime = cInt(Hour) + 12 & ":" & Minute & " AM" End If Else If FromArea = "MONTH" then Clocktime = Hour & ":" & Minute & "AM" Else Clocktime = Hour & ":" & Minute & " AM" End If End If End If End If FormatTimeFix = ClockTime Else TempTimeValue = left(TimeValue, 5) FormatTimeFix = TempTimeValue End If End Function %>