%
'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
%>
 |
<% = strMonthName & " " & intThisYear %> |
 |
| S |
M |
T |
W |
T |
F |
S |
 |
<%
' 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
%>
|
|
<%
' 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
%>
|
Site Events Calendar
|
|
<%emitmonths()%>
<%if mlev >= 1 then%>
|
">Add New Event
|
<%end if%>
<%if smode <> "" then%>
|
|
<%end if%>
|
Upcoming Events:
|
<% call emitupcomingevents %>
|
|
Recent Events:
|
<% call emitpastEvents %>
|
<%
' my_Conn.Close
' Set my_Conn = Nothing
%>