<%@ LANGUAGE=VBSCRIPT %> <%Option Explicit%> <% Dim DBConn Dim oRS Dim strSQL Dim EventID Dim EntryID %> <% strSQL = "SELECT calendar.EntryID, calendar.EventID, events.EventName, calendar.CalDay, calendar.CalMonth, calendar.CalYear FROM events RIGHT JOIN calendar ON events.EventID = calendar.EventID Order By calendar.CalDay, calendar.CalMonth, calendar.CalYear, events.EventID" Set oRS = Server.CreateObject("ADODB.Recordset") oRS.Open strSQL, DBConn, 3 %> <% Function GetDaysInMonth(iMonth, iYear) Select Case iMonth Case 1, 3, 5, 7, 8, 10, 12 GetDaysInMonth = 31 Case 4, 6, 9, 11 GetDaysInMonth = 30 Case 2 If IsDate("February 29, " & iYear) Then GetDaysInMonth = 29 Else GetDaysInMonth = 28 End If End Select End Function Function GetWeekdayMonthStartsOn(iMonth, iYear) GetWeekdayMonthStartsOn = WeekDay(CDate(iMonth & "/1/" & iYear)) End Function Function SubtractOneMonth(dDate) Dim iDay, iMonth, iYear iDay = Day(dDate) iMonth = Month(dDate) iYear = Year(dDate) If iMonth = 1 Then iMonth = 12 iYear = iYear - 1 Else iMonth = iMonth - 1 End If If iDay > GetDaysInMonth(iMonth, iYear) Then iDay = GetDaysInMonth(iMonth, iYear) SubtractOneMonth = CDate(iMonth & "-" & iDay & "-" & iYear) End Function Function AddOneMonth(dDate) Dim iDay, iMonth, iYear iDay = Day(dDate) iMonth = Month(dDate) iYear = Year(dDate) If iMonth = 12 Then iMonth = 1 iYear = iYear + 1 Else iMonth = iMonth + 1 End If If iDay > GetDaysInMonth(iMonth, iYear) Then iDay = GetDaysInMonth(iMonth, iYear) AddOneMonth = CDate(iMonth & "-" & iDay & "-" & iYear) End Function Dim dDate ' Date we're displaying calendar for Dim iDIM ' Days In Month Dim iDOW ' Day Of Week that month starts on Dim iCurrent ' Variable we use to hold current day of month as we write table Dim iPosition ' Variable we use to hold current position in table Dim previousID Dim previousDay If IsDate(Request.QueryString("date")) Then dDate = CDate(Request.QueryString("date")) Else If IsDate(Request.QueryString("month") & "-" & Request.QueryString("day") & "-" & Request.QueryString("year")) Then dDate = CDate(Request.QueryString("month") & "-" & Request.QueryString("day") & "-" & Request.QueryString("year")) Else dDate = Date() If Request.QueryString.Count <> 0 Then Response.Write "The date you picked was not a valid date. The calendar was set to today's date.

" End If End If End If iDIM = GetDaysInMonth(Month(dDate), Year(dDate)) iDOW = GetWeekdayMonthStartsOn(Month(dDate), Year(dDate)) %>
<% If iDOW <> 1 Then Response.Write(vbTab & "" & vbCrLf) iPosition = 1 Do While iPosition < iDOW Response.Write(vbTab & vbTab & "" & vbCrLf) iPosition = iPosition + 1 Loop End If '-- Write days of month in proper day slots -- iCurrent = 1 iPosition = iDOW Do While iCurrent <= iDIM '-- open the table row -- If iPosition = 1 Then Response.Write(vbTab & "" & vbCrLf) End If '-- Write the date and subject -- Response.Write(vbTab & vbTab & "" & vbCrLf) '-- Close the table row -- If iPosition = 7 Then Response.Write vbTab & "" & vbCrLf iPosition = 0 End If '-- Increment variables -- iCurrent = iCurrent + 1 iPosition = iPosition + 1 Loop If iPosition <> 1 Then Do While iPosition <= 7 Response.Write(vbTab & vbTab & "" & vbCrLf) iPosition = iPosition + 1 Loop Response.Write vbTab & "" & vbCrLf End If %>
<--Prior Month

<%= MonthName(Month(dDate)) & " " & Year(dDate) %>

 Next Month--> Home
Sun Mon Tue Wed Thu Fri Sat
 
" & iCurrent & "") previousID = 0 previousDay = 0 If Not oRS.BOF Then oRS.MoveFirst Do Until oRS.EOF If oRS.Fields("CalYear") = Year(dDate) AND oRS.Fields("CalMonth") = Month(dDate) AND oRS.Fields("CalDay") = iCurrent Then If previousID <> oRS.Fields("EventID") or ( previousID = oRS.Fields("EventID") AND previousDay<>iCurrent) Then Response.Write("
" & oRS.Fields("EventName") & "") previousID = oRS.Fields("EventID") previousDay = oRS.Fields("CalDay") End If End IF oRS.MoveNext Loop End If Response.Write("
 
<% oRS.Close Set oRS = Nothing %>

Login Here