<% '=========================================================== ' filename: calendar.asp = ' = ' purpose: this file displays the calendar = ' = '=========================================================== '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' make sure the path to the include file below is correct !!!! '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %> <% '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 'on error resume next '=========================================================== ' declarations = '=========================================================== dim months, arrMonths, today, selectedMonth, selectedYear, daysOfWeek, arrDaysOfWeek dim dayOne, firstDayOnCalendar, rs, id if isNumeric(calendarID) and len(calendarID & "") > 0 then 'a specific template is requested getTemplate() 'get template info for this calendar end if months = "January,February,March,April,May,June,July,August,September,October,November,December" arrMonths = split(months, ",") daysOfWeek = "Sun,Mon,Tue,Wed,Thur,Fri,Sat" arrDaysOfWeek = split(daysOfWeek, ",") today = cdate(datepart("m", now()) & "/" & datepart("d", now()) & "/" & datepart("yyyy", now())) '============================================================================ '============================================================================ ' ================== ' main body of program ================== ' ================== '============================================================================ '============================================================================ 'see if new month or year has been requested selectedMonth = request("selectedMonth") selectedYear = request("selectedYear") 'check to see if a new valid month or year has been requested so we can determine 'what month and year we are displaying if not (selectedMonth < 13 and selectedMonth > 0) then selectedMonth = datepart("m", today) end if if not (selectedYear < (year(now())+50) or selectedYear > (year(now())-50)) or len(selectedYear & "") = 0 then selectedYear = datepart("yyyy", today) end if 'get first day of selected month firstDayOfMonth = selectedMonth & "/1/" & selectedYear firstDayOnCalendar = dateAdd("d", cdate(firstDayOfMonth), (dayOne * -1)+1) dayOne = datepart("w", cdate(selectedMonth & "/1/" & selectedYear)) '------------------------------------------------------------------------------------------------------------ 'debug 'Response.Write "date = " & selectedMonth & "/1/" & selectedYear & "
" 'Response.Write dayOne & "
" firstDayOnCalendar = dateAdd("d", cdate(firstDayOfMonth), (dayOne * -1)+1) 'Response.Write firstDayOnCalendar & "
" '------------------------------------------------------------------------------------------------------------ displayStyles() 'style sheet for calendar displayCalendarHeader() 'displays calendar header displayCalendar() 'display the calendar '============================================================================ '============================================================================ ' ================== ' end main body of program ================== ' ================== '============================================================================ '============================================================================ '....................................................................................................... '....................................................................................................... '....................................................................................................... '....................................................................................................... '===========================================================............................................ ' Below are thu functions and subroutines that drive this =............................................ ' page. =............................................ '===========================================================............................................ '....................................................................................................... '....................................................................................................... '....................................................................................................... '....................................................................................................... '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '*********************************************************** ' subroutine: displayStyles() * ' * ' purpose: displays style sheet for calendar * ' * ' parameters: none * ' * '*********************************************************** sub displayStyles() %> <% end sub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '*********************************************************** ' subroutine: displayCalendarHeader() * ' * ' purpose: displays the calendar header (month, year, * ' forward, and back links) * ' * ' parameters: none * ' * '*********************************************************** sub displayCalendarHeader() dim thisPage, thisQuery, prevMonth, prevYear, nextMonth, nextYear, prevNewYear, nextNewYear, borderStyle thisPage = Request.ServerVariables("Script_Name") 'name of current page thisQuery = Request.ServerVariables("Query_string") select case selectedMonth 'determine previous and next month and year for calendar links case 1 'January prevMonth = 12 nextMonth = 2 prevNewYear = selectedYear - 1 nextNewYear = selectedYear case 12 'December prevMonth = 11 nextMonth = 1 prevNewYear= selectedYear nextNewYear= selectedYear + 1 case else 'All other months prevMonth = selectedMonth - 1 nextMonth = selectedMonth + 1 prevNewYear= selectedYear nextNewYear= selectedYear end select prevYear = selectedYear - 1 nextYear = selectedYear + 1 borderStyle = "BORDER-RIGHT: " & daysBorderColor & " 1px solid; BORDER-TOP: " & daysBorderColor & " 1px solid; BORDER-LEFT: " & daysBorderColor & " 1px solid; " %>
<< < <%=arrMonths(selectedMonth-1) & " " & selectedYear%> > >>
<% end sub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '*********************************************************** ' subroutine: displayCalendar() * ' * ' purpose: displays the calendar * ' * ' parameters: none * ' * '*********************************************************** sub displayCalendar() dim i, thisDay, thisMonth, stopMonth, borderStyle, bgColor, currentDay i=0 thisDay = firstDayOnCalendar thisMonth = month(thisDay) stopMonth = month(dateAdd("m", 1, firstDayOfMonth)) 'first write days of week at top of table %> <% for i = 0 to 6 borderStyle = "" if i=0 then borderStyle = "BORDER-RIGHT: " & daysBorderColor & " 1px solid; BORDER-TOP: " & daysBorderColor & " 1px solid; BORDER-LEFT: " & daysBorderColor & " 1px solid; BORDER-BOTTOM: " & daysBorderColor & " 1px solid" else borderStyle = "BORDER-RIGHT: " & daysBorderColor & " 1px solid; BORDER-TOP: " & daysBorderColor & " 1px solid; BORDER-BOTTOM: " & daysBorderColor & " 1px solid" end if bgColor = "" %> <% Next %> <% connectToDB() 'first connect to DB set rs = server.CreateObject("ADODB.Recordset") 'now dislpay all the days for that month Do while thisMonth <> stopMonth 'keep going until next month %> <% for i = 0 to 6 'loop through each day of the week and display cell borderStyle = "" if i=0 then borderStyle = "BORDER-RIGHT: " & daysBorderColor & " 1px solid; BORDER-LEFT: " & daysBorderColor & " 1px solid; BORDER-BOTTOM: " & daysBorderColor & " 1px solid" else borderStyle = "BORDER-RIGHT: " & daysBorderColor & " 1px solid; BORDER-BOTTOM: " & daysBorderColor & " 1px solid" end if 'now set background color of this cell based on the day of the week bgColor = "" currentDay = datepart("w", thisDay, 1) 'sunday is first day of week select case currentDay case 1 'sunday bgColor = sunBGColor case 7 bgColor = satBGColor 'saturday case else bgColor = weekdayBGColor 'mon - fri end select if today = thisDay then 'this is today bgColor = currentDayBGColor end if %> <% thisDay = thisDay + 1 next %> <% thisMonth = month(thisDay) Loop set rs = nothing closeDB() %>
<%=arrDaysOfWeek(i)%>
<%=day(thisDay)%>
<% getEvents(thisDay) 'get any events for that day %>
<% end sub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '*********************************************************** ' subroutine: getTemplate() * ' * ' purpose: gets the design template information for this * ' calendar and overwrites defaults * ' * ' parameters: none * ' * '*********************************************************** sub getTemplate() connectToDB() set rs = server.CreateObject("ADODB.Recordset") sql = "SELECT * FROM templates WHERE id = " & calendarID rs.Open sql, conn, 2, 2 if not rs.EOF then 'found the template title= rs("title") description = rs("description") numberFont = rs("numberFont") numberFontSize = rs("numberFontSize") numberFontColor = rs("numberFontColor") titleFont = rs("titleFont") titleFontSize = rs("titleFontSize") titleFontColor = rs("titleFontColor") headerBGColor = rs("headerBGColor") headerFont = rs("headerFont") headerFontSize = rs("headerFontSize") headerFontColor = rs("headerFontColor") daysFont = rs("daysFont") daysFontSize = rs("daysFontSize") daysFontColor = rs("daysFontColor") daysBorderColor = rs("daysBorderColor") daysBGColor = rs("daysBGColor") sunBGColor = rs("sunBGColor") satBGColor = rs("satBGColor") weekdayBGColor = rs("weekdayBGColor") currentDayBGColor = rs("currentDayBGColor") calendarWidth = rs("calendarWidth") tdWidth = round(calendarWidth/7) end if rs.Close set rs = nothing closeDB() end sub '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '*********************************************************** ' subroutine: getEvents() * ' * ' purpose: displays the events for that day in the calendar* ' * ' parameters: thisDay - day we are searching for * ' * '*********************************************************** sub getEvents(thisDay) sql = "SELECT * FROM events WHERE archived = 0 AND start_date <= #" & thisDay & "# AND end_date >= #" & thisDay & "#" rs.Open sql, conn, 2, 2 if not rs.EOF then 'there are events Do while not rs.EOF 'display event for this day Response.Write "" Response.Write rs("title") & "

" rs.MoveNext Loop else 'no events Response.Write "
 " end if rs.Close end sub %>Auto Auction: car auctions, auction automobile, auction car, public auto auctions, public auction auto