<% ' Name: ASP Calendar ' Author: Manohar Kamath ' Version: 1.0 ' Copyright Manohar Kamath. Original calendar copyright Wrox Press %> <% '------------------------------------------------------------ ' 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 '------------------------------------------------------------------------- ' This routine prints the individual table divisions for days of the month '------------------------------------------------------------------------- Sub Write_TD(sValue, sClass) Response.Write " " & sValue & "" & vbCrLf End Sub Set RsNext = Server.CreateObject("ADODB.RecordSet") Sub NextEvents() if intThisMonth < 12 then intNextMonth = intThisMonth + 1 else intNextMonth = 1 intThisYear = intThisYear + 1 end if session.LCID=1046 strMonthName = MonthName(intNextMonth) 'Convertendo apenas a 1. letra para maiúsculo strMonthName = UCase(Left(strMonthName,1)) & Right(strMonthName,Len(strMonthName)-1) session.LCID=1033 sSQL = "SELECT DISTINCT Start_Date, End_Date, Event_Title FROM tEvents WHERE " & _ "(Month(Start_Date) = " & intNextMonth & " AND Year(Start_Date) = " & intThisYear & ") " & _ "OR " & _ "(Month(End_Date) = " & intNextMonth & " AND Year(End_Date) = " & intThisYear & ") " & _ "ORDER BY Start_Date" 'Response.Write sSQL ' Open the RecordSet with a static cursor. This cursor provides bi-directional navigation RsNext.Open sSQL, sDSN, adOpenStatic, adLockReadOnly, adCmdText End Sub ' 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 session.LCID=1046 strMonthName = MonthName(intThisMonth) 'Convertendo apenas a 1. letra para maiúsculo strMonthName = UCase(Left(strMonthName,1)) & Right(strMonthName,Len(strMonthName)-1) session.LCID=1033 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 ' Open a record set of schedules Set Rs = Server.CreateObject("ADODB.RecordSet") ' These dates are used in the SQL dFirstDay = intThisMonth & "/1/" & intThisYear dLastDay = intThisMonth & "/" & intLastDay & "/" & intThisYear sSQL = "SELECT DISTINCT Start_Date, End_Date, Event_Title FROM tEvents WHERE " & _ "(Start_Date >=#" & dFirstDay & "# AND Start_Date <= #" & dLastDay & "#) " & _ "OR " & _ "(End_Date >=#" & dFirstDay & "# AND End_Date <= #" & dLastDay & "#) " & _ "OR " & _ "(Start_Date < #" & dFirstDay & "# AND End_Date > #" & dLastDay & "# )" & _ "ORDER BY Start_Date" 'Response.Write sSQL ' Open the RecordSet with a static cursor. This cursor provides bi-directional navigation Rs.Open sSQL, sDSN, adOpenStatic, adLockReadOnly, adCmdText %> Calendário para <% = strMonthName & " " & intThisYear %>

Calendário de Eventos

Voltar <% = strMonthName & " " & intThisYear %> Voltar
<% ' Initialize the end of rows flag to false id_ev = 1 id_ev_ex = 0 EndRows = False dateStart = "" 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_TD LastMonthDate, "calend2" 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_TD NextMonthDate, "calend2" 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 dToday >= Rs("Start_Date") AND dToday <= Rs("End_Date") Then if DateDiff("d",Rs("Start_Date"),Rs("End_Date")) >= 1 then if Rs("End_Date") = dToday then if id_ev <> 1 then id_ev = id_ev - 1 end if end if end if ' Print the date in a highlighted font if intLoopDay = cSUN then Write_TD " " & intPrintDay & "", "calend2_e" bEvents = True if id_ev_ex = 0 then if Month(Date()) < intThisMonth then response.write "" id_ev_ex = 1 else if Day(Date()) <= intPrintDay then response.write "" id_ev_ex = 1 end if end if end if Else Write_TD " " & intPrintDay & "", "calend1_e" bEvents = True if id_ev_ex = 0 then if Month(Date()) < intThisMonth then response.write "" id_ev_ex = 1 else if Day(Date()) <= intPrintDay then response.write "" id_ev_ex = 1 end if end if end if End if id_ev = id_ev + 1 ' If the Start date is greater than the date itself, there is no point ' checking other records. Exit the loop ElseIf dToday < Rs("Start_Date") 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 ' Sem evento -> class = NOEVENT If bEvents = False Then if dToday = date() then Write_TD intPrintDay, "calendHoje" else if intLoopDay = cSUN then Write_TD intPrintDay, "calend2" else Write_TD intPrintDay, "calend1" end if end if 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 %>
Dom Seg Ter Qua Qui Sex Sáb
<% If NOT Rs.EOF Then Rs.MoveFirst id_ev = 1 exibir_display = 0 Do While NOT Rs.EOF if Rs("Start_Date") >= Date() and exibir_display = 0 then display = "inline" 'exibir_display = 1 else display = "none" end if %> <% id_ev = id_ev + 1 Rs.MoveNext Loop else proximoEvento = 0 limiteLoop = 3 iLimite = 0 Do While proximoEvento = 0 NextEvents if RsNext.RecordCount > 0 then proximoEvento = 1 else if iLimite < limiteLoop then iLimite = iLimite + 1 RsNext.close else exit do end if end if Loop if RsNext.RecordCount > 0 then if RsNext("Start_Date") >= Date() then RsNext.MoveFirst %> <% end if end if End if %>
Evento
<% if DateDiff("d",Rs("Start_Date"),Rs("End_Date")) >= 1 then %> <%=Day(rs("Start_Date"))%> a <%=Day(rs("End_Date"))%> de <%=strMonthName%>
<% else %> <%=Day(rs("Start_Date"))%> de <%=strMonthName%>
<% end if %> <%=rs("Event_Title")%>
Próximo Evento
<% if DateDiff("d",RsNext("Start_Date"),RsNext("End_Date")) >= 1 then %> <%=Day(rsNext("Start_Date"))%> a <%=Day(rsNext("End_Date"))%> de <%=strMonthName%>
<% else %> <%=Day(rsNext("Start_Date"))%> de <%=strMonthName%>
<% end if %> <%=rsNext("Event_Title")%>
<% Rs.Close Set Rs = Nothing %>