<% Response.Expires = 0 Response.Expiresabsolute = Now() - 1 Response.AddHeader "pragma","no-cache" Response.AddHeader "cache-control","private" Response.CacheControl = "no-cache" %> <% '*************************************************************************** '* ASP 101 Sample Code - http://www.asp101.com * '* * '* This code is made available as a service to our * '* visitors and is provided strictly for the * '* purpose of illustration. * '* * '* Please direct all inquiries to webmaster@asp101.com * '* * '* HISTORY * '* ------------------------------------------------------------------------* '* Unk David McIntosh Updated and Streamlined. Contact me at * '* dmcintosh@carolina.rr.com * '* * '* 01.14.2002 Michael S. Hepfer Added Database and CSS interaction. * '* michael_steven1@hotmail.com * '* * '*************************************************************************** Dim dDate ' Date we're displaying calendar for Dim iDIM ' Days In Month Dim iDOW ' Day Of Week that month starts on or the Day of Week were on. Dim iCurrent ' Variable we use to hold current day of month as we write table Dim ld_loopDate ' holds the loop position date as we loop thru the calender Dim lb_eventsFound ' boolean true events were found for the loop date DIM rstemp ' the recordset 'get the events for this month and keep them in the recordset open_calender_connection() Set rstemp = Server.CreateObject( "ADODB.Recordset" ) set rstemp=connCalender.execute( "select * from calender_event" ) ' Call function to get the selected date dDate = GetSelectedDate() ' write out the calender With Response ' first (Outer) Table is simply to get the pretty border .Write "Hello" .Write "" .Write "" .Write "" .Write "" .Write "

" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" 'Get day of the week the month starts on. iDOW = GetWeekdayMonthStartsOn(dDate) ' Write spacer cells at beginning of first row if month doesn't start on a Sunday. .Write vbTab & "" & vbCrLf For iCurrent = 1 to iDOW - 1 .Write vbTab & vbTab & "" & vbCrLf Next ' Write days of month in proper day slots For iCurrent = 1 to GetDaysInMonth(Month(dDate), Year(dDate)) ' set the current date, were going to use it twice later on ld_loopDate = cdate( Month(dDate) & "/" & iCurrent & "/" & Year(dDate) ) ' If we're at the begginning of a row then write TR If iDOW = 1 Then .Write vbTab & "" & vbCrLf End If ' If the day we're writing is the selected day then highlight it somehow. If iCurrent = Day(dDate) Then .Write vbTab & vbTab & "" ' If we're at the endof a row then close it up If iDOW = 7 Then .Write vbTab & "" & vbCrLf iDOW = 0 End If ' Increment the days of the week iDOW = iDOW + 1 Next ' Write spacer cells at end of last row if month doesn't end on a Saturday. If iDOW <> 1 Then Do While iDOW <= 7 .Write vbTab & vbTab & "" & vbCrLf iDOW = iDOW + 1 Loop .Write vbTab & "" & vbCrLf End If ' close up both the tables .Write " " .Write "" .Write "" .Write "" .Write "" .Write "" .Write "" .Write " << " & MonthName(Month(dDate)) & " " & Year(dDate) & " >> " .Write " Sun Mon Tue Wed Thu Fri Sat   " .Write iCurrent & " " Else .Write vbTab & vbTab & " " .Write "" .Write "" & iCurrent & " " & vbCrLf End If ' write out events for the current day filtering the recordset and calling a function rstemp.Filter = "start_dt <= " & ld_loopDate & " and end_dt >= " & ld_loopDate ' filter the recordset lb_eventsFound = WriteEventLabelsForRecordset( rstemp ) rstemp.Filter = 0 If not lb_eventsFound then ' give the cell some height .Write " " End If lb_eventsFound = false ' reset the flag ' close up the current day .Write "   " .Write "

" .Write "
" ' call function that writes the date select form, and show events for the selected date Call WriteSelectDateForm() rstemp.Filter = "start_dt <= " & dDate & " and end_dt >= " & dDate ' filter the recordset Call WriteEventsForRecordset( rstemp ) 'write the events for the recordset ' the add new event link .Write "Add a new event" End With ' Close the calender connection close_calender_connection() set rstemp = nothing %>