" Else response.write "" 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 Sub5Var2 & ": " & Year(theDate) & "" 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 " " 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) If StartWeeksOnMonday <> "YES" then StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) Else If weekday(ThisMonthsFirstDay) <> 1 then StartDate = dateadd("d",2-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) Else StartDate = dateadd("d",-6,ThisMonthsFirstDay) End If End If '------- 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 & "" If request.querystring("action") = "embedmini" then 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 & "" If StartWeeksOnMonday <> "YES" then MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" Else MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" End If MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & " " & MiniSundayName & " " & MiniMondayName & " " & MiniTuesdayName & " " & MiniWednesdayName & " " & MiniThursdayName & " " & MiniFridayName & " " & MiniSaturdayName & " " & MiniMondayName & " " & MiniTuesdayName & " " & MiniWednesdayName & " " & MiniThursdayName & " " & MiniFridayName & " " & MiniSaturdayName & " " & MiniSundayName & " " '-------- Main Calendar Table ------------------------------------- MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" If StartWeeksOnMonday <> "YES" then '-------- 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 Else '-------- If the first day is not monday -------------------------- If weekday(ThisMonthsFirstDay) <> 2 then For Counter = day(StartDate) to day(LastMonthsLastDay) Call DrawOtherMiniDay (Counter) Next End if 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 StartWeeksOnMonday <> "YES" then If weekday(DateToUse) = 7 then MiniOutput = MiniOutput & "" If Counter <> day(ThisMonthsLastDay) then MiniOutput = MiniOutput & "" End If End if Else ' ---- Start Weeks On Monday If weekday(DateToUse) = 1 then MiniOutput = MiniOutput & "" If Counter <> day(ThisMonthsLastDay) then MiniOutput = MiniOutput & "" End If End if End If Next '-------- If last day is not saturday ----------------------------- If StartWeeksOnMonday <> "YES" then If weekday(ThisMonthsLastDay) < 7 then For Counter = 1 to 7 - weekday(ThisMonthsLastDay) DrawOtherMiniDay (Counter) Next End if Else If weekday(ThisMonthsLastDay) <> 1 then For Counter = 1 to 7 - weekday(ThisMonthsLastDay) + 1 DrawOtherMiniDay (Counter) Next End if 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 Sub7Var1 & ": " & MonthName(Month(FirstDate)) & " " & Year(FirstDate) & "" response.write "	" response.write Sub7Var1 & ": " & MonthName(Month(SecondDate)) & " " & Year(SecondDate) & "" response.write "	" response.write Sub7Var1 & ": " & MonthName(Month(ThirdDate)) & " " & Year(ThirdDate) & "" 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 "    " '----- Changed this to allow overnight events ---------------------------------------------- If cdate(RS("Cal_EventStartDate")) = cdate(DateToUse) then If Session("DateFormat") = "US" then response.write FormatTime(RS("Cal_EventStartTime")) Else TempTime = FormatTime(RS("Cal_EventStartTime")) response.write FormatTimeFix(TempTime, "MONTH") End If Else If Session("DateFormat") = "US" then '-- response.write FormatTime(RS("Cal_EventStartTime")) Else '-- TempTime = FormatTime(RS("Cal_EventStartTime")) '-- response.write FormatTimeFix(TempTime, "MONTH") End If End If '------ End Of Change ----------------------------------------------------------------------- response.write " " %>" onclick="NewWindow(this.href,'aspWebCalendar','430','500','yes');return false"><% response.write RS("Cal_EventTitle") & "" If RS("Cal_EventRecurrID") <> "" then response.write " " End If If ShowUserName = "YES" then response.write " " End If If ShowRollInfo = "YES" then 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 " " End If If ShowUserName = "YES" then response.write " " End If If ShowRollInfo = "YES" then 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 Dim SlotArray(20) 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 EventTimeSlot = GetTimeSlot(DateToUse, RS("Cal_EventStartTime"), RS("Cal_EventID")) If Session("CascadeEvents") = "YES" then If EventCounter > 0 then If RS.RecordCount <= 4 then AddtoLeft = 110 Else AddtoLeft = (CascadeWidth / RS.RecordCount) + 5 End If EventLeft = EventLeft + AddtoLeft Else EventLeft = 80 End If If RS.RecordCount <= 4 then EventWidth = 100 Else EventWidth = (CascadeWidth / RS.RecordCount) End If If ClientBrowser = "OTHER" then If EventCounter = 0 then EventLeft = EventLeft + 200 End If End If Else '----- Stacked Events --------------------------- EventWidth = 150 AddtoLeft = 160 * EventTimeSlot - 160 EventLeft = AddtoLeft + 80 If ClientBrowser = "OTHER" then EventLeft = EventLeft + 200 End If End If '----- Changed to allow overnight events ----------------------------------------------- If AllowOvernightEvents = "YES" then If Session("DateFormat") = "US" then If cdate(RS("Cal_EventStartDate")) <> cdate(RS("Cal_EventEndDate")) then If cdate(RS("Cal_EventStartDate")) = cDate(DateToUse) then StartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3) EndTime = FormatDateTime(CDate("11:59PM"),3) Else StartTime = FormatTimeFix(StartTime, "") EndTime = FormatTimeFix(EndTime, "") End If Else StartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3) EndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3) End If Else StartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3) EndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3) StartTime = FormatTimeFix(StartTime, "") EndTime = FormatTimeFix(EndTime, "") End If Else 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 End If '----- End of change -------------------------------------------------------------------- EventHeight = DateDiff("n", StartTime, EndTime) EventTop = DateDiff("n", "12:00a", StartTime) 'EventHeight = ((EventHeight * 19) * 2) / 60 + 1 'EventTop = (((EventTop * 19) * 2)) / 60 If ClientBrowser <> "OTHER" then EventHeight = ((EventHeight * 29) * 2) / 60 + 1 EventTop = (((EventTop * 29) * 2)) / 60 Else 'EventHeight = ((EventHeight * 29) * 2) / 60 + 1 EventHeight = ((EventHeight * 58) / 60) + 1 EventTop = ((EventTop * 58)) / 60 + 32 End If 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") & "" If ShowUserName = "YES" then response.write " " End If response.write "

" 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 If cDate(RS("Cal_EventStartDate")) = cDate(DateToUse) then IsVisible = IsEventVisible(RS("Cal_EventGroupID")) If weekday(DateToUse)=1 AND RS("Cal_EventStartTime")=#10:00AM# then IsVisible = "FALSE" End If If weekday(DateToUse)=1 AND RS("Cal_EventStartTime")=#06:00PM# AND RS("Cal_EventTitle")="Evening Service" then IsVisible = "FALSE" End If If weekday(DateToUse)=1 AND RS("Cal_EventStartTime")=#06:00PM# AND RS("Cal_EventTitle")="Youth Group" then IsVisible = "FALSE" End If If weekday(DateToUse)=4 AND RS("Cal_EventStartTime")=#06:30PM# AND RS("Cal_EventTitle")="Wednesday Night Groups" then IsVisible = "FALSE" End If If weekday(DateToUse)=5 AND RS("Cal_EventStartTime")=#09:30AM# then IsVisible = "FALSE" End If '-- Thursday Bible Study If weekday(DateToUse)=7 AND RS("Cal_EventStartTime")=#06:00PM# AND RS("Cal_EventTitle")="Saturday Service" then IsVisible = "FALSE" End If '-- If IsVisible = "TRUE" then FoundEvent = "YES" TempOutput = "

" TempOutput = TempOutput & "" '-- Changes for Fairton TempOutput = TempOutput & "" TempOutput = TempOutput & "" Else TempOutput = TempOutput & "" & WeekDayName(weekday(DateToUse), True) & ", " & MonthName(month(DateToUse), True) & " " & "" End If Else '-- If weekday(DateToUse)=1 then TempOutput = TempOutput & "" & WeekDayName(weekday(DateToUse), True) & ", " & MonthName(month(DateToUse), True) & " " & day(DateToUse) & "" '-- End If End If Else TempOutput = TempOutput & "" & WeekDayName(weekday(DateToUse), True) & ", " & MonthName(month(DateToUse), True) & " " & day(DateToUse) & "" End If '----- End of change ------------------------------------------------------------------------------------------------ Else TempStartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3) TempStartTime = FormatTimeFix(TempStartTime,"") TempEndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3) TempEndTime = FormatTimeFix(TempEndTime,"") TempOutput = TempOutput & "" & WeekDayName(weekday(DateToUse), True) & ", " & MonthName(month(DateToUse), True) & " " & day(DateToUse) & "" End If Else TempOutput = TempOutput & "" & WeekDayName(weekday(DateToUse), True) & ", " & MonthName(month(DateToUse), True) & " " & day(DateToUse) & "" End If TempOutput = TempOutput & " " If RS("Cal_EventAllDay") <> "TRUE" then If Session("DateFormat") = "US" then '----- Changed to allow overnight events ------------------------------------------------------------------------- If AllowOvernightEvents = "YES" then If cDate(RS("Cal_EventStartDate")) <> cDate(RS("Cal_EventEndDate")) then If cDate(RS("Cal_EventStartDate")) = cDate(DateToUse) then TempOutput = TempOutput & "" & MonthName(month(DateToUse), True) & " " & day(DateToUse) & " - " & day(cdate(RS("Cal_EventEndDate"))) & " " & FormatTime("12:00AM") & " " & FormatTime(RS("Cal_EventStartTime")) & " " & FormatTime(RS("Cal_EventStartTime")) & " " & TempStartTime & " " '-- taken out for new website TempOutput = TempOutput & "" TempOutput = TempOutput & "" '-- HopeX = RS("Cal_EventBody") BodyToWrite = Replace(RS("Cal_EventBody"), vbcrlf, " ") If BodyToWrite = "" then '--TempOutput = TempOutput & "--" Else TempOutput = TempOutput & "" '-- taken out for new website TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" End If '-- added 8/27/2012 per Cathy 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 '-- TempOutput = TempOutput & " " & TitleToWrite & "" '-- If RS("Cal_EventRecurrID") <> "" then '-- TempOutput = TempOutput & "  " '-- End If If ShowUserName = "YES" then TempOutput = TempOutput & " " End If If CanUserModify(RS("Cal_EventGroupID")) = "TRUE" then If AllowOtherUserToEdit = "YES" or Session("Cal_User_ID") = RS("Cal_EventUserID") or Session("Cal_User_RightsLevel") = 1 then TempOutput = TempOutput & " " If CalType = "outside" then TempOutput = TempOutput & "" Else TempOutput = TempOutput & "" End If TempOutput = TempOutput & "" TempOutput = TempOutput & " " If CalType = "outside" then TempOutput = TempOutput & "" Else TempOutput = TempOutput & "" End If TempOutput = TempOutput & "" End If End If TempOutput = TempOutput & "   " TempOutput = TempOutput & BodyToWrite TempOutput = TempOutput & " " TempOutput = TempOutput & "

" If CalType = "inside" then response.write TempOutput End If FinalOutput = FinalOutput & TempOutput End If 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 = " & SafeSQL(request.querystring("eventID")) Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & SafeSQL(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 "

	Fairton Event Detail     " & 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 "" If ShowUserName = "YES" then response.write "" response.write "" response.write "" response.write "" End If 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 " " 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 If AllowOtherUserToEdit = "YES" or Session("Cal_User_ID") = RS("Cal_EventUserID") or Session("Cal_User_RightsLevel") = 1 then %> " onclick="NewWindow(this.href,'aspWebCalendar2','500','440','no');return false"><% response.write "" response.write "" %> " onclick="NewWindow(this.href,'aspWebCalendar2','500','440','no');return false"><% response.write "" response.write "" End If End If %> " onclick="NewWindow(this.href,'aspWebCalendar2','500','440','no');return false"><% response.write "" 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 "" 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 "User / Owner: " SQLu = "SELECT * FROM Cal_User WHERE Cal_User_ID = " & RS("Cal_EventUserID") Set RSu=dbc.execute(SQLu) If NOT RSu.EOF then response.write RSu("Cal_User_FirstName") & " " & RSu("Cal_User_LastName") End If RSu.Close Set RSu=Nothing 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 "

	Fairton Event Detail     " & 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 ******************************************************** '********************************************************************************* '-- Fairton Changed Sub DrawLoginPage response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "

	" & "     " & 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 = '" & SafeSQL(request.form("txtUserName")) & "'" Else SQL = "SELECT * FROM Cal_User WHERE Cal_User_UserName = '" & SafeSQL(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) If NoSummary = "YES" then %><% End If 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  |  D Title Date From " %>" 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 = "CDOSYS" then Set sMail = Server.CreateObject("CDO.Message") Set sMailCon = Server.CreateObject ("CDO.Configuration") With sMailCon .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = EmailHost .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 .Fields.Update End With Set sMail.Configuration = sMailCon With sMail .From = txtSendFrom .To = txtSendTo .Subject = txtSubject .HTMLBody = txtBody .Send End with Set sMail = Nothing 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 EndDateToUse = DateAdd("d", 1, RS("Cal_EventEndDate")) FixEndDay = Day(EndDateToUse) If len(FixEndDay) = 1 then FixEndDay = "0" & FixEndDay End If FixEndMonth = Month(EndDateToUse) If len(FixEndMonth) = 1 then FixEndMonth = "0" & FixEndMonth End If EventStartDate = Year(RS("Cal_EventStartDate")) & FixStartMonth & FixStartDay EventEndDate = Year(EndDateToUse) & FixEndMonth & FixEndDay SELECT CASE Session("TimeZoneBias") CASE "-1" TimeZoneMidnight = "T000000Z" CASE "-2" TimeZoneMidnight = "T010000Z" CASE "-3" TimeZoneMidnight = "T020000Z" CASE "-4" TimeZoneMidnight = "T030000Z" CASE "-5" TimeZoneMidnight = "T040000Z" CASE "-6" TimeZoneMidnight = "T050000Z" CASE "-7" TimeZoneMidnight = "T060000Z" CASE "-8" TimeZoneMidnight = "T070000Z" CASE "-9" TimeZoneMidnight = "T080000Z" CASE ELSE TimeZoneMidnight = "T040000Z" END SELECT VCalEventStart = EventStartDate & TimeZoneMidnight VCalEventEnd = EventEndDate & TimeZoneMidnight 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, "") '----- Fix for overnight events ------------------------------------ If AllowOvernightEvents = "YES" then IsOvernight = "NO" If RS("Cal_EventStartDate") < RS("Cal_EventEndDate") then IsOvernight = "YES" Else IsOvernight = "NO" End If ShowEvent = "YES" If CDate(DateToUse) <> CDate(RS("Cal_EventStartDate")) then ShowEvent = "NO" Else ShowEvent = "YES" End If If ShowEvent = "YES" then VCalTemp = VCalTemp & "BEGIN: VEVENT" & vbCrLF VCalTemp = VCalTemp & "DTStart:" & VCalEventStart & vbCrLF VCalTemp = VCalTemp & "DTEnd:" & VCalEventEnd & vbCrLF VCalTemp = VCalTemp & "Location;ENCODING=QUOTED-PRINTABLE:" & EventLocation & vbCrLF 'pmg put other things in vcs file VCalTemp = VCalTemp & "SUMMARY;ENCODING=QUOTED-PRINTABLE:" & RS("Cal_EventTitle") & RS("Cal_EventUser1") & vbCrLF 'VCalTemp = VCalTemp & "SUMMARY;ENCODING=QUOTED-PRINTABLE:" & RS("Cal_EventTitle") & vbCrLF 'end pmg 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 Else 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 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 "" & VCalTemp & " " '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 "" Set RS=Server.CreateObject("ADODB.RecordSet") If UseSQLServer = "YES" then RS.Open "SELECT * FROM Cal_User ORDER BY Cal_User_LastName, Cal_User_FirstName", dbc, adOpenDynamic, adLockPessimistic, adCMDText Else RS.Open "SELECT * FROM Cal_User ORDER BY Cal_User_LastName, Cal_User_FirstName", dbc, adOpenDynamic, adLockPessimistic, adCMDText End If Do While NOT RS.EOF response.write "" & RS("Cal_User_FirstName") & " " & RS("Cal_User_LastName") & "" RS.MoveNext Loop RS.Close Set RS=Nothing 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) If UsePageTemplate <> "YES" then 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 Else '--------------------------------------------------------------------------------- '----- Pull In the Page Header and Footer ---------------------------------------- '--------------------------------------------------------------------------------- PageTemplate = "calendar.htm" TemplateFile = Server.MapPath(PageTemplate) Set fs = CreateObject("Scripting.FileSystemObject") Set thisfile = fs.OpenTextFile(TemplateFile, 1, False) tempSTR=thisfile.readall TemplateContent = tempSTR thisfile.Close set thisfile=nothing set fs=nothing PageArray = split(TemplateContent, "[CONTENT]") PageHeader = PageArray(0) PageFooter = PageArray(1) If FileToRead = "cal_header.asp" then response.write PageHeader Else response.write PageFooter End If End If 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 '******* 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 '******* Get the number of events for this time ************************************** Function GetTimeSlot(DateToCheck, EventStart, EventID) Dim EventArrayA(96) Dim EventArrayB(96) Dim EventArrayC(96) Dim EventArrayD(96) Dim EventArrayE(96) Dim EventArrayF(96) If UseSQLServer = "YES" then SQLe = "SELECT * FROM Cal_Events WHERE Cal_EventStartDate = '" & FormatDateFix(DateToCheck) & "' ORDER BY Cal_EventStartTime" Else SQLe = "SELECT * FROM Cal_Events WHERE Cal_EventStartDate = #" & DateToCheck & "# ORDER BY Cal_EventStartTime" End If Set RSe=dbc.execute(SQLe) StartTimeMin = 0 EndTimeMin = 0 For A = 1 to 96 EventArrayA(A) = 0 Next For B = 1 to 96 EventArrayB(B) = 0 Next For C = 1 to 96 EventArrayC(C) = 0 Next For D = 1 to 96 EventArrayD(D) = 0 Next For E = 1 to 96 EventArrayE(E) = 0 Next For F = 1 to 96 EventArrayF(F) = 0 Next Do While NOT RSe.EOF 'ThisEventSlot = 0 EventSlotA = "" EventSlotB = "" EventSlotC = "" EventSlotD = "" EventSlotE = "" EventSlotF = "" CanISeeIt = IsEventVisible(RSe("Cal_EventGroupID")) If CanISeeIt = "TRUE" then If RSe("Cal_EventAllDay") <> "TRUE" then StartTimeMin = DateDiff("n", "12:00am", RSe("Cal_EventStartTime")) EndTimeMin = DateDiff("n", "12:00am", RSe("Cal_EventEndTime")) StartTimeMin = StartTimeMin / 15 EndTimeMin = EndTimeMin / 15 '----- Check and Fill A Time Slot ------------------ For E = StartTimeMin + 1 to EndTimeMin If EventArrayA(E) <> 0 then EventSlotA = "NO" End If Next If EventSlotA = "" then For E = StartTimeMin + 1 to EndTimeMin EventArrayA(E) = EventArrayA(E) + 1 Next End If If RSe("Cal_EventID") = EventID and EventSlotA = "" and ThisEventSlot = 0 then ThisEventSlot = "1" End If If EventSlotA = "NO" then For E = StartTimeMin + 1 to EndTimeMin If EventArrayB(E) <> 0 then EventSlotB = "NO" End If Next If EventSlotB = "" then For E = StartTimeMin + 1 to EndTimeMin EventArrayB(E) = EventArrayB(E) + 1 Next End If If RSe("Cal_EventID") = EventID and EventSlotB = "" and ThisEventSlot = 0 then ThisEventSlot = "2" End If End If If EventSlotA = "NO" and EventSlotB = "NO" then For E = StartTimeMin + 1 to EndTimeMin If EventArrayC(E) > 0 then EventSlotC = "NO" End If Next If EventSlotC = "" then For E = StartTimeMin + 1 to EndTimeMin EventArrayC(E) = EventArrayC(E) + 1 Next End If If RSe("Cal_EventID") = EventID and EventSlotC = "" and ThisEventSlot = 0 then ThisEventSlot = "3" End If End If If EventSlotA = "NO" and EventSlotB = "NO" and EventSlotC = "NO" then For E = StartTimeMin + 1 to EndTimeMin If EventArrayD(E) > 0 then EventSlotD = "NO" End If Next If EventSlotD = "" then For E = StartTimeMin + 1 to EndTimeMin EventArrayD(E) = EventArrayD(E) + 1 Next End If If RSe("Cal_EventID") = EventID and EventSlotD = "" and ThisEventSlot = 0 then ThisEventSlot = "4" End If End If If EventSlotA = "NO" and EventSlotB = "NO" and EventSlotC = "NO" and EventSlotD = "NO" then For E = StartTimeMin + 1 to EndTimeMin If EventArraye(E) > 0 then EventSlotE = "NO" End If Next If EventSlotE = "" then For E = StartTimeMin + 1 to EndTimeMin EventArrayE(E) = EventArrayE(E) + 1 Next End If If RSe("Cal_EventID") = EventID and EventSlotE = "" and ThisEventSlot = 0 then ThisEventSlot = "5" End If End If If EventSlotA = "NO" and EventSlotB = "NO" and EventSlotC = "NO" and EventSlotD = "NO" and EventSlotE = "NO" then For E = StartTimeMin + 1 to EndTimeMin If EventArraye(E) > 0 then EventSlotF = "NO" End If Next If EventSlotF = "" then For E = StartTimeMin + 1 to EndTimeMin EventArrayF(E) = EventArrayF(E) + 1 Next End If If RSe("Cal_EventID") = EventID and EventSlotF = "" and ThisEventSlot = 0 then ThisEventSlot = "6" End If End If End If End If RSe.MoveNext Loop EventStartNumber = DateDiff("n", "12:00am", EventStart) EventStartNumber = EventStartNumber / 15 EventStartNumber = EventStartNumber + 1 'EventBeforeSlot = EventStartNumber - 1 'If EventStartNumber <> 0 then ' EventSlot = EventArray(EventStartNumber) 'Else ' EventSlot = 0 'End If 'If EventSlot = "" then ' EventSlot = 0 'End If GetTimeSlot = ThisEventSlot End Function '********************************************************************************* '******** Draw Group List ******************************************************** '********************************************************************************* Sub DrawGroupList LegendColCounter = 1 FilterGroups = Session("Cal_User_AllGroups") TempOutput = "" 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") GroupID = RS("Cal_Group_ID") Else GroupColor = Session("Cal_User_EventColor") GroupName = RS("Cal_Group_Name") GroupID = RS("Cal_Group_ID") End If TempOutput = TempOutput & "" TempOutput = TempOutput & "" TempOutput = TempOutput & "" RS.MoveNext Loop TempOutput = TempOutput & "

" TempOutput = TempOutput & "" TempOutput = TempOutput & " █ " & GroupName & "

" TempOutput = Replace(TempOutput, "'", "\'") %> function ShowGroupList() { var tmpStr; tmpStr = ('<%=TempOutput%>'); document.write(tmpStr); } <% End Sub '******* Format Time Function 24 or 12 hour ************************************** Function FormatTimeFixOLD(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 '******* Format Time Function **************************************************** Function FormatTimeOLD(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 '********************************************************************************* '***** Format Time Function ****************************************************** '********************************************************************************* Function FormatTime(TimeValue) If TimeFormatToUse = "12" then TimeValue = replace(TimeValue," ","") TimeValue = replace(TimeValue,":","") TimeValue = replace(TimeValue,".","") TimeValue = replace(TimeValue,"-","") TimeValue = replace(TimeValue,"e","") TimeValue = replace(TimeValue,"E","") TimeValue = replace(TimeValue,"M","") TimeValue = replace(TimeValue,"m","") If NOT ((ucase(right(TimeValue,1))="A") or (ucase(right(TimeValue,1))="P")) then TimeFormat = "24" Else TempAMPM = ucase(right(TimeValue,1) & "M") End If TimeLength = len(TimeValue)-1 StripTime = left(TimeValue,TimeLength) If len(StripTime) > 4 then StripTime = left(StripTime,len(StripTime)-2) End If If len(StripTime) = 3 then TimePartA = abs(left(StripTime,1)) Else TimePartA = abs(left(StripTime,2)) TimePartB = abs(left(StripTime,2)) End If If left(TimePartA, 1) = 0 then TimePartA = right(TimePartA, len(TimePartA)-1) End If TimePartB = right(StripTime,2) TempTime = TimePartA & ":" & TimePartB & TempAMPM FormatTime = TempTime Else TempTimeValue = left(TimeValue, 5) FormatTime = TempTimeValue End If End Function '********************************************************************************* '***** Format Time Fix Function ************************************************** '********************************************************************************* Function FormatTimeFix(TimeValue, FromArea) If TimeFormatToUse = "12" then TimeValue = replace(TimeValue," ","") TimeValue = replace(TimeValue,":","") TimeValue = replace(TimeValue,".","") TimeValue = replace(TimeValue,"-","") TimeValue = replace(TimeValue,"e","") TimeValue = replace(TimeValue,"E","") TimeValue = replace(TimeValue,"M","") TimeValue = replace(TimeValue,"m","") If NOT ((ucase(right(TimeValue,1))="A") or (ucase(right(TimeValue,1))="P")) then TimeFormat = "24" Else TempAMPM = ucase(right(TimeValue,1) & "M") End If TimeLength = len(TimeValue)-1 StripTime = left(TimeValue,TimeLength) If len(StripTime) > 4 then StripTime = left(StripTime,len(StripTime)-2) End If If len(StripTime) = 3 then TimePartA = abs(left(StripTime,1)) Else TimePartA = abs(left(StripTime,2)) TimePartB = abs(left(StripTime,2)) End If If left(TimePartA, 1) = "0" then TimePartA = right(TimePartA, len(TimePartA)-1) End If TimePartB = right(StripTime,2) TempTime = TimePartA & ":" & TimePartB & TempAMPM FormatTimeFix = TempTime Else TempTimeValue = left(TimeValue, 5) FormatTimeFix = TempTimeValue End If End Function '********************************************************************************* '******** Draw Print Window ****************************************************** '********************************************************************************* Sub DrawPrintWindow(theDate) LightColor = "#EFEFEF" MidLightColor = "#CFCFCF" LightMainColor = "#848485" DarkMainColor = "#525252" LightLineColor = "#757575" PrimaryHighlightColor = "#FBE694" SecondaryHighlightColor = "#EE9515" %> <% response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "

Fairton Christian Calendar - Print Calendars     Select your printing options...

" 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) SELECT CASE CalendarType CASE "month" BeginDate = ThisMonthsFirstDay EndDate = ThisMonthsLastDay CASE "week" WeekDayTitleName = Weekday(theDate, 2) BeginDate = DateAdd("w", 1-WeekDayTitleName, theDate) EndDate = DateAdd("d", 6, BeginDate) CASE "day" BeginDate = theDate CASE "eventlisting" CASE ELSE END SELECT 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 "Calendar Type: " response.write "" response.write " Day " response.write " Week " response.write " Month " response.write " Event List " response.write "Range: " response.write "Begin Date: " response.write "" %> ', 140, 150, window.event.screenY , window.event.screenX)"><% response.write " " response.write " " response.write " End Date: " response.write "" %> ', 140, 150, window.event.screenY , window.event.screenX)"><% response.write " " response.write " Tips: " response.write " " response.write " For best results set printing margins in IE to .25 " response.write " Make sure you have IE set to 'Print background colors and images " response.write " " If ClientBrowser <> "OTHER" then response.write " " Else response.write "" response.write "" End If response.write " " response.write "Print Preview: " response.write "" response.write " " response.write " " response.write "

" End Sub '********************************************************************************* '******** Print Month Calendar *************************************************** '********************************************************************************* Sub PrintMonthCalendar(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) '----- Open a container to hold output ------------------------------------------------- response.write "" response.write "

" '--------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write " " & MonthName(Month(theDate)) & " " & Year(theDate) & " Printed: " & FormatDateTime(Date(),1) & " " response.write "" response.write "" response.write "" response.write "" response.write " " Call PrintMiniCalendar(ThisMonthsFirstDay) response.write " " Call PrintMiniCalendar(NextMonthsFirstDay) response.write " " response.write " " '------- 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 PrintOtherMonthDay (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 PrintMonthNormalDay (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) Call PrintOtherMonthDay (Counter) Next End if '-------- Draw the last row of the calendar ----------------------- response.write "" response.write "" '----- Close container to hold output -------------------------------------------------- response.write "

" '--------------------------------------------------------------------------------------- End Sub Sub PrintMonthNormalDay(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 MonthCalDayStyle = "border-style:outset;border-width:1;bborder-color:gray;text-align:left;vertical-align:top;background-color:#CCCCCC;" Else MonthCalDayStyle = "border-style:outset;border-width:1;border-color:gray;text-align:left;vertical-align:top;background-color:#FFFFFF;border-collapse:collapse;" End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write "

" response.write "" response.write DayNumber response.write "  " response.write "

" response.write "" response.write "" End Sub Sub PrintOtherMonthDay(DayNumber) '--------------------------------------- Draw Other Day response.write "" response.write "" End Sub '********************************************************************************* '******** Print Event Month ****************************************************** '********************************************************************************* Sub PrintEvent(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 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 " " response.write RS("Cal_EventTitle") 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 " " response.write RS("Cal_EventTitle") response.write " " response.write "

" End If End If End If RS.MoveNext Loop End Sub '********************************************************************************* '******** Draw Week View ********************************************************* '********************************************************************************* Sub PrintWeekCalendar(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) FirstDate = DateAdd("w", 1-WeekDayTitleName, theDate) LastDate = DateAdd("d", 6, FirstDate) PageTitle = MonthName(Month(FirstDate)) & " " & Day(FirstDate) & " - " & MonthName(Month(LastDate)) & " " & Day(LastDate) '----- Open a container to hold output ------------------------------------------------- response.write "" response.write "

" '--------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write " " & PageTitle & " Printed: " & FormatDateTime(Date(),1) & " " response.write "" response.write "" response.write "" response.write "" response.write " " Call PrintMiniCalendar(ThisMonthsFirstDay) response.write " " Call PrintMiniCalendar(NextMonthsFirstDay) 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 PrintWeekDayBlock(theDate, 1, "33%") response.write " " Call PrintWeekDayBlock(theDate, 4, "33%") response.write " " Call PrintWeekDayBlock(theDate, 2, "33%") response.write " " Call PrintWeekDayBlock(theDate, 5, "33%") response.write " " Call PrintWeekDayBlock(theDate, 3, "33%") response.write " " Call PrintWeekDayBlock(theDate, 6, "17%") response.write " " Call PrintWeekDayBlock(theDate, 7, "16%") response.write " " '----- Close container to hold output -------------------------------------------------- response.write "

" '--------------------------------------------------------------------------------------- End Sub '------ Draw Week Day Block ------------------------------------------------------ Sub PrintWeekDayBlock(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 "

" response.write DateToShow response.write "" response.write "

" response.write "" 'response.write "" End Sub '********************************************************************************* '******** Print Mini Calendar **************************************************** '********************************************************************************* Sub PrintMiniCalendar(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 & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & " " MiniOutput = MiniOutput & MonthName(Month(theDate)) & " " & Year(theDate) 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 PrintOtherMiniDay (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 PrintMiniNormalDay (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) Call PrintOtherMiniDay (Counter) Next End if '-------- Draw the last row of the calendar ----------------------- MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" '-------- End of Container ---------------------------------------- MiniOutput = MiniOutput & "

" response.write MiniOutput End Sub Sub PrintMiniNormalDay(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 IsThereAnEvent = CheckForEvent(DateToUse) If IsThereAnEvent = "YES" then MonthCalDayClass = "TableMiniDayCellWithEvent" End If MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" If IsThereAnEvent = "YES" then MiniOutput = MiniOutput & "" End If MiniOutput = MiniOutput & DayNumber If IsThereAnEvent = "YES" then MiniOutput = MiniOutput & "" End If MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & "" End Sub Sub PrintOtherMiniDay(DayNumber) '--------------------------------------- Draw Other Day MiniOutput = MiniOutput & "" MiniOutput = MiniOutput & " " MiniOutput = MiniOutput & "" End Sub '********************************************************************************* '******** Print Day View ********************************************************* '********************************************************************************* Sub PrintDayCalendar(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) PageTitle = FormatDateTime(theDate,1) '----- Open a container to hold output ------------------------------------------------- response.write "" response.write "

" '--------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write " " & PageTitle & " Printed: " & FormatDateTime(Date(),1) & " " response.write "" response.write "" response.write "" response.write "" response.write " " Call PrintMiniCalendar(ThisMonthsFirstDay) response.write " " Call PrintMiniCalendar(NextMonthsFirstDay) response.write " " response.write " " '--------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write " " If BrowserType <> "OTHER" then response.write " " Else response.write " " End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write " " response.write "All Day" response.write "  " response.write " " If TimeFormatToUse = "12" then response.write "" Call PrintAgendaRow("12", "am") For I = 1 to 11 Call PrintAgendaRow(I,"00") Next Call PrintAgendaRow("12", "pm") For I = 1 to 11 Call PrintAgendaRow(I, "OO") Next response.write "" Call PrintDayEvent(theDate, "DAY") Else response.write "" Call PrintAgendaRow("00", "00") For I = 1 to 9 Call PrintAgendaRow("0" & I,"00") Next For I = 10 to 23 Call PrintAgendaRow(I,"00") Next response.write "" Call PrintDayEvent(theDate, "DAY") End If response.write " " '----- Close container to hold output -------------------------------------------------- response.write "

" '--------------------------------------------------------------------------------------- End Sub '------ Write Agenda Row -------------------------------------------------------- Sub PrintAgendaRow(TimeToWrite1, TimeToWrite2) response.write "" response.write "" response.write "" & TimeToWrite1 & " " & TimeToWrite2 & "" response.write "" response.write " " response.write "" response.write "" response.write "" response.write " " response.write "" response.write "" End Sub '********************************************************************************* '******** Print Day Event ******************************************************** '********************************************************************************* Sub PrintDayEvent(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 RS.RecordCount >= 1 then RS.MoveFirst EventCounter = 0 End If Dim SlotArray(20) AllDayCounter = 0 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 EventTimeSlot = GetTimeSlot(DateToUse, RS("Cal_EventStartTime"), RS("Cal_EventID")) If Session("CascadeEvents") = "YES" then If EventCounter > 0 then If RS.RecordCount <= 4 then AddtoLeft = 110 Else AddtoLeft = (CascadeWidth / RS.RecordCount) + 5 End If EventLeft = EventLeft + AddtoLeft Else EventLeft = 80 End If If RS.RecordCount <= 4 then EventWidth = 100 Else EventWidth = (CascadeWidth / RS.RecordCount) End If Else '----- Stacked Events --------------------------- EventWidth = 130 AddtoLeft = 140 * EventTimeSlot - 140 EventLeft = AddtoLeft + 65 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 * 16.5) * 2) / 60 + 1) If EventTop > 720 then EventTop = ((((EventTop * 16.5) * 2)) / 60) + 189 Else EventTop = ((((EventTop * 16.5) * 2)) / 60) + 191 End If 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 "

" response.write RS("Cal_EventTitle") & "

" EventCounter = EventCounter + 1 Else EventTop = (AllDayCounter * 11) + 100 EventLeft = 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 "" response.write "" response.write "" response.write " " response.write "" response.write " " response.write RS("Cal_EventTitle") response.write " " response.write "

" AllDayCounter = AllDayCounter + 1 End If End If End If RS.MoveNext Loop End Sub '********************************************************************************* '******** Print Event List ******************************************************* '********************************************************************************* Sub PrintEventList(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) If Request.QueryString("date") = "" Then BeginDateToUse = ThisMonthsFirstDay Else BeginDateToUse = Request.QueryString("date") End If If Request.QueryString("enddate") = "" Then EndDateToUse = NextMonthsFirstDay Else EndDateToUse = Request.QueryString("enddate") End If PageTitle = "Event Listing: " & BeginDateToUse & " - " & EndDateToUse '----- Open a container to hold output ------------------------------------------------- response.write "" response.write "

" '--------------------------------------------------------------------------------------- response.write "" response.write "" 'response.write "" response.write " " & PageTitle & " Printed: " & FormatDateTime(Date(),1) & " " 'response.write "" 'response.write "" 'response.write "" 'response.write "" 'response.write " " 'Call PrintMiniCalendar(ThisMonthsFirstDay) 'response.write " " 'Call PrintMiniCalendar(NextMonthsFirstDay) 'response.write " " 'response.write " " '--------------------------------------------------------------------------------------- DateToUse = cdate(BeginDateToUse) EndDate = cdate(EndDateToUse) NumOfTimes = DateDiff("d", DateToUse, EndDate) For I = 1 to NumOfTimes FinalOutput = "" TempOutput = "" FoundEvent = "" 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 & "    " TitleToWrite = RS("Cal_EventTitle") TempOutput = TempOutput & TitleToWrite 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 & BodyToWrite TempOutput = TempOutput & " " TempOutput = TempOutput & " " FinalOutput = FinalOutput & TempOutput End If End If RS.MoveNext Loop If FoundEvent = "YES" then DayTitle = "" DayTitle = DayTitle & " " & FormatDateTime(DateToUse,1) & " " response.write DayTitle & FinalOutput End If Next '----- Close container to hold output -------------------------------------------------- response.write "

" '--------------------------------------------------------------------------------------- End Sub '********************************************************************************* '******** Determine Browser Type ************************************************* '********************************************************************************* Function GetBrowserType(BrowserAgent) If InStr(BrowserAgent, UCASE("MSIE")) then Browser = "Microsoft Internet Explorer" Else Browser = "OTHER" End If GetBrowserType = Browser End Function '---------------------------------------------------------------- '----- SQL Injection Filter ------------------------------------- '---------------------------------------------------------------- Function SafeSQL(sInput) TempString = sInput 'sBadChars=array("select", "drop", ";", "--", "insert", "delete", "xp_", "#", "%", "&", "'", "(", ")", "/", "\", ":", ";", "<", ">", "=", "[", "]", "?", "`", "|") sBadChars=array("select", "drop", ";", "--", "insert", "delete", "xp_", "#", "%", "&", "'", "(", ")", ":", ";", "<", ">", "=", "[", "]", "?", "`", "|") For iCounter = 0 to uBound(sBadChars) TempString = replace(TempString,sBadChars(iCounter),"") Next SafeSQL = TempString End function %>