<% 'Response.CacheControl= "public" %> <% 'Response.ExpiresAbsolute=#23:58:00# %> Calendar <% Function GetDaysInMonth(iMonth, iYear) Dim dTemp dTemp = DateAdd("d", -1, DateSerial(iYear, iMonth + 1, 1)) GetDaysInMonth = Day(dTemp) End Function Function GetWeekdayMonthStartsOn(dAnyDayInTheMonth) Dim dTemp dTemp = DateAdd("d", -(Day(dAnyDayInTheMonth) - 1), dAnyDayInTheMonth) GetWeekdayMonthStartsOn = WeekDay(dTemp) End Function Function SubtractOneMonth(dDate) SubtractOneMonth = DateAdd("m", -1, dDate) End Function Function AddOneMonth(dDate) AddOneMonth = DateAdd("m", 1, dDate) End Function Dim dDate ' Date we're displaying calendar for 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 s Dim startdat, diffis, diffistod ' 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 seperate variables, putting them togeter into a date. ' Lastly check if the date is valid...if not use today startdat = "8/1/2000" If IsDate(Request.QueryString("date")) Then dDate = CDate(Request.QueryString("date")) Else dDate = Date() End If '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) %> <% ' 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 ' Write days of month in proper day slots iCurrent = 1 iPosition = iDOW Do While iCurrent <= iDIM ' If we're at the begginning of a row then write TR If iPosition = 1 Then Response.Write vbTab & "" & vbCrLf End If ' If the day we're writing is the selected day then highlight it somehow. if iCurrent < 10 then datethis = "0" & iCurrent else datethis = iCurrent end if if Month(dDate) < 10 then monththis = "0" & Month(dDate) else monththis = Month(dDate) end if if iPosition = 1 then d = 0 else d = 0 end if s = Year(dDate) & "/" & monththis & "/" & datethis diffis = Datediff("d",startdat,s) diffistod = Datediff("d",date,s) if ((diffis >= 0) and (diffistod < 0)) then Response.Write vbTab & vbTab & "" & vbCrLf 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 ' Write spacer cells at end of last row if month doesn't end on a Saturday. If iPosition <> 1 Then Do While iPosition <= 7 Response.Write vbTab & vbTab & "" & vbCrLf iPosition = iPosition + 1 Loop Response.Write vbTab & "
<%= MonthName(Month(dDate)) & " " & Year(dDate) %>
Sun Mon Tue Wed Thu Fri Sat
 
" & iCurrent & "
" & iCurrent & "
 
" & vbCrLf End If %>