<%@ Language=VBScript %> <% Response.Buffer = True %> <% Server.ScriptTimeout = 1000 %> <% '_________________________________________________________________________________ '--------------------------------------------------------------------------------- ' Script Name : aspWebCalendar FREE - Entire Script ' File Name : calendar.asp ' Version : 1.1 ' Creation Date : 4/10/2006 ' Last Update : 3/25/2007 ' Copyright : © 2002 - 2007 Full Revolution, Inc. '_________________________________________________________________________________ '--------------------------------------------------------------------------------- '********************************************************************************* '******** Page Opening Code ****************************************************** '********************************************************************************* %> <% '********************************************************************************* '******** Javascripts ************************************************************ '********************************************************************************* %> <% '********************************************************************************* '******** Determine the Browser Type ********************************************* '********************************************************************************* ClientBrowser = GetBrowserType(request.ServerVariables("HTTP_USER_AGENT")) '********************************************************************************* '******** Required Variables ***************************************************** '********************************************************************************* If Session("ConfigLoaded") = "" or Session("ConfigLoaded") = "NO" then SQL = "SELECT * FROM Cal_Config WHERE Cal_ConfigID = 1" Set RS=dbc.execute(SQL) Session("ScriptTitle") = RS("Cal_ConfigScriptTitle") Session("DefaultColorScheme") = RS("Cal_ConfigDefaultColorScheme") Session("ImageFolder") = RS("Cal_ConfigImageFolder") Session("DateFormat") = RS("Cal_ConfigDateFormat") Session("HTMLTemplate") = RS("Cal_ConfigHTMLTemplate") Session("MainFontFace") = RS("Cal_ConfigMainFontFace") Session("TimeFormatToUse") = RS("Cal_ConfigTimeFormatToUse") Session("MonthBlockHeight") = RS("Cal_ConfigMonthBlockHeight") Session("MiniCalendarWidth") = RS("Cal_ConfigMiniCalendarWidth") Session("DefaultView") = RS("Cal_ConfigDefaultView") Session("LCID") = RS("Cal_ConfigLCID") Session("ConfigLoaded") = "YES" SQLc = "SELECT * FROM Cal_ColorSchemes WHERE ColorSchemeID = " & RS("Cal_ConfigDefaultColorScheme") Set RSc=dbc.execute(SQLc) Session("LightColor") = RSc("LightColor") Session("MidLightColor") = RSc("MidLightColor") Session("LightMainColor") = RSc("LightMainColor") Session("DarkMainColor") = RSc("DarkMainColor") Session("LightLineColor") = RSc("LightLineColor") Session("PrimaryHighlightColor") = RSc("PrimaryHighlightColor") Session("SecondaryHighlightColor") = RSc("SecondaryHighlightColor") RSc.Close Set RSc=Nothing RS.Close Set RS=Nothing End If ScriptTitle = Session("ScriptTitle") DefaultColorScheme = Session("DefaultColorScheme") ImageFolder = Session("ImageFolder") DateFormat = Session("DateFormat") HTMLTemplate = Session("HTMLTemplate") MainFontFace = Session("MainFontFace") TimeFormatToUse = Session("TimeFormatToUse") MonthBlockHeight = Session("MonthBlockHeight") MiniCalendarWidth = Session("MiniCalendarWidth") DefaultView = Session("DefaultView") LCID = Session("LCID") LightColor = Session("LightColor") MidLightColor = Session("MidLightColor") LightMainColor = Session("LightMainColor") DarkMainColor = Session("DarkMainColor") LightLineColor = Session("LightLineColor") PrimaryHighlightColor = Session("PrimaryHighlightColor") SecondaryHighlightColor = Session("SecondaryHighlightColor") MiniCalendarHeight = 1 Session.LCID = LCID MonthSundayName = WeekDayName(1) MonthMondayName = WeekDayName(2) MonthTuesdayName = WeekDayName(3) MonthWednesdayName = WeekDayName(4) MonthThursdayName = WeekDayName(5) MonthFridayName = WeekDayName(6) MonthSaturdayName = WeekDayName(7) MiniSundayName = "S" MiniMondayName = "M" MiniTuesdayName = "T" MiniWednesdayName = "W" MiniThursdayName = "T" MiniFridayName = "F" MiniSaturdayName = "S" '********************************************************************************* '******** Find Out What We Should Be Doing *************************************** '********************************************************************************* '----- UNCOMMENT THE IF STATEMENT WHEN DONE! ------------------------------------- 'If Session("TemplateLoaded") <> "YES" then Call LoadTemplate 'End If If request.form("txtCalSelector") <> "" then Session("CalendarFilter") = request.form("txtCalSelector") End If If Session("CalendarFilter") = "" then Session("CalendarFilter") = 0 End If If request.querystring("calendar") <> "" then Session("CalendarFilter") = request.querystring("calendar") End If Session("CalendarFilter") = cint(Session("CalendarFilter")) If request.querystring("date") <> "" then WorkingDate = UniversalDate(request.querystring("date")) Else WorkingDate = UniversalDate(Date()) End If ScriptAction = request.querystring("action") If ScriptAction = "" then ScriptAction = DefaultView End If SELECT CASE ScriptAction CASE "month" response.write Session("PageHeader") CalType = "month" Call DrawHeaderBar Call DrawMonthView response.write Session("PageFooter") CASE "day" response.write Session("PageHeader") CalType = "day" Call DrawHeaderBar Call DrawDayView response.write Session("PageFooter") CASE "week" response.write Session("PageHeader") CalType = "week" Call DrawHeaderBar Call DrawWeekView response.write Session("PageFooter") CASE "year" response.write Session("PageHeader") CalType = "year" Call DrawHeaderBar Call DrawYearView response.write Session("PageFooter") CASE "viewevent" response.write Session("PageHeader") CalType = "day" Call DrawHeaderBar Call DrawViewEvent response.write Session("PageFooter") CASE "login" Call DrawLogin CASE "processlogin" Call ProcessLogin CASE "logoff" Call LogOff CASE "modifyconfig" Call EditConfig CASE "addevent" Call DrawAddEvent CASE "editevent" Call DrawEditEvent CASE "deleteevent" Call DeleteEvent CASE "managecalendars" Call ManageCalendars CASE "editcalendar" Call ManageCalendars CASE "deletecalendar" Call DeleteCalendar CASE "managecolorschemes" Call ManageColorSchemes CASE "editcolorscheme" Call ManageColorSchemes CASE "deletecolorscheme" Call DeleteColorScheme CASE "securitycheck" Call SecurityCheck CASE "summary" Call DrawSummary CASE "summary2" Call DrawSummary2 CASE "dbaddrecord" Call DBAddRecord CASE "dbupdaterecord" Call DBUpdateRecord CASE ELSE END SELECT dbc.close Set dbc=Nothing '********************************************************************************* '********************************************************************************* '***** Draw Login Screen ********************************************************* '********************************************************************************* Sub DrawLogin Session.Abandon Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Login" response.write "" response.write "" response.write "" '------------------------------------------------------------------------- response.write "" End Sub Sub DrawOtherMonthDay(DayNumber) '--------------------------------------- Draw Other Day response.write "" End Sub '********************************************************************************* '******** Write Event ************************************************************ '********************************************************************************* Sub WriteEvent(DateToUse, CalViewType) If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate = #" & DateToUse & "# ORDER BY Cal_EventStartTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate = #" & DateToUse & "# ORDER BY Cal_EventStartTime" End If Set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic Do While NOT RS.EOF SQLc = "SELECT * FROM Cal_Calendars WHERE Cal_CalendarID = " & RS("Cal_EventCalendarID") Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_CalendarColor") RSc.Close Set RSc=Nothing If RS("Cal_EventAllDay") <> "YES" then 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 "
Password:
 
" response.write "
" If request.querystring("error") = "wrongpassword" then response.write "Sorry the password you have entered is not correct." End If response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Draw Add Event Screen ***************************************************** '********************************************************************************* Sub DrawAddEvent If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Add An Event" response.write "" %> <% response.write "" response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","Add An Event","11pt") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" 'response.write "" 'response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Event Title:
Event Description:" response.write "" response.write "
" response.write "
Event Date: " If Session("DateFormat") = "US" then response.write "" Else response.write "" End If response.write "
  All Day Event
Event Start Time:" response.write "" response.write "
Event End Time:" response.write "" response.write "
Event Calendar:" response.write "" response.write "
Event Link:
Image:" response.write "
" Set FSO = CreateObject("Scripting.FileSystemObject") Set MainFolder = FSO.GetFolder(Server.MapPath("calendar/images/48")) Set ImageFiles = MainFolder.Files IconsAcross = 4 Counter = 0 response.write "" response.write "" For Each X In ImageFiles If right(UCASE(X.Name),3) = "JPG" OR right(UCASE(X.Name),3) = "GIF" OR right(UCASE(X.Name),3) = "PNG" then If Counter = IconsAcross then response.write "" response.write "" Counter = 0 End If response.write "" Counter = Counter + 1 End If Next response.write "
" response.write "
" response.write "
 
" response.write "
" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Draw Edit Event Screen **************************************************** '********************************************************************************* Sub DrawEditEvent If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & SafeSQL(request.querystring("eventID")) Set RS=dbc.execute(SQL) Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Edit An Event" response.write "" %> <% response.write "" response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","Add An Event","11pt") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" 'response.write "" 'response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Event Title:
Event Description:" response.write "" response.write "
" & RS("Cal_EventBody") & "
" response.write "
Event Date: " response.write "" response.write "
  All Day Event
Event Start Time:" response.write "" response.write "
Event End Time:" response.write "" response.write "
Event Calendar:" response.write "" response.write "
Event Link:
Image:" response.write "
" Set FSO = CreateObject("Scripting.FileSystemObject") Set MainFolder = FSO.GetFolder(Server.MapPath("calendar/images/48")) Set ImageFiles = MainFolder.Files IconsAcross = 4 Counter = 0 response.write "" response.write "" For Each X In ImageFiles If right(UCASE(X.Name),3) = "JPG" OR right(UCASE(X.Name),3) = "GIF" OR right(UCASE(X.Name),3) = "PNG" then If Counter = IconsAcross then response.write "" response.write "" Counter = 0 End If response.write "" Counter = Counter + 1 End If Next response.write "
" response.write "
" response.write "
 
" response.write "
" response.write "
" response.write "
" response.write "" '----- Fill in some items ----------------------------------------------- If RS("Cal_EventStartTime") <> "" then %> '"> '"> <% End If If RS("Cal_EventAllDay") = "YES" then %> <% End If RS.Close Set RS=Nothing End Sub '********************************************************************************* '***** Delete Event ************************************************************** '********************************************************************************* Sub DeleteEvent If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "DELETE * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventID") Set RS=dbc.execute(SQL) response.redirect "calendar.asp?date=" & request.querystring("date") End Sub '********************************************************************************* '***** Process Login ************************************************************* '********************************************************************************* Sub ProcessLogin SQL = "SELECT * FROM Cal_Config" Set RS=dbc.execute(SQL) If NOT RS.EOF then If RS("Cal_ConfigAdminPassword") = request.form("txtPassword") then Session("Cal_UserID") = 1 response.redirect "calendar.asp?action=summary&from=login" Else response.redirect "calendar.asp?action=login&error=wrongpassword" End If End If End Sub '********************************************************************************* '******** Process Logoff ********************************************************* '********************************************************************************* Sub Logoff Session.Abandon response.redirect "calendar.asp" End Sub '********************************************************************************* '******** Draw Header Bar ******************************************************** '********************************************************************************* Sub DrawHeaderBar theDate = WorkingDate HeaderText = CalType SELECT CASE HeaderText CASE "month" HeaderInfo = MonthName(Month(theDate)) & " " & Year(theDate) If Month(theDate) > 1 then PrevMonth = Month(theDate) - 1 PrevYear = Year(theDate) Else PrevMonth = 12 PrevYear = Year(theDate) - 1 End If If Month(theDate) < 12 then NextMonth = Month(theDate) + 1 NextYear = Year(theDate) Else NextMonth = 1 NextYear = Year(theDate) + 1 End If PrevDate = PrevYear & "-" & PrevMonth & "-1" NextDate = NextYear & "-" & NextMonth & "-1" CASE "day" HeaderInfo = FormatDateTime(theDate,1) PrevDate = cDate(theDate) - 1 NextDate = cDate(theDate) + 1 CASE "week" WeekDayTitleName = Weekday(theDate, 1) WeekDayTitleName = "Week of " & DateAdd("w", 1-WeekDayTitleName, theDate) HeaderInfo = WeekDayTitleName PrevDate = DateAdd("ww", -1, theDate) NextDate = DateAdd("ww", 1, theDate) CASE "year" PrevDate = DateAdd("yyyy", -1, theDate) NextDate = DateAdd("yyyy", 1, theDate) HeaderInfo = "Year View of " & Year(theDate) CASE "listing" PrevDate = DateAdd("m", -1, theDate) NextDate = DateAdd("m", 1, theDate) HeaderInfo = MonthName(Month(theDate)) & " " & Year(theDate) & " - " & MonthName(Month(DateAdd("m", 2, theDate))) & " " & Year(DateAdd("m", 2, theDate)) END SELECT %> <% '---------- New Button Bar -------------------------------------------------------- response.write "
" response.write "" If ClientBrowser <> "OTHER" then Call DrawButton("button_back.gif","Back a Month","","window.location.reload('calendar.asp?date=" & PrevDate & "&action=" & CalType & "');",30) Call DrawButton("","",HeaderInfo,"",150) Call DrawButton("button_forward.gif","Forward a Month","","window.location.reload('calendar.asp?date=" & NextDate & "&action=" & CalType & "');",30) Call DrawButtonSep Call DrawButton("button_day.gif","Day View","","window.location.reload('calendar.asp?action=day&date=" & theDate & "');",30) Call DrawButton("button_week.gif","Week View","","window.location.reload('calendar.asp?action=week&date=" & theDate & "');",30) Call DrawButton("button_month.gif","Month View","","window.location.reload('calendar.asp?action=month&date=" & theDate & "');",30) Call DrawButton("button_year.gif","Year View","","window.location.reload('calendar.asp?action=year&date=" & theDate & "');",30) Call DrawButton("button_gototoday.gif","Goto Today","","window.location.reload('calendar.asp?action=day&date=" & Date() & "');",30) Call DrawButtonSep Call DrawCalendarSelector Call DrawButtonSep If Session("Cal_UserID") = 1 then Call DrawButton("button_addevent.gif","Add Event","","NewWindow('calendar.asp?action=addevent&date=" & theDate & "','aspWebCalendarADDEVENT','500','540','no');",30) End If If Session("Cal_UserID") = "" then Call DrawButton("button_logon.gif","Login","","NewWindow('calendar.asp?action=login','aspWebCalendarLOGIN','580','430','no');",30) End If If Session("Cal_UserID") = 1 Then Call DrawButtonSep Call DrawButton("button_config.gif","Modify Config","","NewWindow('calendar.asp?action=modifyconfig','aspWebCalendarCONFIG','500','430','no');",30) Call DrawButton("button_calendars.gif","Manage Calendars","","NewWindow('calendar.asp?action=managecalendars','aspWebCalendarCALENDARS','500','400','no');",30) Call DrawButtonSep Call DrawButton("button_logoff.gif","Logoff","","window.location.reload('calendar.asp?action=logoff');",30) End If Else Call DrawBadBrowserButton("button_back.gif","Back a Month","","calendar.asp?date=" & PrevDate & "&action=" & CalType,30) Call DrawBadBrowserButton("","",HeaderInfo,"",150) Call DrawBadBrowserButton("button_forward.gif","Forward a Month","","calendar.asp?date=" & NextDate & "&action=" & CalType,30) Call DrawButtonSep Call DrawBadBrowserButton("button_day.gif","Day View","","calendar.asp?action=day&date=" & theDate & "",30) Call DrawBadBrowserButton("button_week.gif","Week View","","calendar.asp?action=week&date=" & theDate,30) Call DrawBadBrowserButton("button_month.gif","Month View","","calendar.asp?action=month&date=" & theDate,30) Call DrawBadBrowserButton("button_year.gif","Year View","","calendar.asp?action=year&date=" & theDate,30) Call DrawBadBrowserButton("button_gototoday.gif","Goto Today","","calendar.asp?action=day&date=" & Date() & "",30) Call DrawButtonSep Call DrawCalendarSelector Call DrawButtonSep If Session("Cal_UserID") = 1 then Call DrawButton("button_addevent.gif","Add Event","","NewWindow('calendar.asp?action=addevent&date=" & theDate & "','aspWebCalendarADDEVENT','500','540','no');",30) End If If Session("Cal_UserID") = "" then Call DrawButton("button_logon.gif","Login","","NewWindow('calendar.asp?action=login','aspWebCalendarLOGIN','580','430','no');",30) End If If Session("Cal_UserID") = 1 Then Call DrawButtonSep Call DrawBadBrowserButton("button_config.gif","Modify Config","","NewWindow('calendar.asp?action=modifyconfig','aspWebCalendarCONFIG','500','600','yes');",30) Call DrawBadBrowserButton("button_calendars.gif","Manage Calendars","","NewWindow('calendar.asp?action=managecalendars','aspWebCalendarCALENDARS','500','400','no');",30) Call DrawButtonSep Call DrawBadBrowserButton("button_logoff.gif","Logoff","","calendar.asp?action=logoff",30) End If End If response.write "
" response.write "
" '----------------------------------------------------------------------------------- End Sub '********************************************************************************* '******** Draw Month View ******************************************************** '********************************************************************************* Sub DrawMonthView '------- Setup some information about the month ----------------- ThisMonthsFirstDay = Year(WorkingDate) & "-" & Month(WorkingDate) & "-1" NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) '------- Draw the beginning of the calendar ---------------------- response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" & MonthSundayName & "" & MonthMondayName & "" & MonthTuesdayName & "" & MonthWednesdayName & "" & MonthThursdayName & "" & MonthFridayName & "" & MonthSaturdayName & "
" '-------- Main Calendar Table ------------------------------------- response.write "" response.write "" '-------- If the first day is not sunday -------------------------- If weekday(ThisMonthsFirstDay) > 1 then For Counter = day(StartDate) to day(LastMonthsLastDay) Call DrawOtherMonthDay(Counter) Next End If '-------- Draw normal days after Saturday, start a new row -------- For Counter = 1 to day(ThisMonthsLastDay) DateToUse = Year(WorkingDate) & "-" & Month(WorkingDate) & "-" & Counter Call DrawMonthNormalDay(Counter) If weekday(DateToUse) = 7 then response.write "" If Counter <> day(ThisMonthsLastDay) then response.write "" End If End if Next '-------- If last day is not saturday ----------------------------- If weekday(ThisMonthsLastDay) < 7 then For Counter = 1 to 7 - weekday(ThisMonthsLastDay) Call DrawOtherMonthDay(Counter) Next End If '-------- Draw the last row of the calendar ----------------------- response.write "" response.write "
" End Sub Sub DrawMonthNormalDay(DayNumber) '----------------------------------- Draw a Normal Day DateToUse = Year(WorkingDate) & "-" & Month(WorkingDate) & "-" & DayNumber If Date() = cDate(DateToUse) then MonthCalDayClass = "TableMonthDayCellToday" Else MonthCalDayClass = "TableMonthDayCell" End If response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write DayNumber response.write "  " response.write "
" 'response.write "
" Call WriteEvent(DateToUse, "MONTH") 'response.write "
" response.write "
" response.write "
" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" End If response.write "" response.write "" response.write "
  " response.write FormatTime(RS("Cal_EventStartTime")) response.write "" response.write "" response.write "" response.write "" response.write RS("Cal_EventTitle") & "" response.write "
" response.write "
" Else response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" End If response.write "" response.write "" response.write "
"" then response.write " colspan=2" End If response.write ">" response.write "" response.write "
" response.write "" response.write "" response.write "" response.write RS("Cal_EventTitle") & "" response.write "
" response.write "
" End If RS.MoveNext Loop RS.Close Set RS=Nothing End Sub '********************************************************************************* '******** Draw Mini Calendar ***************************************************** '********************************************************************************* Sub DrawMiniCalendar(theDate) '------- Setup some information about the month ----------------- ThisMonthsFirstDay = Year(theDate) & "-" & Month(theDate) & "-1" 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 ---------------------- response.write "" response.write "
" '------- Draw the month heading ---------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write MonthName(Month(theDate)) & " " & Year(theDate) 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 "" 'response.write "
 " & MiniSundayName & "" & MiniMondayName & "" & MiniTuesdayName & "" & MiniWednesdayName & "" & MiniThursdayName & "" & MiniFridayName & "" & MiniSaturdayName & "
" '-------- Main Calendar Table ------------------------------------- 'response.write "" response.write "" '----- Draw the Week button --------------------------------------- response.write "" '-------- If the first day is not sunday -------------------------- If weekday(ThisMonthsFirstDay) > 1 then For Counter = day(StartDate) to day(LastMonthsLastDay) Call DrawOtherMiniDay(Counter) Next End If '-------- Draw normal days after Saturday, start a new row -------- For Counter = 1 to day(ThisMonthsLastDay) DateToUse = Year(theDate) & "-" & Month(theDate) & "-" & Counter Call DrawMiniNormalDay(Counter, DateToUse) If weekday(DateToUse) = 7 then response.write "" If Counter <> day(ThisMonthsLastDay) then response.write "" '----- Draw the Week button --------------------------------------- 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 DrawOtherMiniDay(Counter) Next End If '-------- Draw the last row of the calendar ----------------------- response.write "" response.write "
W
W
" '-------- End of Container ---------------------------------------- response.write "

" End Sub Sub DrawMiniNormalDay(DayNumber, theDate) '----------------------------------- Draw a Normal Day DateToUse = Year(theDate) & "-" & Month(theDate) & "-" & DayNumber If Date() = cDate(DateToUse) then MonthCalDayClass = "TableMiniDayCellToday" Else MonthCalDayClass = "TableMiniDayCell" End If IsThereAnEvent = CheckForEvent(DateToUse) If IsThereAnEvent = "YES" then MonthCalDayClass = "TableMiniDayCellWithEvent" End If response.write "" response.write "" response.write "" response.write DayNumber response.write "" response.write "" End Sub Sub DrawOtherMiniDay(DayNumber) '--------------------------------------- Draw Other Day response.write "" response.write " " response.write "" End Sub '********************************************************************************* '******** Draw Day View ********************************************************** '********************************************************************************* Sub DrawDayView %> <% response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" TitleToWrite = "Events for: " & FormatDateTime(WorkingDate,1) & "" Call DrawTitle("100%","24",TitleToWrite,"11pt") Call DrawHLine(2) '----- Draw out the events ----------------------------------------------------- If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate = #" & WorkingDate & "# ORDER BY Cal_EventStartTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate = #" & WorkingDate & "# ORDER BY Cal_EventStartTime" End If Set RS=dbc.execute(SQL) If RS.EOF then '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "There are no events on this date." response.write "" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- End If Do While NOT RS.EOF '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "
" response.write RS("Cal_EventTitle") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventAllDay") = "YES" then response.write "" Else response.write "" End If If Session("Cal_UserID") = 1 then response.write "" End If 'If RS("Cal_EventLink") <> "" then ' response.write "" 'Else ' response.write "" 'End If response.write "
Date:" & FormatDateTime(RS("Cal_EventDate"),1) & "
Title:" & RS("Cal_EventTitle") & "
Description:" & RS("Cal_EventBody") & "
Times:ALL DAY EVENT
Times:" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & "
ADMIN:" response.write "EDIT | " response.write "DELETE" response.write "
Link:" & RS("Cal_EventLink") & "
Link:NONE
" response.write "

" RS.MoveNext '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- Loop RS.Close Set RS=Nothing response.write "
" PreviousMonth = DateAdd("m",-1,WorkingDate) NextMonth = DateAdd("m",1,WorkingDate) Call DrawMiniCalendar(PreviousMonth) Call DrawMiniCalendar(WorkingDate) Call DrawMiniCalendar(NextMonth) response.write "
" End Sub '********************************************************************************* '******** Draw Week View ********************************************************* '********************************************************************************* Sub DrawWeekView %> <% '----- Change the working date to the first day of the current week ----------- WeekDayTitleName = Weekday(WorkingDate, 1) WorkingDate = DateAdd("w", 1-WeekDayTitleName, WorkingDate) response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" TitleToWrite = "Events between: " & FormatDateTime(WorkingDate,1) & " and " & FormatDateTime(DateAdd("d",6,WorkingDate),1) & "" Call DrawTitle("100%","24",TitleToWrite,"11pt") Call DrawHLine(2) For I = 1 to 7 If I > 1 then WorkingDate = DateAdd("d",1,WorkingDate) End If TitleToWrite = "Events for: " & FormatDateTime(WorkingDate,1) & "" Call DrawSmallTitle("100%","18",TitleToWrite,"9pt") '----- Draw out the events ----------------------------------------------------- If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate = #" & WorkingDate & "# ORDER BY Cal_EventStartTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate = #" & WorkingDate & "# ORDER BY Cal_EventStartTime" End If Set RS=dbc.execute(SQL) If RS.EOF then '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "There are no events on this date." response.write "" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- End If Do While NOT RS.EOF '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "
" response.write RS("Cal_EventTitle") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventAllDay") = "YES" then response.write "" Else response.write "" End If If Session("Cal_UserID") = 1 then response.write "" End If 'If RS("Cal_EventLink") <> "" then ' response.write "" 'Else ' response.write "" 'End If response.write "
Date:" & FormatDateTime(RS("Cal_EventDate"),1) & "
Title:" & RS("Cal_EventTitle") & "
Description:" & RS("Cal_EventBody") & "
Times:ALL DAY EVENT
Times:" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & "
ADMIN:" response.write "EDIT | " response.write "DELETE" response.write "
Link:" & RS("Cal_EventLink") & "
Link:NONE
" response.write "

" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- RS.MoveNext Loop RS.Close Set RS=Nothing Next response.write "
" PreviousMonth = DateAdd("m",-1,WorkingDate) NextMonth = DateAdd("m",1,WorkingDate) Call DrawMiniCalendar(PreviousMonth) Call DrawMiniCalendar(WorkingDate) Call DrawMiniCalendar(NextMonth) response.write "
" End Sub '********************************************************************************* '******** Draw Year View ********************************************************* '********************************************************************************* Sub DrawYearView %> <% response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" TitleToWrite = "Events between: " & FormatDateTime(WorkingDate,1) & " and " & FormatDateTime(DateAdd("y",1,WorkingDate),1) & "" Call DrawTitle("100%","24",TitleToWrite,"11pt") Call DrawHLine(2) For I = 1 to 12 If I > 1 then WorkingDate = DateAdd("m",1,WorkingDate) End If '------- Setup some information about the month ----------------- ThisMonthsFirstDay = Year(WorkingDate) & "-" & Month(WorkingDate) & "-1" NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) TitleToWrite = "Events for: " & MonthName(Month(WorkingDate)) & " " & Year(WorkingDate) & "" Call DrawSmallTitle("100%","18",TitleToWrite,"9pt") '----- Draw out the events ----------------------------------------------------- If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate >= #" & ThisMonthsFirstDay & "# AND Cal_EventDate <= #" & ThisMonthsLastDay & "# ORDER BY Cal_EventDate, Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate >= #" & ThisMonthsFirstDay & "# AND Cal_EventDate <= #" & ThisMonthsLastDay & "# ORDER BY Cal_EventDate, Cal_EventStartTime, Cal_EventEndTime" End If Set RS=dbc.execute(SQL) If RS.EOF then '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "There are no events on this date." response.write "" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- End If Do While NOT RS.EOF '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "
" response.write RS("Cal_EventTitle") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventAllDay") = "YES" then response.write "" Else response.write "" End If If Session("Cal_UserID") = 1 then response.write "" End If 'If RS("Cal_EventLink") <> "" then ' response.write "" 'Else ' response.write "" 'End If response.write "
Date:" & FormatDateTime(RS("Cal_EventDate"),1) & "
Title:" & RS("Cal_EventTitle") & "
Description:" & RS("Cal_EventBody") & "
Times:ALL DAY EVENT
Times:" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & "
ADMIN:" response.write "EDIT | " response.write "DELETE" response.write "
Link:" & RS("Cal_EventLink") & "
Link:NONE
" response.write "

" RS.MoveNext '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- Loop RS.Close Set RS=Nothing Next response.write "
" PreviousMonth = DateAdd("m",-1,WorkingDate) NextMonth = DateAdd("m",1,WorkingDate) Call DrawMiniCalendar(PreviousMonth) Call DrawMiniCalendar(WorkingDate) Call DrawMiniCalendar(NextMonth) response.write "
" End Sub '********************************************************************************* '******** Draw View Event ******************************************************** '********************************************************************************* Sub DrawViewEvent %> <% response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" TitleToWrite = "Event View: " Call DrawTitle("100%","24",TitleToWrite,"11pt") Call DrawHLine(2) SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & SafeSQL(request.querystring("eventid")) Set RS=dbc.execute(SQL) If NOT RS.EOF then '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "
" response.write RS("Cal_EventTitle") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventAllDay") = "YES" then response.write "" Else response.write "" End If If Session("Cal_UserID") = 1 then response.write "" End If 'If RS("Cal_EventLink") <> "" then ' response.write "" 'Else ' response.write "" 'End If response.write "
Date:" & FormatDateTime(RS("Cal_EventDate"),1) & "
Title:" & RS("Cal_EventTitle") & "
Description:" & RS("Cal_EventBody") & "
Times:ALL DAY EVENT
Times:" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & "
ADMIN:" response.write "EDIT | " response.write "DELETE" response.write "
Link:" & RS("Cal_EventLink") & "
Link:NONE
" response.write "

" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- End If RS.Close Set RS=Nothing response.write "
" PreviousMonth = DateAdd("m",-1,WorkingDate) NextMonth = DateAdd("m",1,WorkingDate) Call DrawMiniCalendar(PreviousMonth) Call DrawMiniCalendar(WorkingDate) Call DrawMiniCalendar(NextMonth) response.write "
" End Sub '********************************************************************************* '***** Draw Manage Calendars Screen ********************************************** '********************************************************************************* Sub ManageCalendars If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If %> <% Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Manage Calendars" response.write "" %> <% response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","Manage Calendars","11pt") response.write "" response.write "" response.write "" If request.querystring("action") = "managecalendars" then response.write "" response.write "" Else SQLc = "SELECT * FROM Cal_Calendars WHERE Cal_CalendarID = " & SafeSQL(request.querystring("calendarID")) Set RSc=dbc.execute(SQLc) response.write "" response.write "" RSc.Close Set RSc=Nothing End If response.write "
" response.write "
" ColorCounter = 0 response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" SQL = "SELECT * FROM Cal_Calendars ORDER BY Cal_CalendarName" Set RS=dbc.execute(SQL) Do While NOT RS.EOF If ColorCounter = 0 then BackColor = "white" ColorCounter = 1 Else BackColor = "#EEEEEE" ColorCounter = 0 End If response.write "" response.write "" response.write "" response.write "" response.write "" RS.MoveNext Loop response.write "
Calendar NameColorActions
" & RS("Cal_CalendarName") & "" response.write "" response.write "█ " response.write RS("Cal_CalendarColor") & "EDIT | DELETE
" response.write "
" response.write "
" response.write "
Add A Calendar" '------------------------------------------------------------------------------- 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 "
Calendar Name:
Calendar Color: " response.write "" response.write "
 
" response.write "
" response.write "
" '------------------------------------------------------------------------------- response.write "
" response.write "
" response.write "
Edit Calendar" '------------------------------------------------------------------------------- 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 "
Calendar Name:
Calendar Color: " response.write "" response.write "
 
" response.write "
" response.write "
" '------------------------------------------------------------------------------- response.write "
" response.write "
" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Delete Calendar *********************************************************** '********************************************************************************* Sub DeleteCalendar If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "DELETE * FROM Cal_Events WHERE Cal_EventCalendarID = " & SafeSQL(request.querystring("calendarID")) Set RS=dbc.execute(SQL) SQL = "DELETE * FROM Cal_Calendars WHERE Cal_CalendarID = " & SafeSQL(request.querystring("calendarID")) Set RS=dbc.execute(SQL) response.redirect "calendar.asp?action=managecalendars" End Sub '********************************************************************************* '***** Draw Edit Config Screen *************************************************** '********************************************************************************* Sub EditConfig If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "SELECT * FROM Cal_Config WHERE Cal_ConfigID = 1" Set RS=dbc.execute(SQL) Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Edit Configuration" 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 DrawTitle2("100%","24","Edit Configuration","11pt") response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "
" response.write "" response.write "" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Script Title:
Admin Password:
Default Color Scheme:" response.write "
Image Folder:
Date Format:" response.write " US (mm/dd/yyyy) " response.write " EURO (dd/mm/yyyy) " response.write "
LCID:" response.write "" response.write "
TimeFormatToUse:" response.write " 12 Hour (AM/PM) " response.write " 24 Hour (Military Time) " response.write "
HTML Template:
Main Font Face:
Month Block Height:
MiniCalendarWidth:
DefaultView:" response.write " Day " response.write " Week " response.write " Month " response.write " Year " 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 "" RS.Close Set RS=Nothing End Sub '********************************************************************************* '***** Security Check ************************************************************ '********************************************************************************* Sub SecurityCheck Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - SECURITY CHECK" response.write "" %> <% response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","SECURITY CHECK","11pt") response.write "" response.write "" response.write "" response.write "
" response.write "SORRY! YOU DON'T HAVE ACCESS TO THIS FUNCTION!" response.write "
" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Draw Manage Color Schemes Screen ****************************************** '********************************************************************************* Sub ManageColorSchemes If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If %> <% Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Manage ColorSchemes" response.write "" %> <% response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","Manage Color Schemes","11pt") response.write "" response.write "" response.write "" If request.querystring("action") = "managecolorschemes" then response.write "" response.write "" Else SQLc = "SELECT * FROM Cal_ColorSchemes WHERE ColorSchemeID = " & SafeSQL(request.querystring("colorschemeID")) Set RSc=dbc.execute(SQLc) response.write "" response.write "" RSc.Close Set RSc=Nothing End If response.write "
" response.write "
" ColorCounter = 0 response.write "" response.write "" response.write "" response.write "" response.write "" SQL = "SELECT * FROM Cal_ColorSchemes ORDER BY ColorSchemeName" Set RS=dbc.execute(SQL) Do While NOT RS.EOF If ColorCounter = 0 then BackColor = "white" ColorCounter = 1 Else BackColor = "#EEEEEE" ColorCounter = 0 End If response.write "" response.write "" response.write "" Else response.write "CURRENT" End If response.write "" RS.MoveNext Loop response.write "
Color Scheme NameActions
" & RS("ColorSchemeName") & "EDIT | " If RS("ColorSchemeID") <> cint(Session("DefaultColorScheme")) then response.write "DELETE
" response.write "
" response.write "
" response.write "
Add A Color Scheme" '------------------------------------------------------------------------------- response.write "" response.write "" response.write "
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Color Scheme Name:
Light Color: " response.write "" response.write "
Mid Light Color: " response.write "" response.write "
Light Main Color: " response.write "" response.write "
Dark Main Color: " response.write "" response.write "
Light Line Color: " response.write "" response.write "
Primary Highlight Color: " response.write "" response.write "
Secondary Highlight Color: " response.write "" response.write "
 
" response.write "
" response.write "
" '------------------------------------------------------------------------------- response.write "
" response.write "
" response.write "
Add A Color Scheme" '------------------------------------------------------------------------------- response.write "" response.write "" response.write "
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Color Scheme Name:
Light Color: " response.write "" response.write "
Mid Light Color: " response.write "" response.write "
Light Main Color: " response.write "" response.write "
Dark Main Color: " response.write "" response.write "
Light Line Color: " response.write "" response.write "
Primary Highlight Color: " response.write "" response.write "
Secondary Highlight Color: " response.write "" response.write "
 
" response.write "
" response.write "
" '------------------------------------------------------------------------------- response.write "
" response.write "
" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Delete ColorScheme ******************************************************** '********************************************************************************* Sub DeleteColorScheme If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "DELETE * FROM Cal_ColorSchemes WHERE ColorSchemeID = " & SafeSQL(request.querystring("colorschemeID")) Set RS=dbc.execute(SQL) response.redirect "calendar.asp?action=managecolorschemes" End Sub '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '******** FUNCTIONS ONLY BELOW HERE ************************************************* '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '********************************************************************************* '******** Build Style Tags ******************************************************* '********************************************************************************* Sub BuildStyles StyleCode = "" StyleCode = StyleCode & ".TableMonthHeader{font-family:" & MainFontFace & ";font-size:9pt;font-weight:bold;color:black}" & vbcrlf StyleCode = StyleCode & ".MonthHeadings{width:14%;text-align:center;font-size:9pt;font-family:" & MainFontFace & ";background-color:" & DarkMainColor & ";border-top:1px solid " & LightLineColor & ";border-bottom:1px solid " & LightLineColor & ";color:white;font-weight:bold;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightMainColor & "', EndColorStr='" & DarkMainColor & "')}" & vbcrlf StyleCode = StyleCode & ".TableMonthCalendar{font-family:" & MainFontFace & ";height:95%;padding:0;background-color:white;border-collapse:collapse;border-style:none;border-color:black" & LightLineColor & ";}" & vbcrlf StyleCode = StyleCode & ".TableMonthDayCellToday{font-family:" & MainFontFace & ";border-style:solid;border-width:1;border-color:" & LightLineColor & ";text-align:left;vertical-align:top;background-color:#CCCCCC;}" & vbcrlf StyleCode = StyleCode & ".TableMonthDayCell{font-family:" & MainFontFace & ";border-style:solid;border-width:1;border-color:" & LightLineColor & ";text-align:left;vertical-align:top;background-color:#FFFFFF;border-collapse:collapse;}" & vbcrlf StyleCode = StyleCode & ".MonthSubHeadings{font-family:" & MainFontFace & ";font-size:8pt;background-color:" & MidLightColor & ";color:black;font-weight:normal;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".TableMonthOtherDayCell{font-family:" & MainFontFace & ";border-style:solid;border-width:1;border-color:" & LightLineColor & ";text-align:center;vertical-align:top;background-color:" & MidLightColor & ";border-collapse:collapse;}" & vbcrlf StyleCode = StyleCode & ".EventTable{font-family:" & MainFontFace & ";border-style:solid;border-width:1;border-color:black;border-collapse:collapse;border-width:1;text-align:left;background-color:white;padding:1;width:100%;}" & vbcrlf StyleCode = StyleCode & ".EventTitleFont{font-family:" & MainFontFace & ";font-size:7pt;}" & vbcrlf StyleCode = StyleCode & ".EventTimeCell{font-family:" & MainFontFace & ";font-size:7pt;width:10%;text-align:left;background-color:#DDDDDD;}" & vbcrlf StyleCode = StyleCode & ".EventTimeFont{font-family:" & MainFontFace & ";font-size:7pt;}" & vbcrlf StyleCode = StyleCode & ".EventTitleCell{font-family:" & MainFontFace & ";font-size:7pt;width:90%;text-align:left;background-color:white;}" & vbcrlf StyleCode = StyleCode & ".EventTitleFont{font-family:" & MainFontFace & ";font-size:7pt;}" & vbcrlf StyleCode = StyleCode & ".EventTitleCellAllDay{font-family:" & MainFontFace & ";font-size:7pt;text-align:center}" & vbcrlf StyleCode = StyleCode & ".MonthDayDiv{width:100%;height:85%;overflow:visible;}" & vbcrlf StyleCode = StyleCode & ".MiniHeadingBar{background-color:" & LightMainColor & ";height:19px;text-align:center;border-top:1px solid " & LightLineColor & ";border-bottom:1px solid " & LightLineColor & ";font-family:" & MainFontFace & ";font-size:8pt;color:black;font-weight:bold;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".TableMiniHeader{height:1;padding:0;background-color:white;border-style:solid;border-color:" & LightLineColor & ";border-width:0;border-collapse:collapse;}" & vbcrlf StyleCode = StyleCode & ".MiniCalHeading{width:14%;font-family:" & MainFontFace & ";font-size:8pt;color:black;font-weight:normal;background-color:" & LightColor & ";text-align:center;}" & vbcrlf StyleCode = StyleCode & ".TableMiniCalendar{padding:0;background-color:white;border-collapse:collapse;border-width:0;border-style:none;}" & vbcrlf StyleCode = StyleCode & ".TableMiniDayCellToday{border-style:solid;border-width:1;border-color:white;text-align:center;vertical-align:top;background-color:silver;padding:0;}" & vbcrlf StyleCode = StyleCode & ".TableMiniDayCell{border-style:solid;border-width:1;border-color:white;text-align:center;vertical-align:center;background-color:white;padding:0;border-collapse:collapse;cursor:hand;}" & vbcrlf StyleCode = StyleCode & ".TableMiniDayCellWithEvent{border-style:solid;border-width:1;border-color:white;text-align:center;vertical-align:center;background-color:" & PrimaryHighlightColor & ";padding:0;border-collapse:collapse;cursor:hand}" & vbcrlf StyleCode = StyleCode & ".FontCalendarDay{font-family:" & MainFontFace & ";font-size:7pt;}" & vbcrlf StyleCode = StyleCode & ".TableMiniOtherDayCell{border-style:solid;border-width:1;border-color:white;text-align:center;vertical-align:center;background-color:" & MidLightColor & ";padding:0;border-collapse:collapse;}" & vbcrlf StyleCode = StyleCode & ".EventLeftTD{width:20%;font-family:" & MainFontFace & ";font-size:8pt;font-weight:bold;background-color:" & LightColor & ";}" & vbcrlf StyleCode = StyleCode & ".EventRightTD{width:80%;font-family:" & MainFontFace & ";font-size:8pt;}" & vbcrlf StyleCode = StyleCode & ".EventTitleBar{background-color:" & MidLightColor & ";height:19px;text-align:left;border-top:1px solid " & LightLineColor & ";border-bottom:1px solid " & LightLineColor & ";font-family:" & MainFontFace & ";font-size:10pt;color:black;font-weight:bold;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightMainColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".ButtonBar{background-color:" & LightColor & ";padding-top:1px;width:100%;height:30px;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".Button{background-color:" & LightColor & ";cursor:hand;padding:1px 1px 1px 1px;height:27px;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".ButtonOver{background-color:" & MidLightColor & ";cursor:hand;border: 1px solid " & LightLineColor & ";height:27px;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & PrimaryHighlightColor & "', EndColorStr='" & SecondaryHighlightColor & "')}" & vbcrlf StyleCode = StyleCode & ".ButtonFont{font-family:" & MainFontFace & ";font-size:9pt;font-weight:bold;}" & vbcrlf StyleCode = StyleCode & ".PageBody{background-color:" & DarkMainColor & ";filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='" & LightMainColor & "', EndColorStr='" & DarkMainColor & "')}" & vbcrlf StyleCode = StyleCode & ".SideBar{background-color:" & DarkMainColor & ";filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='" & LightMainColor & "', EndColorStr='" & DarkMainColor & "')}" & vbcrlf StyleCode = StyleCode & ".StandardFont{font-family:" & MainFontFace & ";font-size:8pt;color:black;font-weight:bold;}" & vbcrlf StyleCode = StyleCode & ".StandardTextBox{font-family:" & MainFontFace & ";font-size:8pt;color:black;font-weight:normal;width:100%;}" & vbcrlf StyleCode = StyleCode & ".DescriptionHeadingFont{font-family:" & MainFontFace & ";font-size:13pt;color:yellow;font-weight:bold;}" & vbcrlf StyleCode = StyleCode & ".DescriptionFont{font-family:" & MainFontFace & ";font-size:8pt;color:white;font-weight:normal;}" & vbcrlf StyleCode = StyleCode & ".EditPaneTable{width:99%; border:0px;}" & vbcrlf StyleCode = StyleCode & ".EditPaneLeft{width:25%;font-family:Arial;font-size:8pt;}" & vbcrlf StyleCode = StyleCode & ".EditPaneRight{width:75%;font-family:Arial;font-size:8pt;}" & vbcrlf StyleCode = StyleCode & ".ErrorFont{font-family:" & MainFontFace & ";font-size:8pt;color:red;font-weight:bold;}" & vbcrlf Session("StyleCode") = StyleCode End Sub '********************************************************************************* '******** Load the Template File We are Using ************************************ '********************************************************************************* Sub LoadTemplate Call BuildStyles TemplateFile = Server.MapPath(HTMLTemplate) 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 TemplateContent = replace(TemplateContent,"%%STYLES%%",Session("StyleCode")) TemplateArray = split(TemplateContent,"%%CONTENT%%") Session("PageHeader") = TemplateArray(0) Session("PageFooter") = TemplateArray(1) Session("TemplateLoaded") = "YES" End Sub '********************************************************************************* '******** Draw Summary Window **************************************************** '********************************************************************************* Sub DrawSummary %> Indianfields <% End Sub '********************************************************************************* '******** Draw Summary Window **************************************************** '********************************************************************************* Sub DrawSummary2 %> <% End Sub '************************************************************************************ '***** Universal Date Format Function *********************************************** '************************************************************************************ Function UniversalDate(dteDate) If IsDate(dteDate) = True Then dteDay = Day(dteDate) dteMonth = Month(dteDate) dteYear = Year(dteDate) UniversalDate = dteYear & "-" & Right(Cstr(dteMonth + 100),2) & "-" & Right(Cstr(dteDay + 100),2) Else UniversalDate = Null End If End Function '************************************************************************************ '***** Display Date Format Function ************************************************* '************************************************************************************ Function FormatDisplayDate(aDate) aDate = cdate(aDate) aDay = Day(aDate) aMonth = Month(aDate) aYear = Year(aDate) SELECT CASE DateDisplayFormat CASE "US" FormatDisplayDate = Right(Cstr(aMonth + 100),2) & "/" & Right(Cstr(aDay + 100),2) & "/" & aYear CASE "EURO" CASE "UNIVERSAL" CASE ELSE FormatDisplayDate = Right(Cstr(aMonth + 100),2) & "-" & Right(Cstr(aDay + 100),2) & "-" & aYear END SELECT End Function '********************************************************************************* '******** 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 '*************************************************************************************** '****** Generic DB Record Add ********************************************************** '*************************************************************************************** Sub DBAddRecord TableName = Request("TableName") RedirURL = Request("RedirURL") Set RS = Server.CreateObject("ADODB.Recordset") RS.MaxRecords = 1 RS.Open "SELECT * FROM " & TableName , dbc, adOpenDynamic, adLockPessimistic, adCMDText RS.AddNew For Each strColumnName in Request.Form If UCase(Left(strColumnName,3)) = "COL" then If Len(Request(strColumnName)) > 0 Then RS(Mid(strColumnName,4,Len(strColumnName))) = Request(strColumnName) 'response.write (Mid(strColumnName,4,Len(strColumnName))) & " = " & Request(strColumnName) & "
" End If End If Next RS.Update RS.Close Set RS = Nothing response.redirect RedirURL End Sub '*************************************************************************************** '****** Generic DB Record Update ******************************************************* '*************************************************************************************** Sub DBUpdateRecord TableKey = Request("TableKey") RecordID = Request("RecordID") TableName = Request("TableName") RedirURL = Request("RedirURL") SQL="UPDATE " & TableName & " SET " For Each strColumnName in Request.Form If UCase(Left(strColumnName,3)) = "COL" then 'If Len(Request(strColumnName)) > 0 Then SQL = SQL & Mid(strColumnName,4,Len(strColumnName)) & " = '" & FixString(Request(strColumnName)) & "'," 'End If End If Next SQL = Left(SQL, len(SQL)-1) SQL = SQL & " WHERE [" & TableKey & "] = " & RecordID dbc.execute(SQL) 'response.write SQL If request.form("from") = "editconfig" then Session("ConfigLoaded") = "NO" End If response.redirect RedirURL End Sub '********************************************************************************* '***** 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 Function ****************************************************** '********************************************************************************* Function FormatTime2(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 FormatTime2 = TempTime Else Dim hour,minute hour = left(TimeValue, 2) minute = left(TimeValue, 5) minute = right(minute, 2) If right(hour, 1) = ":" then hour = left(hour, 1) End If If left(hour, 1) = "0" then hour = right(hour, 1) End If If right(minute,1) = ":" then minute = left(minute,1) & "0" End If If hour < 12 then clocktime = hour & ":" & minute & " AM" Else If hour <> 12 then hour = hour - 12 End If clocktime = hour & ":" & minute & " PM" End If StandardTime = clocktime TempTimeValue = StandardTime FormatTime2 = TempTimeValue End If End Function '********************************************************************************* '******* Check Day For Event ***************************************************** '********************************************************************************* Function CheckForEvent(DateToUse) If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate = #" & DateToUse & "# ORDER BY Cal_EventStartTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate = #" & DateToUse & "# ORDER BY Cal_EventStartTime" End If Set RS=dbc.execute(SQL) Return = "NO" Do While NOT RS.EOF Return = "YES" Exit Do RS.MoveNext Loop RS.Close Set RS=Nothing CheckForEvent = Return End Function '********************************************************************************* '******** Draw Horizontal Line *************************************************** '********************************************************************************* Sub DrawHLine(LineWidth) response.write "
" response.write "
" End Sub '********************************************************************************* '******** Draw Title ************************************************************* '********************************************************************************* Sub DrawTitle(TitleWidth,TitleHeight,TitleToWrite,FontPoint) response.write "
" response.write "" & TitleToWrite & "" response.write "
" End Sub '********************************************************************************* '******** Draw Title 2 *********************************************************** '********************************************************************************* Sub DrawTitle2(TitleWidth,TitleHeight,TitleToWrite,FontPoint) response.write "
" response.write "" & TitleToWrite & "" response.write "
" End Sub '********************************************************************************* '******** Draw Title ************************************************************* '********************************************************************************* Sub DrawSmallTitle(TitleWidth,TitleHeight,TitleToWrite,FontPoint) response.write "
" response.write "" & TitleToWrite & "" response.write "
" End Sub '********************************************************************************* '******** Draw Button ************************************************************ '********************************************************************************* Sub DrawButton(ButtonImage, ButtonAlt, ButtonText, ButtonAction, ButtonWidth) response.write "" If ButtonAction <> "" then response.write "
" Else response.write "
" End If response.write "" response.write "" If ButtonImage <> "" then response.write "" End If If ButtonText <> "" then response.write "" End If response.write "" response.write "
" & ButtonAlt & " " & ButtonText & "
" response.write "
" response.write "" End Sub '********************************************************************************* '******** Draw Bad Browser Button ************************************************ '********************************************************************************* Sub DrawBadBrowserButton(ButtonImage, ButtonAlt, ButtonText, ButtonAction, ButtonWidth) response.write "" If ButtonAction <> "" then response.write "
" response.write "" End If response.write "" response.write "" If ButtonImage <> "" then response.write "" End If If ButtonText <> "" then response.write "" End If response.write "" response.write "
" & ButtonAlt & " " & ButtonText & "
" If ButtonAction <> "" then response.write "
" End If response.write "
" response.write "" End Sub '********************************************************************************* '******** Draw Button Seperator ************************************************** '********************************************************************************* Sub DrawButtonSep response.write "" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '******** Draw Calendar Selector ************************************************* '********************************************************************************* Sub DrawCalendarSelector response.write "" response.write "
" response.write "" response.write "
" response.write "" End Sub '********************************************************************************* '******** Draw Time Drop Down **************************************************** '********************************************************************************* Sub CreateTimeDropDown(TimeToWrite, PartOfDay, WhichField) If TimeFormatToUse = "12" then If TimeToWrite <> "12" then response.write "" response.write "" response.write "" response.write "" Else If PartOfDay = "AM" then response.write "" response.write "" response.write "" response.write "" Else response.write "" End If End If Else If TimeToWrite <> "12" then response.write "" response.write "" response.write "" response.write "" Else response.write ">" & TimeToWrite & ":00 " response.write "" response.write "" response.write "" End If Else response.write ">" & cint(TimeToWrite) + 12 & ":00 " response.write "" response.write "" response.write "" End If Else If PartOfDay = "AM" then response.write "" response.write "" response.write "" response.write "" Else response.write "" End If End If End If End Sub '********************************************************************************* '******** 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 '********************************************************************************* '******** FixString Function ***************************************************** '********************************************************************************* Function FixString(strSource) strSource = Replace(strSource, "'", "''") strSource = Replace(strSource, "''''", "''") FixString = Replace(strSource, "'''", "''") End Function %>