<%
Dim dDatum, dtag, dMonat, dWeekday, dYear, dLastDay, dFirstDay, j
Function fGetLastDay(datum)
Dim fday, fmonth, fyear, fdate
fday = Mid(datum,1,2)
fmonth = Mid(datum,4,2)
fyear = Mid(datum,7,4)
FOR fday = 28 TO 32
fdate = dateserial(fyear, fmonth, fday)
IF NOT month(fdate) = Cdbl(fmonth) THEN
fGetLastDay = fday - 1
EXIT FOR
END IF
NEXT
End Function
WITH Response
IF Request("D") = "" THEN
dDatum = CDate(date())
ELSE
On Error Resume Next
dDatum = cDate(Request("D"))
IF Err.Number <> 0 THEN
.Write "Fehler"
.End
END IF
On Error Goto 0
END IF
dTag = Day(dDatum)
dMonat = Month(dDatum)
dMonat = MonthName(dMonat)
dWeekday = Weekday(dDatum,2)
dYear = Year(dDatum)
dLastDay = fGetLastDay(dDatum)
dFirstDay = Weekday(CDate("01." & dMonat & "." & dYear),2)
.Write " <TABLE WIDTH=""98%"" BORDER=""1"" " &_
"CELLPADDING=""0"" CELLSPACING=""0"" ALIGN=""center"">" & vbCrLf &_
" <TR>" & vbCrLf &_
" <TD>Montag</TD>" & vbCrLf &_
" <TD>Dienstag</TD>" & vbCrLf &_
" <TD>Mittwoch</TD>" & vbCrLf &_
" <TD>Donnerstag</TD>" & vbCrLf &_
" <TD>Freitag</TD>" & vbCrLf &_
" <TD>Samstag</TD>" & vbCrLf &_
" <TD>Sonntag</TD>" & vbCrLf &_
" </TR>" & vbCrLf &_
" <TR>" & vbCrLf
For i = 1 TO dFirstDay - 1
.Write " <TD> </TD>" & vbCrLf
j = j + 1
Next
For i = 1 TO fGetLastDay(dDatum)
IF j = 7 THEN
.Write " </TR>" & vbCrLf &_
" <TR>" & vbCrLf
j = 0
END IF
IF i = dTag THEN
.Write " <TD STYLE=""background-color: #0000FF;"">" & i &
"</TD>" & vbCrLf
ELSE
IF Weekday(CDate(i & "." & dMonat & "." & dYear),2) = 6 OR Weekday(CDate(i
& "." & dMonat & "." & dYear),2) = 7 THEN
.Write " <TD STYLE=""background-color: #FF0000;"">" & i &
"</TD>" & vbCrLf
ELSE
.Write " <TD STYLE=""background-color: #E5E5E5;"">" & i &
"</TD>" & vbCrLf
END IF
END IF
j = j + 1
Next
IF j < 7 THEN
Do until j = 7
.Write " <TD> </TD>" & vbCrLf
j = j + 1
Loop
END IF
.Write " </TR>" & vbCrLf &_
" </TABLE>" & vbCrLf
END WITH
%>