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