<% strNowYear = CLng(Left(Date, 4)) strNowMonth = CLng(Mid(Date, 6, 2)) strNowDay = CLng(Right(Date, 2)) %> <% Set RSRelease = Server.CreateObject("ADODB.Recordset") Set RSConcert = Server.CreateObject("ADODB.Recordset") Set RSHistory = Server.CreateObject("ADODB.Recordset") Set RSBirth = Server.CreateObject("ADODB.Recordset") Set RSFair = 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 Fair = "SELECT COUNT(FairDate) AS Count FROM tblFair WHERE FairDate = #" & strCheckDate & "# AND FairDate >= #" & strToday & "# AND Deleted = False" RSFair.Open Fair, Connect, adOpenStatic, adLockOptimistic History = "SELECT COUNT(HistDate) AS Count FROM tblHistory WHERE Month(HistDate) = " & strCheckMonth & " AND Day(HistDate) = " & strCheckDay & " AND Deleted = False" RSHistory.Open History, Connect, adOpenStatic, adLockOptimistic Birth = "SELECT COUNT(BirthDate) AS Count FROM tblMember WHERE Month(BirthDate) = " & strCheckMonth & " AND Day(BirthDate) = " & strCheckDay & " AND Deleted = False AND Active = True" RSBirth.Open Birth, Connect, adOpenStatic, adLockOptimistic Concert = "SELECT COUNT(ConDate) AS Count FROM tblConcert WHERE ConDate = #" & strCheckDate & "# AND Deleted = False" RSConcert.Open Concert, Connect, adOpenStatic, adLockOptimistic Release = "SELECT COUNT(RelDate) AS Count FROM tblRelease WHERE RelDate = #" & strCheckDate & "# AND Deleted = False" RSRelease.Open Release, Connect, adOpenStatic, adLockOptimistic strFair = RSFair("Count") strRelease = RSRelease("Count") strConcert = RSConcert("Count") strHistory = RSHistory("Count") strBirth = RSBirth("Count") strCount = strFair -- strRelease -- strConcert -- strHistory -- strBirth If strFair = 0 Then strFairC = "Mässor: " & strFair Else strFairC = "Mässor: " & strFair & "" End If If strRelease = 0 Then strReleaseC = "Releaser: " & strRelease Else strReleaseC = "Releaser: " & strRelease & "" End If If strConcert = 0 Then strConcertC = "Konerter: " & strConcert Else strConcertC = "Konerter: " & strConcert & "" End If If strHistory = 0 Then strHistoryC = "Historia: " & strHistory Else strHistoryC = "Historia: " & strHistory & "" End If If strBirth = 0 Then strBirthC = "Medlemmar: " & strBirth Else strBirthC = "Medlemmar: " & strBirth & "" End If strCountResult = strFairC & "
" & strReleaseC & "
" & strConcertC & "
" & strHistoryC & "
" & strBirthC RSFair.Close RSRelease.Close RSConcert.Close RSHistory.Close RSBirth.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 & "
" & strCountResult & "" & CHR(10) Else strResult = strResult & "" & lngDay & "" & CHR(10) End If Else If strTrue = True Then strResult = strResult & "" & lngDay & "
" & strCountResult & "" & 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 & "
" & strCountResult & "" & CHR(10) Else strResult = strResult & "" & lngDay & "" & CHR(10) End If Else If strTrue = True Then strResult = strResult & "" & lngDay & "
" & strCountResult & "" & 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) %> Skivbaren.nu's Kalender

<%= RenderCalendar(Year(strDate), Month(strDate)) %>
">« <% =strMonth %>
<% =Year(strDate)%>
">»
Måndag Tisdag Onsdag Tordag Fredag Lördag Söndag