<% Response.Buffer = True %> <% Session.LCID = 1053 %> <% strNowYear = CLng(Left(Date, 4)) strNowMonth = CLng(Mid(Date, 6, 2)) strNowDay = CLng(Right(Date, 2)) %> <% '************************************ 'Kopplingen till databasen '************************************ Set Connect = Server.CreateObject("ADODB.Connection") Connect.Open "driver={Microsoft Access Driver (*.mdb)};uid=;pwd=gurkmeja;dbq=" & Server.MapPath("../../data/calendar.mdb") Set RSCal = Server.CreateObject("ADODB.Recordset") %> <% 'GetDaysInMonth() Public Function GetDaysInMonth(ByVal vlngYear, ByVal vlngMonth) 'As Long 'Declarations Dim lngResult 'As Long Dim strDate 'As String 'Get date, add one month, reduce one day strDate = DateSerial(vlngYear, vlngMonth, 1) strDate = DateAdd("m", 1, strDate) strDate = DateAdd("d", -1, strDate) 'Set result lngResult = Day(strDate) 'Return result GetDaysInMonth = lngResult End Function %> <% 'RenderCalendar() Public Function RenderCalendar(ByVal vlngYear, ByVal vlngMonth) 'As String 'Declarations Dim strResult 'As String Dim lngDaysInMonth 'As Long Dim lngDay 'As Long Dim lngWeekday 'As Long 'Init variables lngDaysInMonth = GetDaysInMonth(vlngYear, vlngMonth) 'Loop, render empty For lngWeekday = 1 To Weekday(DateSerial(vlngYear, vlngMonth, 1), 2) - 1 strResult = strResult & "" & CHR(10) Next 'Loop For lngDay = 1 To lngDaysInMonth If lngDay < 10 Then strDayAdd = 0 & lngDay Else strDayAdd = lngDay End If strCheckDate = Left(strDate, 4) & "-" & Mid(strDate, 6, 2) & "-" & strDayAdd strCheckDay = strDayAdd strCheckMonth = Mid(strDate, 6, 2) strToday = Date CalCheck = "SELECT COUNT(Datum) AS Count FROM tblCalendar WHERE Datum = #" & strCheckDate & "#" RSCal.Open CalCheck, Connect, adOpenStatic, adLockOptimistic strCount = RSCal("Count") RSCal.Close If strCount = 0 Then strTrue = False Else strTrue = True End If 'Render If lngWeekday = 7 Then If lngDay = strNowDay And vlngMonth = strNowMonth And vlngYear = strNowYear Then If strTrue = True Then strResult = strResult & "" & lngDay & "" & CHR(10) Else strResult = strResult & "" & lngDay & "" & CHR(10) End If Else If strTrue = True Then strResult = strResult & "" & lngDay & "" & CHR(10) Else strResult = strResult & "" & lngDay & "" & CHR(10) End If End If Else If lngDay = strNowDay And vlngMonth = strNowMonth And vlngYear = strNowYear Then If strTrue = True Then strResult = strResult & "" & lngDay & "" & CHR(10) Else strResult = strResult & "" & lngDay & "" & CHR(10) End If Else If strTrue = True Then strResult = strResult & "" & lngDay & "" & CHR(10) Else strResult = strResult & "" & lngDay & "" & CHR(10) End If End If End If 'Set weekday lngWeekday = lngWeekday + 1 'Check weekday If lngWeekday > 7 And lngDay < lngDaysInMonth Then 'Render strResult = strResult & "" & CHR(10) & "" & CHR(10) 'Set weekday lngWeekday = 1 End If Next 'Check weekday If lngWeekday < 7 Then 'Loop, render empty For lngWeekday = Weekday(DateSerial(vlngYear, vlngMonth, lngDay), 2) To 7 strResult = strResult & "" & CHR(10) Next End If 'Return result RenderCalendar = strResult End Function %> <% 'Declarations Dim strDate 'As String 'Get request-parameters strDate = Request("date") 'Verify parameters If Not IsDate(strDate) Then strDate = Date strMonth = MonthName(Month(strDate)) strMonth = ucase(Left(strMonth,1)) & mid(strMonth,2) %>
<%= RenderCalendar(Year(strDate), Month(strDate)) %>
" target="smallcal">« <% =strMonth %>
<% =Year(strDate)%>
" target="smallcal">»
M T O T F L S
<% Connect.Close %>