<%@ Language=VBScript %> <%dim colorScheme : colorScheme = "blue" %> <%dim pageTitle : pageTitle = "title_calendar.gif" %> <% Dim iYear Dim iMonth Dim iDay Dim dMinDate : dMinDate = "1/1/2003" Dim dMaxDate : dMaxDate = "12/1/" & CStr(Year(date()) + 2) 'String representations of the year, month, and day (YYYY, MM, DD) for comparisons with the DateID. Dim sYear Dim sMonth Dim sDay Dim sYearMonth Dim sYearMonthDay Dim sDate ' Used for the while loops counters Dim dDate ' Date we're displaying calendar for Dim dDateTemp ' Temp Variable for Date addition/subtraction functions Dim dDateTempMonth ' Temp Variable for Date addition/subtraction functions Dim iDIM ' Days In Month Dim iDOW ' Day Of Week that month starts on Dim iCurrent ' Variable we use to hold current day of month as we write table Dim iPosition ' Variable we use to hold current position in table dim oConn dim oCmd dim oRs dim isAdmin dim sEvents dim sAllDayEvents isAdmin = false ' BUG... implement this. dim iCatId: iCatId = -1 If IsNumeric(Request.Item("category_id")) And Request.Item("category_id") <> "" Then iCatId = CInt(Request.Item("category_id")) Response.Cookies("category_id") = Request.Item("category_id") ElseIf IsNumeric(Request.Cookies("category_id")) And Request.Cookies("category_id") <> "" Then iCatId = CInt(Request.Cookies("category_id")) End If ' Get selected date. There are two ways to do this. ' First check if we were passed a full date in RQS("date"). ' If so use it, if not look for separate variables, putting them together into a date. ' Lastly check if the date is valid...if not use today If IsDate(Request.QueryString("date")) Then dDate = CDate(Request.QueryString("date")) Else If IsDate(Request.QueryString("month") & "-" & Request.QueryString("day") & "-" & Request.QueryString("year")) Then dDate = CDate(Request.QueryString("month") & "-" & Request.QueryString("day") & "-" & Request.QueryString("year")) Else dDate = Date() ' The annoyingly bad solution for those of you running IIS3 If Len(Request.QueryString("month")) <> 0 Or Len(Request.QueryString("day")) <> 0 Or Len(Request.QueryString("year")) <> 0 Or Len(Request.QueryString("date")) <> 0 Then Response.Write "

The date you picked was not a valid date. The calendar was set to today's date.

" End If ' The elegant solution for those of you running IIS4 'If Request.QueryString.Count <> 0 Then Response.Write "The date you picked was not a valid date. The calendar was set to today's date.

" End If End If iYear = Year(dDate) iMonth = Month(dDate) iDay = Day(dDate) 'Now we've got the date. Now get Days in the choosen month and the day of the week it starts on. iDIM = GetDaysInMonth(Month(dDate), Year(dDate)) iDOW = GetWeekdayMonthStartsOn(dDate) 'Create the command object to return the reports set oConn = Server.CreateObject("ADODB.Connection") with oConn ' .ConnectionString = "Driver=SQL Server;Server=10.0.0.5;database=Calendar;uid=sa;pwd=nsswfi98" .ConnectionString = Application("ConnString") .Open end with %>
" border="0" alt="<%=MonthName(Month(dDate), true)%>." /> Month-At-A-Glance.
<%dDateTemp = dDate dDateTempMonth = SubtractOneMonth(dDateTemp) if datediff("d", dMinDate, dDateTempMonth) >= 0 then Call renderMiniCalendar(dDateTempMonth, 0, isAdmin, false) else%>
 
<% end if %>

<%= MonthName(iMonth) & " " & Year(dDate) %>

<% printDropBox "month", CStr(iMonth), aMonths %> <% printDropBox "year", CStr(iYear), aYears %>

Category: <% '--------------------------------------------------------------------------- ' ' populate with categories ' '--------------------------------------------------------------------------- set oCmd = server.CreateObject("ADODB.Command") with oCmd set .ActiveConnection = oConn .CommandText = "p_SelectCategories" .CommandType = adCmdStoredProc '.Parameters.Append .CreateParameter("@DateID", adInteger, adParamInput, 4, iDateID) .Execute set oRs = Server.CreateObject("ADODB.Recordset") with oRs .Open oCmd, , adOpenForwardOnly, adLockReadOnly redim preserve aCategories(2,0) aCategories(0,i) = "-1" aCategories(1,i) = "(No Category)" aCategories(2,i) = "" i = 1 while not .EOF redim preserve aCategories(2,i) aCategories(0,i) = .Fields("CategoryID").Value aCategories(1,i) = .Fields("CategoryName").Value aCategories(2,i) = "EditCat" & .Fields("CategoryID").Value .MoveNext i = i + 1 wend end with oRs.close set oRs = nothing end with set oCmd = nothing printDropBox "category_id", CStr(iCatID), aCategories %> <% If sDate <> date Then Response.Write "" End If %>


Month-At-A-Glance.
<%dDateTemp = dDate dDateTempMonth = AddOneMonth(dDateTemp) if datediff("d", dMaxDate, dDateTempMonth) <= 0 then Call renderMiniCalendar(dDateTempMonth, 0, isAdmin, false) else%>
 
<% end if %>

   << Back

<% ' Write spacer cells at beginning of first row if month doesn't start on a Sunday. If iDOW <> 1 Then Response.Write vbTab & "" & vbCrLf iPosition = 1 Do While iPosition < iDOW Response.Write vbTab & vbTab & "" & vbCrLf iPosition = iPosition + 1 Loop End If set oCmd = Server.CreateObject("ADODB.Command") with oCmd set .ActiveConnection = oConn .CommandText = "p_SelectCalendarEvents" .CommandType = adCmdStoredProc ' Since the dateID is an int, we compare by numbers, which are created by concatening strings. ' The database won't care that the 20020231 is invalid because February has 28 days... it's still an int. ' As long as months don't have 32 days, we'll be fine. :) sMonth = Month(dDate) if sMonth < 10 then sMonth = "0" & sMonth end if sYearMonth = cDbl(Year(dDate) & sMonth) .Parameters.Append .CreateParameter("@Begin", adDouble, adParamInput, 4, sYearMonth & "01") .Parameters.Append .CreateParameter("@End", adDouble, adParamInput, 4, sYearMonth & "31") If iCatId > -1 Then oCmd.Parameters.Append .CreateParameter("@Category", adDouble, adParamInput, 4, iCatId) End If oCmd.Execute set oRs = Server.CreateObject("ADODB.Recordset") with oRs .Open oCmd,,adOpenForwardOnly,adLockReadOnly '.MoveFirst ' Write days of month in proper day slots iCurrent = 1 iPosition = iDOW Do While iCurrent <= iDIM ' Get the current day in two-digit format --dave 01/10/03 if iCurrent < 10 then sDay = "0" & iCurrent else sDay = iCurrent end if sYearMonthDay = sYearMonth & sDay ' If we're at the beginning of a row then write TR If iPosition = 1 Then Response.Write vbTab & "" & vbCrLf End If ' We have to keep checking if it's .EOF, otherwise, it'll crap out when it hits the ' end of the record set, and we haven't finished printing the calendar. If Not .EOF then sDate = .Fields("DateID").Value End If ' If the day we're writing is the selected day then highlight it somehow. If datevalue(date) = dateserial(year(dDate), month(dDate), iCurrent) Then Response.Write vbTab & vbTab & " <% ' Else ' Response.Write vbTab & vbTab & "" & vbCrLf ' End If ' If we're at the endof a row then write /TR If iPosition = 7 Then Response.Write vbTab & "" & vbCrLf iPosition = 0 End If ' Increment variables iCurrent = iCurrent + 1 iPosition = iPosition + 1 Loop end with oRs.close set oRs = nothing end with set oCmd = nothing oConn.Close set oConn = nothing ' Write spacer cells at end of last row if month doesn't end on a Saturday. dim i: i = 1 If iPosition <> 1 Then Do While iPosition <= 7 Response.Write vbTab & vbTab & "" & vbCrLf ' Response.Write vbTab & vbTab & "" & vbCrLf iPosition = iPosition + 1 i = i + 1 Loop Response.Write vbTab & "" & vbCrLf End If %>
Sun
Mon
Tue
Wed
Thu
Fri
Sat
" & day(dateadd("D", 0 - (iDOW - iPosition), iMonth & "/1/" & iYear)) & "
" Response.Write vbCrLf & vbTab & vbTab & vbTab else Response.Write vbTab & vbTab & "" Response.Write vbCrLf & vbTab & vbTab & vbTab end if if isAdmin then Response.Write "" & vbcrlf Response.Write vbCrLf & vbTab & vbTab & vbTab end if sEvents = "" sAllDayEvents = "" ' Is the event that we're on supposed to be displayed on this day? --dave 01/10/03 Do While Not .EOF if cDbl(sDate) <> cDbl(sYearMonthDay) then Exit Do end if if not isnull(.Fields("DateIcon").Value) then sDateIcon = .Fields("DateIcon").Value else sDateIcon = null end if if not isnull(.Fields("DateTitle").Value) then sDateTitle = .Fields("DateTitle").Value else sDateTitle = null end if if .Fields("AllDayEvent").Value then 'icon and link (Is this supposed to go to a page with events that have similiar icons??) if len(.Fields("IconFileName").Value) > 0 then sAllDayEvents = sAllDayEvents & "" end if if len(sAllDayEvents) = 0 then sAllDayEvents = .Fields("ShortDescription").Value else sAllDayEvents = sAllDayEvents & .Fields("ShortDescription").Value & "

" end if else 'icon and link (Is this supposed to go to a page with events that have similiar icons??) if len(.Fields("IconFileName").Value) > 0 then sEvents = sEvents & "" end if sEvents = sEvents & "" & getPrettyTime(.Fields("StartTime").Value) 'if .Fields("EndTime").Value then ' sEvents = sEvents & " - " & getPrettyTime(.Fields("EndTime").Value) 'end if sEvents = sEvents & "
" & vbCrLf 'link for item sEvents = sEvents & vbTab & vbTab & vbTab & vbTab & vbTab sEvents = sEvents & "" sEvents = sEvents & "" & .Fields("ShortDescription").Value & "

" sEvents = sEvents & "
" & vbCrLf sEvents = sEvents & vbTab & vbTab & vbTab & vbTab & vbTab end if .MoveNext If Not .EOF then sDate = .Fields("DateID").Value End If Loop if len(sAllDayEvents) > 0 or len(sEvents) > 0 then Response.Write "" & iCurrent & "" & vbcrlf else Response.Write "" & iCurrent & "" & vbcrlf end if if len(sDateIcon) > 0 then Response.Write "" end if %>
<% if len(sDateTitle) > 0 then %>

<%=sDateTitle%>

<% end if %> <% if len(sAllDayEvents) > 0 then %>

<%=sAllDayEvents%>

<% end if %>

<%=sEvents%>

" ' ' if isAdmin then ' Response.Write "" & vbcrlf ' end if ' Response.Write "" & iCurrent & "" & vbcrlf ' ' ' Is the event that we're on supposed to be displayed on this day? --dave 01/10/03 ' Do While Not .EOF ' if cDbl(sDate) <> cDbl(sYearMonthDay) then ' Exit Do ' end if ' Response.Write .Fields("DateID").Value & " = " & sYearMonthDay ' Response.Write .Fields("StartTime").Value & ", " & .Fields("EndTime").Value & ", " & _ ' .Fields("ShortDescription").Value & ", " & _ ' .Fields("AllDayEvent").Value & ", " & _ ' .Fields("IconFileName").Value & ", " & _ ' .Fields("CategoryName").Value & "

" ' .MoveNext ' If Not .EOF then ' sDate = .Fields("DateID").Value ' End If ' Loop ' ' 'Response.Write renderDay(Year(dDate),Month(dDate),iCurrent) ' Response.Write "
" & i & "