<%@LANGUAGE="VBSCRIPT"%> <% '------------------------------------------------------------ ' This function finds the last date of the given month '------------------------------------------------------------ Function GetLastDay(intMonthNum, intYearNum) Dim dNextStart If CInt(intMonthNum) = 12 Then dNextStart = CDate( "1/1/" & intYearNum) Else dNextStart = CDate(intMonthNum + 1 & "/1/" & intYearNum) End If GetLastDay = Day(dNextStart - 1) End Function ' Constants for the days of the week Const cSUN = 1, cMON = 2, cTUE = 3, cWED = 4, cTHU = 5, cFRI = 6, cSAT = 7 ' Get the name of this file sScript = Request.ServerVariables("SCRIPT_NAME") ' Check for valid month input If IsEmpty(Request("MONTH")) OR NOT IsNumeric(Request("MONTH")) Then datToday = Date() intThisMonth = Month(datToday) ElseIf CInt(Request("MONTH")) < 1 OR CInt(Request("MONTH")) > 12 Then datToday = Date() intThisMonth = Month(datToday) Else intThisMonth = CInt(Request("MONTH")) End If ' Check for valid year input If IsEmpty(Request("YEAR")) OR NOT IsNumeric(Request("YEAR")) Then datToday = Date() intThisYear = Year(datToday) Else intThisYear = CInt(Request("YEAR")) End If strMonthName = MonthName(intThisMonth) datFirstDay = DateSerial(intThisYear, intThisMonth, 1) intFirstWeekDay = WeekDay(datFirstDay, vbSunday) intLastDay = GetLastDay(intThisMonth, intThisYear) ' Get the previous month and year intPrevMonth = intThisMonth - 1 If intPrevMonth = 0 Then intPrevMonth = 12 intPrevYear = intThisYear - 1 Else intPrevYear = intThisYear End If ' Get the next month and year intNextMonth = intThisMonth + 1 If intNextMonth > 12 Then intNextMonth = 1 intNextYear = intThisYear + 1 Else intNextYear = intThisYear End If ' Get the last day of previous month. Using this, find the sunday of ' last week of last month LastMonthDate = GetLastDay(intLastMonth, intPrevYear) - intFirstWeekDay + 2 NextMonthDate = 1 ' Initialize the print day to 1 intPrintDay = 1 ' These dates are used in the SQL dFirstDay = intThisMonth & "/1/" & intThisYear &" 0:00:00" dLastDay = intThisMonth & "/" & intLastDay & "/" & intThisYear &" 23:59:00" %> <% Dim RS Dim RS_cmd Dim RS_numRows Set RS_cmd = Server.CreateObject ("ADODB.Command") RS_cmd.ActiveConnection = MM_event_STRING RS_cmd.CommandText = "SELECT * FROM tblEvents,tblDates WHERE " & _ "(DateEvent >=#" & dFirstDay & "# AND DateEvent <= #" & dLastDay & "#) " & _ " AND tblEvents.active = True AND tblEvents.eventID=tblDates.eventID_lu ORDER BY tblDates.DateEvent, tblDates.TimeEvent" RS_cmd.Prepared = true Set RS = RS_cmd.Execute RS_numRows = 0 %> <% '------------------------------------------------------------------------- ' This routine prints the individual table divisions for days of the month '------------------------------------------------------------------------- Sub Write_TD(sValue) Response.Write " " & sValue & "" Response.Write("
") If Not rs.BOF Then 'Display an event rs.MoveFirst Do Until rs.EOF If FormatDateTime(dToday,2) = FormatDateTime(Rs("DateEvent"),2) Then Response.Write("

") If rs("TimeEvent") <> "" Then strHour2 = ConvDate(rs("TimeEvent"), "%I") strMin2 = ConvDate(rs("TimeEvent"), "%M") strAP2 = ConvDate(rs("TimeEvent"), "%P") strTime2 = strHour2 & ":" & strMin2 & " " & strAP2 Response.Write("" & strTime2 & "
") End If Response.Write("" & Replace((RS.Fields.Item("strTitle").Value), Chr(13), "
") & "
") Response.Write (""& Replace(rs.Fields.Item("Notes").Value &" ", VbCrLf, "
")) Response.Write("

") End If rs.MoveNext Loop End If Response.Write "

 " & vbCrLf End Sub Sub Write_TD2(sValue) Response.Write " " & sValue & " " & vbCrLf End Sub %> Events for <% = strMonthName & " " & intThisYear %>
<% ' Initialize the end of rows flag to false EndRows = False Response.Write vbCrLf ' Loop until all the rows are exhausted Do While EndRows = False ' Start a table row Response.Write " " & vbCrLf ' This is the loop for the days in the week For intLoopDay = cSUN To cSAT ' If the first day is not sunday then print the last days of previous month in grayed font If intFirstWeekDay > cSUN Then Write_TD2 LastMonthDate LastMonthDate = LastMonthDate + 1 intFirstWeekDay = intFirstWeekDay - 1 ' The month starts on a sunday Else ' If the dates for the month are exhausted, start printing next month's dates ' in grayed font If intPrintDay > intLastDay Then Write_TD2 NextMonthDate NextMonthDate = NextMonthDate + 1 EndRows = True Else ' If last day of the month, flag the end of the row If intPrintDay = intLastDay Then EndRows = True End If dToday = CDate(intThisMonth & "/" & intPrintDay & "/" & intThisYear) If NOT Rs.EOF Then ' Set events flag to false. This means the day has no event in it bEvents = False Do While NOT Rs.EOF AND bEvents = False ' If the date falls within the range of dates in the recordset, then ' the day has an event. Make the events flag True If FormatDateTime(dToday,2) = FormatDateTime(Rs("DateEvent"),2) Then ' Print the date in a highlighted font Write_TD "" & intPrintDay & "" bEvents = True ' If the Start date is greater than the date itself, there is no point ' checking other records. Exit the loop ElseIf FormatDateTime(dToday,2) < FormatDateTime(Rs("DateEvent"),2) Then Exit Do ' Move to the next record Else Rs.MoveNext End If Loop ' Checks for that day Rs.MoveFirst End If ' If the event flag is not raise for that day, print it in a plain font If bEvents = False Then Write_TD "" & intPrintDay & "" End If End If ' Increment the date. Done once in the loop. intPrintDay = intPrintDay + 1 End If ' Move to the next day in the week Next Response.Write " " & vbCrLf Loop %>
previous month

<% = strMonthName & " " & intThisYear %>

next month
Sunday Monday Tuesday Wednesday Thursday Friday Saturday
previous month

<% = strMonthName & " " & intThisYear %>

next month
<% Rs.Close() Set Rs = Nothing %>