<% 'set my_Conn = Server.CreateObject("ADODB.Connection") 'my_Conn.Open strConnString ' Constants for the days of the week dim intPrivateEvent if Request.Form("isPrivateEvent") = "1" then intPrivateEvent = 1 else intPrivateEvent = 0 end if ' Get the name of this file sScript = Request.ServerVariables("SCRIPT_NAME") 'set the date to today datToday = date() ' Check for valid month input intThisMonth = Request.QueryString("month") if intThisMonth = "" then intThisMonth = month(datToday) else intThisMonth = cint(intThisMonth) end if If intThisMonth < 1 OR intThisMonth > 12 Then intThisMonth = Month(datToday) End If ' Check for valid year input intThisYear = Request.QueryString("year") If intThisYear = "" Then intThisYear = Year(datToday) else intThisYear = cint(intThisYear) End If sMode = Request.QueryString("mode") dDate = Request.QueryString("Date") If not IsEmpty(ddate) and IsDate(ddate) and smode = "" Then sMode = "display" end if if Request.Form("EVENT") <> "" then Update_Event(Request.Form("EVENT")) end if dim strMonthName, datFirstDay, intFirstWeekday, intLastDay, intPrevMonth, intNextMonth, intPrevYear, intNextYear dim LastMonthDate, NextMonthDate, intPrintDay, intLastMonth, dToday, dFirstDay, dLastDay, endrows, intLoopDay dim bevents, sTitle '------------------------------------------------------------ ' 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 Sub Write_TD3(sValue, sClass) Response.Write " " & sValue & "" & vbCrLf End Sub Function emitmonths() 'start with previous month 'intthismonth = intThisMonth - 1 'show 3 months 'for i = 0 to 2 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 '###################### Added below on 1/11/2001 if Request.QueryString("month") = "" then intLastMonth = DatePart( "m", DateAdd( "m", -1, Date())) else if Request.QueryString("month") = 1 then intLastMonth = 12 else intLastMonth = Request.QueryString("month") - 1 end if end if if Request.QueryString("year") = "" then intPrevYear = DatePart( "yyyy", DateAdd( "m", -1, Date())) else if Request.QueryString("month") = 1 then intPrevYear = Request.QueryString("year") - 1 else intPrevYear = Request.QueryString("year") end if end if '###################### Added above on 1/11/2001 ' 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 dLastDay = intThisMonth & "/" & intLastDay & "/" & intThisYear sSQL = "SELECT event_id, start_date, end_date, event_title, event_details, M_Name, Private FROM FORUM_EVENTS Inner JOIN Forum_Members ON FORUM_EVENTS.added_by = Forum_Members.Member_ID WHERE " & _ "(Start_Date >='" & DateToStr(dFirstDay) & "' AND Start_Date <= '" & DateToStr(dLastDay) & "') " & _ "OR " & _ "(End_Date >='" & DateToStr(dFirstDay) & "' AND End_Date <= '" & DateToStr(dLastDay) & "') " & _ "OR " & _ "(Start_Date < '" & DateToStr(dFirstDay) & "' AND End_Date > '" & DateToStr(dLastDay) & "' )" & _ "ORDER BY Start_Date" 'Response.Write sSQL 'Open the RecordSet with a static cursor. This cursor provides bi-directional navigation 'Rs.Open sSQL, my_Conn, adOpenStatic, adLockReadOnly, adCmdText dim rs set rs = server.CreateObject("adodb.recordset") rs.Open ssql, my_Conn %>
<% ' 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_TD LastMonthDate, "NON" 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, "NON" 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 sEName = lcase(RS("M_NAME")) ' 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 >= strToDate(Rs("Start_Date")) AND dToday <= strToDAte(Rs("End_Date")) AND ((Rs("PRIVATE") <> 1) OR ( Rs("PRIVATE") = 1 and sEName = lcase(strDBNTUserName) ) and strDBNTUSerName <> "") Then ' Print the date in a highlighted font select case dtoday case date() Write_TD " " & intPrintDay & "", "Today" case cdate(ddate) Write_TD " " & intPrintDay & "", "Selected" case else Write_TD " " & intPrintDay & "", "HL" end select bEvents = True ' If the Start date is greater than the date itself, there is no point ' checking other records. Exit the loop ElseIf dToday < strToDate(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 If bEvents = False Then select case dtoday case date() Write_TD " " & intPrintDay & "", "TODAY" case cdate(ddate) Write_TD " " & intPrintDay & "", "Selected" case else Write_TD " " & intPrintDay & "", "SOME" end select 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 Rs.Close set rs = nothing %>
Previous Month <% = strMonthName & " " & intThisYear %> Next Month
S M T W T F S
<% ' Get the next month and year 'intThisMonth = intThisMonth + 1 'If intThisMonth > 12 Then ' intThisMonth = 1 ' intThisYear = intThisYear + 1 'Else ' intThisYear = intThisYear 'End If 'next end function function emitupcomingevents dim rs Set Rs = Server.CreateObject("ADODB.RecordSet") strSql = "SELECT start_date, event_title, M_Name,PRIVATE FROM FORUM_EVENTS Inner JOIN Forum_Members ON FORUM_EVENTS.added_by = Forum_Members.Member_ID WHERE start_date >= '" & DateToStr(date()) & "' and start_date < '" & DateToStr(DateAdd("d",30,date())) & "' Order by start_date, event_id ASC" rs.Open strSql, my_Conn do until rs.EOF sEName = lcase(rs("M_NAME")) if (rs("PRIVATE") <> 1) or (rs("PRIVATE") = 1 and sEName = lcase(strDBNTUSerName)) and strDBNTUSerName <> "" then Response.Write "" & rs("Event_Title") & "
" end if rs.MoveNext loop rs.Close set rs = nothing end function function emitpastEvents dim rs Set Rs = Server.CreateObject("ADODB.RecordSet") strSql = "SELECT start_date, event_title, M_Name,PRIVATE FROM FORUM_EVENTS Inner JOIN Forum_Members ON FORUM_EVENTS.added_by = Forum_Members.Member_ID WHERE start_date < '" & DateToStr(date()) & "' and start_date > '" & DateToStr(DateAdd("d",-30,date())) & "' Order by start_date desc" rs.Open strSql, my_Conn do until rs.EOF sEName = lcase(rs("M_NAME")) if (rs("PRIVATE") <> 1) or (rs("PRIVATE") = 1 and sEName = lcase(strDBNTUSerName)) and strDBNTUSerName <> "" then Response.Write "" & rs("Event_Title") & "
" end if rs.MoveNext loop rs.Close set rs = nothing end function %> <%emitmonths()%> <%if mlev >= 1 then%> <%end if%> <%if smode <> "" then%> <%end if%>
Site Events Calendar
">Add New Event
View Full Calendar
Upcoming Events:
<% call emitupcomingevents %>

Recent Events:
<% call emitpastEvents %>

<% ' my_Conn.Close ' Set my_Conn = Nothing %>