<%
'-------------------------------------------------------------
' This function returns the connection string to the database
'-------------------------------------------------------------
Function getConnString()
getConnString = "Provider=SQLOLEDB.1;User ID=morris;Initial Catalog=morris;Data Source=incudev;Locale Identifier=1033;Connect Timeout=15;Current Language=us_english;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=morris;User Id=morris;PASSWORD=pickering516;"
End Function
'-------------------------------------------------------------
' This function returns the day for events
'-------------------------------------------------------------
Function getDay()
Dim sInDay
sInDay = Request.QueryString("CALDAY")
' If the CALDAY key in the URL is empty
If IsEmpty(sInDay) Then
getDay = 0 ' if ever the CALDAY is missing, always show the entire month MODIFIED by Ct 6/29/00
' Check if the month and year are current. If yes, (OLD Method)
' return the current day else return 1
'If getMonth=Month(Date) and getYear=Year(Date) Then
' getDay = Day(Date)
'Else
' getDay = 1
'End If
Else
' Return the day from CALDAY key in the URL
getDay = CInt(sInDay)
End If
End Function
'-------------------------------------------------------------
' This function returns the month for both calendar and events
'-------------------------------------------------------------
Function getMonth()
Dim sInMonth
' Get the CALMONTH key from URL
sInMonth = Request.QueryString("CALMONTH")
' If the month is empty or invalid, return the current month
If IsEmpty(sInMonth) OR NOT IsNumeric(sInMonth) Then
getMonth = Month(Date())
ElseIf CInt(sInMonth) < 1 OR CInt(sInMonth) > 12 Then
getMonth = Month(Date())
Else
getMonth = CInt(sInMonth)
End If
End Function
'-------------------------------------------------------------
' This function returns the year for both calendar and events
'-------------------------------------------------------------
Function getYear()
Dim sInYear
' Get the CALYEAR key from the URL
sInYear = Request.QueryString("CALYEAR")
' If the year is invalid, return the current year
If IsEmpty(sInYear) OR NOT IsNumeric(sInYear) Then
getYear = Year(Date())
Else
getYear = CInt(sInYear)
End If
End Function
'-------------------------------------------------------------
' This routine prints the individual table divisions for
' days of the month
'
' Parameters:
' psValue: Display day
' psClass: Display class name
'-------------------------------------------------------------
Sub Write_TD(psValue, psClass)
Response.Write "| " & psValue & " | " & vbCrLf
End Sub
'-------------------------------------------------------------
' This routine displays the calendar
'
' Parameters:
' psEventsURL : Page that contains event listing. Leave
' blank if it is the same page as calendar
' psFrame : Target of event listing page. If same page
' as calendar, leave blank
'-------------------------------------------------------------
Sub showCalendar(psEventsURL, psFrame)
Dim sMonthName, sScript
Dim iPrevMonth, iNextMonth, iPrevYear, iNextYear, iFirstWeekDay
Dim iThisMonth, iThisYear, dMonthDay, iDay, iLastMonthDate, iNextMonthdate
' Variables for the records
Dim Conn, oCm, oRs, iIndex, sSQL, iEventCount, oParm
Dim dFirstDay, dLastDay, arEvents, bEndRows, iLoopDay, bEvents, bLoopEnd
Dim iRowNum, sTargetURL, sTarget
' Constants for the fields in the records
Const cSTART_DATE =0, cEND_DATE = 1, cEVENT_TITLE = 2
' ADO constants
Const adCmdStoredProc = 4, adDate = 7
' Get the name of the file executing this routine
sScript = Request.ServerVariables("SCRIPT_NAME")
' Get the month and year values
iThisMonth = getMonth()
iThisYear = getYear()
' Get the name of the month
sMonthName = MonthName(iThisMonth)
' Compute the first and last dates in the month. We will need these in our query
dFirstDay = DateSerial(iThisYear, iThisMonth, 1)
dLastDay = DateSerial(iThisYear, iThisMonth+1, 0)
' Compute the first week day of the month
iFirstWeekDay = WeekDay(dFirstDay, vbSunday)
' Get the previous month and year. This is used to create the back image
iPrevMonth = Month(DateSerial(iThisYear, iThisMonth - 1, 1))
iPrevYear = Year(DateSerial(iThisYear, iThisMonth - 1, 1))
' Get the next month and year. This information is used to drive the forward image
iNextMonth = Month(DateSerial(iThisYear, iThisMonth + 1, 1))
iNextYear = Year(DateSerial(iThisYear, iThisMonth + 1, 1))
' Get the last day of previous month. Using this, find the first sunday of the first
' week in the month
iLastMonthDate = Day(DateSerial(iThisYear, iThisMonth, 0)) - iFirstWeekDay + 2
iNextMonthDate = 1
' Initialize the date variable with the first date in the first week of the month
dMonthDay = DateSerial(iThisYear, iThisMonth, vbSunday - iFirstWeekDay + 1)
'---------------------------------------------
' Create the target frame and URL. This target
' URL will contain the month and year. The day
' will be appended within the calendar loop
'---------------------------------------------
If psEventsURL = "" Then
psEventsURL = Request.ServerVariables("SCRIPT_NAME")
End If
sTargetURL = psEventsURL & "?calmonth=" & iThisMonth & "&calyear=" & iThisYear
' Set the frame to display calendar
If psFrame = "" Then
sTarget = "_self"
Else
sTarget = psFrame
End If
' Create a connection to the database
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open getConnString()
' Create a Command Object to open calendar query
Set oCm = Server.CreateObject("ADODB.Command")
Set oCm.ActiveConnection = Conn
Set oRs = Server.CreateObject("ADODB.RecordSet")
' Call the query qMonthEvents in the Access DB with the start date and end date as parameters
oCm.CommandText = "qMonthEvents"
oCm.CommandType = adCmdstoredProc
Set oParm = oCm.CreateParameter("dStart", adDate, , , dFirstDay)
oCm.Parameters.Append oParm
Set oParm = oCm.CreateParameter("dStart", adDate, , , dLastDay)
oCm.Parameters.Append oParm
On Error Resume Next
' Create the resultset of the above query
Set oRs = oCm.Execute()
Set oCm.ActiveConnection = Nothing
' Check if any errors occurred during the query execution.
' If any errors occurred, print the error and exit gracefully
If Err.Number <> 0 Then
Response.Write "Error: " & Err.description & " occurred. Please contact the calendar administrator."
Exit Sub
End If
' Initialize the loop variables
iIndex = 0
iEventCount = 0
' Create the array of events from the recordset use GetRows() method of
' the RecordSet object to convert records to an array
If NOT oRs.EOF Then
arEvents = oRs.GetRows()
iEventCount = UBound(arEvents, 2) + 1
End If
' Close and destroy the database objects. This will conserve resources
oRs.Close
Set oRs = Nothing
Conn.Close
Set Conn = Nothing
%>
<%
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("![]() ")
Response.write (" | ")
Response.write ("")
Response.write (sMonthName & " " & iThisYear )
Response.write (" | ")
Response.write ("")
Response.write ("![]() ")
Response.write (" | ")
Response.write (" ")
Response.write ("")
Response.write ("")
Response.write ("| S | ")
Response.write ("M | ")
Response.write ("T | ")
Response.write ("W | ")
Response.write ("T | ")
Response.write ("F | ")
Response.write ("S | ")
Response.write (" ")
Response.write ("")
Response.write ("")
Response.write ("![]() | ")
Response.write (" ")
' Initialize the end of rows flag to false
bEndRows = False
iIndex = 0
' Generate 6 rows in the calendar
For iRowNum = 0 To 5
' Start a table row. This corresponds to one week
Response.Write " " & vbCrLf
' This is the loop for the days in the week
For iLoopDay = 1 To 7
' If the first day is not sunday then print the last days of previous month
' in grayed font
If dMonthDay > dLastDay OR dMonthDay < dFirstDay Then
Write_TD Day(dMonthDay), "DIM"
Else
' Set events flag to false. This means the day has no event in it
bEvents = False
bLoopEnd = False
'
If iEventCount > 0 Then
Do While iIndex < iEventCount And bLoopEnd = 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 dMonthDay >= arEvents(cSTART_DATE, iIndex) AND dMonthDay <= arEvents(cEND_DATE, iIndex) Then
' Print the date highlighted font
bEvents = True
' Flag end of internal For loop
bLoopEnd = True
' If the Start date is greater than the date itself, there is no
' point checking other records. Exit the loop
ElseIf dMonthDay < arEvents(cSTART_DATE, iIndex) Then
bLoopEnd = True
End If
' Move to the next record
iIndex = iIndex + 1
Loop
' Reset the array pointer back to the first element
iIndex = 0
End If
iDay = Day(dMonthDay)
' If the event flag is not raised for that day, print it in a plain font
If bEvents = False Then
Write_TD " " & iDay & "", "NOEV"
' Otherwise print it in a bold font
Else
Write_TD " " & iDay & "", "EV"
End If
End If
' Move to the next day in the week, increment the date.
dMonthDay = CDate(dMonthDay + 1)
Next
' Close the table row. End of that week
Response.Write " " & vbCrLf
Next
Response.write (" ")
Response.write (" | ")
Response.write (" ")
Response.write (" |
")
Response.write ("
")
End Sub
'-------------------------------------------------------------
' This routine displays the event-listing for a given day
'-------------------------------------------------------------
Sub showEvents()
Dim iMonth, iYear, iDay, dDate, oCm, oRs, Conn, oParm,iDayCheck,iStartDay,iEndDay,strDateHeadingBeg,strDateHeadingEnd,bNoDayEvents
Const adCmdStoredProc = 4, adDate = 7
' Get the month, year and day
iYear = getYear()
iMonth = getMonth()
iDayCheck = getDay()
if iDayCheck = 0 then ' loop for the entire month
iStartDay = 1
iEndDay = 31
else
iStartDay = iDayCheck
iEndDay = iDayCheck
end if
'set up the Event Heading strings
strDateHeadingBeg = "
"
'assume there are No Day Events
bNoDayEvents = true
' Create a connection to the database
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open getConnString()
for iDay = iStartDay to iEndDay
' Contruct the date from the above variables
dDate = DateSerial(iYear, iMonth, iDay)
' Open a record set of schedules
' Create command and recordset objects
Set oCm = Server.CreateObject("ADODB.Command")
Set oRs = Server.CreateObject("ADODB.RecordSet")
Set oCm.ActiveConnection = Conn
' Call the qDayEvents query in the Access database and pass the date as a parameter
oCm.CommandText = "qDayEvents"
oCm.CommandType = adCmdStoredProc
Set oParm = oCm.CreateParameter("EventDate", adDate, , , dDate)
oCm.Parameters.Append oParm
On Error Resume Next
' Execute the query
Set oRs = oCm.Execute()
' Check if any errors occurred during the query execution.
' If any errors occurred, print the error and exit gracefully
If Err.Number <> 0 Then
Response.Write "Error: " & Err.description & " occurred. Please contact the calendar administrator."
Exit Sub
End If
' Close the command object
Set oCm.ActiveConnection = Nothing
Set oCm = Nothing
'Print the date if there are events
If NOT oRs.EOF Then
Response.Write strDateHeadingBeg & " " & FormatDateTime(dDate, 1) & strDateHeadingEnd
end if
' Check if the resultset is empty
If NOT oRs.EOF Then
' If not, loop through the results and print each event
Do While NOT oRs.EOF
' Write the event item
Response.Write " "
Response.Write oRs.Fields("Event_Title").value & VbCrLf
Response.Write "
" & vbCrLf
' If the event lasts more than one day, indidate the start and end dates
If oRs.Fields("Start_Date").value <> oRs.Fields("End_Date").value Then
Response.Write "Starts: " &_
oRs.Fields("Start_Date").value & vbCrLf
Response.Write "
Ends: " & oRs.Fields("End_Date").value & vbCrLf
Response.Write "
"
End If
Response.Write "" & vbCrLf
' Print the event details
Response.Write Replace(oRs.Fields("Event_Details").value & " ", vbCrLf, "
") & "
" & vbCrLf
' Print URL, if any
If NOT IsNull(oRs.Fields("Event_URL").value) And oRs.Fields("Event_URL").value <> "" Then
Response.Write "" &_
"More details: http://" &_
oRs.Fields("Event_URL").value & "
" & vbCrLf
End If
' Print contact email, if any
If NOT IsNull(oRs.Fields("Event_Contact").value) And oRs.Fields("Event_Contact").value <> "" Then
Response.Write "" &_
"Contact: " &_
oRs.Fields("Event_Contact").value & "
" & vbCrLf
End If
' End of a event listing item
Response.Write "" & vbCrLf
Response.Write "
"
' Go to the next event item in the resultset
oRs.MoveNext()
Loop ' to another event of current day
bNoDayEvents = false
End If
' Close and destroy the recordset and connection objects
oRs.Close()
Set oRs = Nothing
Next ' day in month and show its events
'if a single day is shown and no events, then show No Events info
if bNoDayEvents then
if iStartDay = iEndDay then
Response.Write strDateHeadingBeg & FormatDateTime(dDate, 1) & strDateHeadingEnd
Response.Write("")
Response.Write("No Events
")
else
dStartDate = DateSerial(iYear, iMonth, 1)
dEndDate = DateSerial(iYear, iMonth, 31)
Response.Write strDateHeadingBeg & FormatDateTime(dStartDate, 1) & " - " & FormatDateTime(dEndDate, 1) & strDateHeadingEnd
Response.Write("")
Response.Write("No Events
")
end if
end if
Conn.Close
Set Conn = Nothing
End Sub
Function CalendarForm (iStartYear,iEndYear)
'------------------------------------------------------------------
' Create a form to allow the user to choose the month and the year
' of the calendar
'------------------------------------------------------------------
Dim iMonth, iYear, sScript, iMonthIndex, iYearIndex
' Get the month and year from the calendar module
iMonth =getMonth()
iYear = getYear()
if iStartYear = "" then iStartYear = Year(Date()) 'set default the current year
if iEndYear = "" then iEndYear = iStartYear + 1 'set default to the next year
' Get the executing script's page
sScript = Request.ServerVariables("SCRIPT_NAME")
Response.write("")
End Function
'****************************************************************
'-------------------------------------------------------------
' This routine displays the event-listing for a given day on the big calendar
'-------------------------------------------------------------
Function showEventTitles (iDay,iMonth,iYear)
Dim dDate, oCm, oRs, Conn, oParm
Const adCmdStoredProc = 4, adDate = 7
' Create a connection to the database
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open getConnString()
' Contruct the date from the above variables
dDate = DateSerial(iYear, iMonth, iDay)
' Create command and recordset objects
Set oCm = Server.CreateObject("ADODB.Command")
Set oRs = Server.CreateObject("ADODB.RecordSet")
Set oCm.ActiveConnection = Conn
' Call the qDayEvents query in the Access database and pass the date as a parameter
oCm.CommandText = "qDayEvents"
oCm.CommandType = adCmdStoredProc
Set oParm = oCm.CreateParameter("EventDate", adDate, , , dDate)
oCm.Parameters.Append oParm
On Error Resume Next
' Execute the query
Set oRs = oCm.Execute()
' Check if any errors occurred during the query execution.
' If any errors occurred, print the error and exit gracefully
If Err.Number <> 0 Then
Response.Write "Error: " & Err.description & " occurred. Please contact the calendar administrator."
Exit Function
End If
' Close the command object
Set oCm.ActiveConnection = Nothing
Set oCm = Nothing
' Check if the resultset is empty
If NOT oRs.EOF Then
' If not, loop through the results and print each event
Do While NOT oRs.EOF
' Write the event item
Response.Write " "
Response.Write "
" & oRs.Fields("Event_Title").value & VbCrLf
Response.Write "
" & vbCrLf
' Go to the next event item in the resultset
oRs.MoveNext()
Loop ' to another event of current day
End If
' Close and destroy the recordset and connection objects
oRs.Close()
Set oRs = Nothing
Conn.Close
Set Conn = Nothing
End Function
'-------------------------------------------------------------
' This routine prints the individual table divisions for
' days of the month of the Big Calendar
'
' Parameters:
' psValue: Display day
' psClass: Display class name
'-------------------------------------------------------------
Sub Write_BigTD(psValue, psClass)
Response.Write " " & psValue
Response.write "
| " & vbCrLf
End Sub
Sub Write_BigTDEvent(psValue, psClass, psDay, psMonth, psYear)
Response.Write " " & psValue
Response.Write " "
showEventTitles psDay, psMonth, psYear
Response.write " | " & vbCrLf
End Sub
'-------------------------------------------------------------
' This routine displays the calendar
'
' Parameters:
' psEventsURL : Page that contains event listing. Leave
' blank if it is the same page as calendar
' psFrame : Target of event listing page. If same page
' as calendar, leave blank
'-------------------------------------------------------------
Sub showBigCalendar(psEventsURL, psFrame)
Dim sMonthName, sScript
Dim iPrevMonth, iNextMonth, iPrevYear, iNextYear, iFirstWeekDay
Dim iThisMonth, iThisYear, dMonthDay, iDay, iLastMonthDate, iNextMonthdate
' Variables for the records
Dim Conn, oCm, oRs, iIndex, sSQL, iEventCount, oParm
Dim dFirstDay, dLastDay, arEvents, bEndRows, iLoopDay, bEvents, bLoopEnd
Dim iRowNum, sTargetURL, sTarget
' Constants for the fields in the records
Const cSTART_DATE =0, cEND_DATE = 1, cEVENT_TITLE = 2
' ADO constants
Const adCmdStoredProc = 4, adDate = 7
' Get the name of the file executing this routine
sScript = Request.ServerVariables("SCRIPT_NAME")
' Get the month and year values
iThisMonth = getMonth()
iThisYear = getYear()
' Get the name of the month
sMonthName = MonthName(iThisMonth)
' Compute the first and last dates in the month. We will need these in our query
dFirstDay = DateSerial(iThisYear, iThisMonth, 1)
dLastDay = DateSerial(iThisYear, iThisMonth+1, 0)
' Compute the first week day of the month
iFirstWeekDay = WeekDay(dFirstDay, vbSunday)
' Get the previous month and year. This is used to create the back image
iPrevMonth = Month(DateSerial(iThisYear, iThisMonth - 1, 1))
iPrevYear = Year(DateSerial(iThisYear, iThisMonth - 1, 1))
' Get the next month and year. This information is used to drive the forward image
iNextMonth = Month(DateSerial(iThisYear, iThisMonth + 1, 1))
iNextYear = Year(DateSerial(iThisYear, iThisMonth + 1, 1))
' Get the last day of previous month. Using this, find the first sunday of the first
' week in the month
iLastMonthDate = Day(DateSerial(iThisYear, iThisMonth, 0)) - iFirstWeekDay + 2
iNextMonthDate = 1
' Initialize the date variable with the first date in the first week of the month
dMonthDay = DateSerial(iThisYear, iThisMonth, vbSunday - iFirstWeekDay + 1)
'---------------------------------------------
' Create the target frame and URL. This target
' URL will contain the month and year. The day
' will be appended within the calendar loop
'---------------------------------------------
If psEventsURL = "" Then
psEventsURL = Request.ServerVariables("SCRIPT_NAME")
End If
sTargetURL = psEventsURL & "?calmonth=" & iThisMonth & "&calyear=" & iThisYear
sDetailURL = "events.asp?calmonth=" & iThisMonth & "&calyear=" & iThisYear
' Set the frame to display calendar
If psFrame = "" Then
sTarget = "_self"
Else
sTarget = psFrame
End If
' Create a connection to the database
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open getConnString()
' Create a Command Object to open calendar query
Set oCm = Server.CreateObject("ADODB.Command")
Set oCm.ActiveConnection = Conn
Set oRs = Server.CreateObject("ADODB.RecordSet")
' Call the query qMonthEvents in the Access DB with the start date and end date as parameters
oCm.CommandText = "qMonthEvents"
oCm.CommandType = adCmdstoredProc
Set oParm = oCm.CreateParameter("dStart", adDate, , , dFirstDay)
oCm.Parameters.Append oParm
Set oParm = oCm.CreateParameter("dStart", adDate, , , dLastDay)
oCm.Parameters.Append oParm
On Error Resume Next
' Create the resultset of the above query
Set oRs = oCm.Execute()
Set oCm.ActiveConnection = Nothing
' Check if any errors occurred during the query execution.
' If any errors occurred, print the error and exit gracefully
If Err.Number <> 0 Then
Response.Write "Error: " & Err.description & " occurred. Please contact the calendar administrator."
Exit Sub
End If
' Initialize the loop variables
iIndex = 0
iEventCount = 0
' Create the array of events from the recordset use GetRows() method of
' the RecordSet object to convert records to an array
If NOT oRs.EOF Then
arEvents = oRs.GetRows()
iEventCount = UBound(arEvents, 2) + 1
End If
' Close and destroy the database objects. This will conserve resources
oRs.Close
Set oRs = Nothing
Conn.Close
Set Conn = Nothing
%>
<%
'Response.write ("")
'Response.write ("")
'Response.write ("")
'Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("")
Response.write ("![]() ")
Response.write (" | ")
Response.write ("")
Response.write (sMonthName & " " & iThisYear )
Response.write (" | ")
Response.write ("")
Response.write ("![]() ")
Response.write (" | ")
Response.write (" ")
Response.write ("")
Response.write ("")
Response.write ("![]() | ")
Response.write ("![]() | ")
Response.write ("![]() | ")
Response.write ("![]() | ")
Response.write ("![]() | ")
Response.write ("![]() | ")
Response.write ("![]() | ")
Response.write (" ")
Response.write ("")
Response.write ("| S | ")
Response.write ("M | ")
Response.write ("T | ")
Response.write ("W | ")
Response.write ("T | ")
Response.write ("F | ")
Response.write ("S | ")
Response.write (" ")
Response.write ("")
Response.write ("")
Response.write ("![]() ")
Response.write (" | ")
Response.write (" ")
' Initialize the end of rows flag to false
bEndRows = False
iIndex = 0
' Generate 6 rows in the calendar
For iRowNum = 0 To 5
' Start a table row. This corresponds to one week
Response.Write " " & vbCrLf
' This is the loop for the days in the week
For iLoopDay = 1 To 7
' If the first day is not sunday then print the last days of previous month
' in grayed font
If dMonthDay > dLastDay OR dMonthDay < dFirstDay Then
Write_BigTD Day(dMonthDay), "DIM"
Else
' Set events flag to false. This means the day has no event in it
bEvents = False
bLoopEnd = False
'
If iEventCount > 0 Then
Do While iIndex < iEventCount And bLoopEnd = 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 dMonthDay >= arEvents(cSTART_DATE, iIndex) AND dMonthDay <= arEvents(cEND_DATE, iIndex) Then
' Print the date highlighted font
bEvents = True
' Flag end of internal For loop
bLoopEnd = True
' If the Start date is greater than the date itself, there is no
' point checking other records. Exit the loop
ElseIf dMonthDay < arEvents(cSTART_DATE, iIndex) Then
bLoopEnd = True
End If
' Move to the next record
iIndex = iIndex + 1
Loop
' Reset the array pointer back to the first element
iIndex = 0
End If
iDay = Day(dMonthDay)
' If the event flag is not raised for that day, print it in a plain font
If bEvents = False Then
Write_BigTD " " & iDay & "", "NOEV"
' Otherwise print it in a bold font
Else
Write_BigTDEvent " " & iDay & "", "EV" ,iDay, iThisMonth, iThisYear
End If
End If
' Move to the next day in the week, increment the date.
dMonthDay = CDate(dMonthDay + 1)
Next
' Close the table row. End of that week
Response.Write " " & vbCrLf
Next
Response.write (" ")
'Response.write (" | ")
'Response.write (" ")
'Response.write (" |
")
'Response.write ("
")
End Sub
%>