% 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)
%>
<% Connect.Close %>