Kalender met evenementen
Door Rogier Doekes
25 maart 2002
Dit artikel beschrijft een kalender met evenementen die per maand laat zien welke activiteiten er gepland zijn.
Deze kalender is makkelijk te navigeren, en kan online gewijzigd worden. De code voor deze kalender is onderaan
deze pagina te downloaden.
De pagina layout is een HTML tabel met een header en footer waarin we naar de vorige en volgende maand kunnen navigeren
(via de querystring variabelen month en year), met daartussen per dag de activiteiten voor de geselecteerde maand.
Om te zorgen dat de pagina de juiste maand weergeeft, wordt eerst gecontroleerd op het bestaan van een querystring.
Als die niet bestaat, of geen numerieke waarden bevat, wordt de huidige maand en jaar weergegeven:
<%
Option Explicit
Dim g_aEvents
Dim g_intMonth
Dim g_intYear
Dim g_lastDay
If Len(Request.QueryString("month")) = 0 Or _
Len(Request.QueryString("year")) = 0 Then
g_intMonth = Month(date)
g_intYear = Year(date)
ElseIf isNumeric(Request.QueryString("month")) = False Or _
isNumeric(Request.QueryString("year")) = False Then
g_intMonth = Month(date)
g_intYear = Year(date)
Else
g_intMonth = Cint(Request.QueryString("month"))
g_intYear = Cint(Request.QueryString("year"))
End If
%>
Om de tabel met de dagwaarden precies te laten eindigen op laatste dag van de maand, bepalen we de laatste dag van de maand.
Met de DateSerial selecteren we de eerste dag van de maand. Daar tellen we een maand bij op en trekken er een dag van af,
zodat we de laatste dag van de maand over houden. (met dank aan Robbert Nix voor deze code snippet)
<%
g_lastDay = Day(DateAdd("d",-1,(DateAdd("M",1, _
DateSerial(g_intYear,g_intMonth,1)))))
%>
De activiteiten worden opgeslagen in een database (hier MS Access) in de tabel event, die de volgende kolommen bevat:
| Event |
| kolomnaam | data type | omschrijving |
| Event_id | autonumber | primary key |
| Event_date | date/time | de dag van de activiteit |
| Event_text | text(200) | de beschrijving van de activiteit |
Het zoeken in deze tabel wordt gedaan met een SQL select statement die records met velden
event_date en event_text ophaalt, waarbij de event_date in de maand valt die we willen laten zien, als volgt:
SELECT event_date, event_text FROM
WHERE event_date BETWEEN [parameter_begin] AND [parameter_end]
In de code maken we gebruik van een functie fnGetEvents die dit statement uitleest en de records vervolgens terug geeft in een array met
de functie oRs.GetRows. De functie fnGetEvents maakt gebruik van een utility functie fnDateReplace. Zoveel databases als er zijn, zoveel
verschillende syntaxes voor de datum. Aangezien we hier met Access werken moeten datum parameters tussen hekjes (#) geplaatst worden. Dus #dd-mm-yyyy#
(als je database natuurlijk nederlands is). Omdat elk land ook z'n eigen datumnotatie heeft en de applicatie server een andere taal kan hebben dan de database,
wordt vaak gebruik gemaakt van de volgende datumnotatie #yyyy/mm/dd#, welke elke Access versie zonder meer accepteerd. De volgende functie zet de dag in dat formaat om:
<%
Function fnDateReplace(intYear, intMonth, intDay)
fnDateReplace = "#" & intYear & "/" & intMonth & "/" & intDay & "#"
End Function
%>
<%
Function fnGetEvents(intMonth, intYear, intEndDay)
Dim oCnn
Dim oRs
Dim strSQL
Set oCnn = Server.CreateObject("ADODB.Connection")
oCnn.Open Application("connection")
strSQL = "SELECT event_date, " & _
"event_text" & _
" FROM event" & _
" WHERE" & _
" event_date BETWEEN " & _
fnDateReplace(intYear, intMonth, 1) & _
" AND " & _
fnDateReplace(intYear, intMonth, intEndDay) & _
" ORDER BY event_date ASC"
Set oRs = oCnn.Execute(strSQL)
If (oRs.EOF) or (oRs.BOF) Then
fnGetEvents = 0
Else
fnGetEvents = oRs.GetRows
End If
oRs.Close
Set oRs = Nothing
oCnn.Close
Set oCnn = Nothing
End Function
%>
De functie fnPrevNextMonth schrijft de header en de footer voor de output. De functie retourneert een tabel met een hyperlink
naar de vorige maand en een hyperlink naar de volgende maand. De maand januari heeft als vorige maand december van het jaar ervoor,
terwijl december als volgende maand januari van het volgend jaar heeft. Daarom worden in deze functie vier variabelen gedefinieerd
die deze waarden vastleggen en vervolgens wordt de header tabel geschreven.
Function fnPrevNextMonth(intMonth, intYear)
Dim strOutput
Dim intPreviousMonth
Dim intNextMonth
Dim intPreviousyear
Dim intNextYear
If intMonth = 1 Then
intPreviousMonth = 12
intPreviousYear = intYear -1
intNextMonth = 2
intNextYear = intYear
ElseIf intMonth = 12 Then
intPreviousMonth = 11
intPreviousYear = intYear
intNextMonth = 1
intNextYear = intYear + 1
Else
intPreviousMonth = intMonth - 1
IntPreviousYear = intYear
intNextMonth = intMOnth + 1
intNextYear = intYear
End If
strOutput = _
<"TABLE width='100%'>" & vbCrLf & _
"<TR>" & vbCrLf & _
"<TD><A href'" & Request.ServerVariables("Script_name") & _
"'?month=" & intPreviousMonth & "&year=" & intPreviousYear & _
"'<vorige maand</A></TD>" & vbCrLf & _
"<TD>Kalendar voor de maand " & intMonth & _
" jaar" & intYear & "<TD>" & vbCrLf & _
"<TD><A href='" & Request.ServerVariables("Script_name") & _
"'?month=" & intNextMonth & "&year=" & intNextYear & _
"'<volgende maand</A></TD>" & vbCrLf & _
"</TR>" & vbCrLf & _
"</TABLE>" & vbCrLf
fnPrevNextMonth = strOutput
End Function
%>
Nu komen we bij de hoofdmoot van de kalendar. Met de functie fnWriteCalendar wordt de tabel
met de kalender voorbereid. Eerst wordt de header geproduceerd: fnPrevNextMonth (zie hierboven),
en vervolgens worden de dagen verwerkt.
De array uit fnGetEvents wordt voor elke dag uitgelezen en als er een dag matched, worden de activiteiten uitgeschreven.
Als laatste wordt de footer (strHeader) aangeroepen.
<%
Function fnWriteCalendar(intMonth, intYear, intEndDay, aEvents)
Dim strOutput
Dim iDag
Dim iEvent
Dim strHeader
strHeader = fnPrevNextMonth(intMonth, intYear)
Session.LCID = 1033
strOutput = _
"<TABLE border=1 width=500>" & vbCrLf & _
"<TR>" & vbCrLf & _
"<TD colspan=2>Activiteiten kalender</TD>" & vbCrLf & _
"</TR>" & vbCrLf & _
"<TR>" & vbCrLf & _
"<TD colspan=2>" & vbCrLf & _
strHeader & _
"</TD>" & vbCrLf & _
"</TR>" & vbCrLf
For iDag = 1 To intEndDay
strOutput = strOutput & _
"<TR>" & vbCrLf & _
"<TD valign=top>" & _
iDag & "-" & intMonth & "-" & intYear & _
"</TD>" & vbCrLf & _
"<TD>"
If IsArray(aEvents) Then
For iEvent = 0 To Ubound(aEvents, 2)
If Cdate(aEvents(0, iEvents)) = _
Cdate(DateSerial(intYear, intMonth, iDag)) Then
strOutput = strOutput & _
aEvents(1, iEvents) & ";"
End If 'aEvents(0,i) = Date
Next
End If
strOutput = strOutput & _
" </TD>" & vbCrLf & _
"</TR>" & vbCrLf
;strOutput = strOutput & _
"</TR><TD colspan=2>" & vbCrLf & _
strHeader & _
"</TD></TR>" & vbCrLf & _
"</TABLE>" & vbCrLf
fnWriteCalendar = strOutput
End Function
%>
Als laatste het aanroepen van de functie fnWriteCalendar die de kalender naar het scherm schrijft:
<%
Response.Write fnWriteCalendar( g_intMonth, g_intYear, g_lastDay, _
fnGetEvents(g_intMOnth, g_intYear, g_lastDay))
%>
Toevoegen nieuwe activiteiten
De asp pagina om nieuwe activiteiten toe te voegen bestaat uit twee blokken: de <FORM> die ingevuld verstuurd wordt en een blok waarin de invoer, alleen na correcte validatie, in de database ingevoerd wordt.
De <FORM> bestaat uit twee invoervelden INPUT name=event_date en <INPUT name=event_text>. Omdat de pagina naar zichzelf verstuurd
wordt is er een hidden <INPUT> in de form opgenomen:
<INPUT type=hidden name=event value=go>
Een alternatief op deze manier is te controleren of de gebruiker op de submit knop gedrukt heeft:
<INPUT type=submit name=cmdSubmit value='voer in'>
Je kunt dit controleren met de volgende asp code:
<%
If Request.Form("cmdSubmit") = "voer in" Then
Else
End If
%>
In dit voorbeeld in voor de <INPUT type=hidden> gekozen.
Met de functie fnWriteForm wordt de <FORM> geschreven. De input parameters van deze functie zijn leeg
als de pagina voor het eerst aangeroepen wordt, maar hebben
de verstuurde formulier waarden wanneer de pagina verstuurd is en niet correct is. Dit zorgt ervoor dat de gebruiker alleen maar
de fouten hoeft te herstellen en niet het gehele form opnieuw in te vullen. De verstuurde waarden worden in het value attribuut meegenomen.
Een voorbeeld:
Een input tag zonder waarden codeer je als volgt:
<INPUT name='tag_name'>
Met waarden voeg je alleen de value attribute toe:
<INPUT name='tag_name' value='123'>
Hieronder is de code voor de functie fnWriteForm
<%
Function fnWriteForm(strMessage, dtmEventDate, strEventText)
Dim strOutput
strOutput = _
"<P>" & strMessage & "</P>" & vbCrLf
strOutput = strOutput & _
"<FORM action='" & Request.ServerVariables("SCRIPT_NAME") & _
"' method=post>" & vbCrLf & _
"<INPUT type=hidden name=event value=go>" & vbCrLf & _
"<TR>" & vbCrLf & _
"<TD>datum activiteit</TD>" & vbCrLf & _
<TD><INPUT name=event_date value='" & dtmEventDate & _
"'></TD>" & vbCrLf & _
"</TR>" & vbCrLf & _
"<TRv" & vbCrLf & _
"<TD>activiteit</TD>" & vbCrLf & _
<TD><INPUT name=event_text value='" & strEventText & _
"'></TD>" & vbCrLf & _
"</TR>" & vbCrLf & _
"<TR>" & vbCrLf & _
"<TD colspan=2 align=center>" & vbCrLf & _
"<INPUT type=submit name=cmdSubmit value='voer in'></TD>" & _
vbCrLf & _
"</TR>" & vbCrLf & _
"</TABLE>" & vbCrLf & _
"</FORM>" & vbCrLf
fnWriteForm = strOutput
End Function
%>
Het invoeren van de record in de database gebeurt met het volgende SQL statement:
INSERT INTO event (event_date, event_text)
VALUES ([date_param], [text_param])
Nu is event_date een kolom van het type date/time en event_text is een kolom van het type text.
Voor de event_date gebruiken we een utility function fnDateReplace die hekjes (#) om de datumwaarde heen zet
(Access verlangt dat van datum parameters) en het formaat als yyyy/mm/dd wegschrijft:
<%
Function fnDateReplace(dtmDate)
fnDateReplace = "#" & Year(dtmDate) & "/" & Month(dtmDate) & _
"/" & Day(dtmDate) & "#"
End Function
%>
Voor de event_text kolom parameter gebruiken we een andere utility function fnQuoteReplace.
Deze functie zet enkele quotes (') om de literal heen en vervangt in de text een enkele quote met twee enkele quotes.
Waarom is dit belangrijk? Stel we willen deze string opslaan in de database: "Rogier's programma". Lijkt een prima statement
en moet ook kunnen. Dit wordt het volgende statement:
INSERT INTO programma (van_wie) VALUES ('Rogier's programma')
Dit geeft een fout melding omdat SQL niet meer dan 'Rogier' leest voor de van_wie waarde en de rest is fout. Om nu toch enkele
quotes in de database te kunnen invoeren gebruiken we twee enkele quotes achter elkaar. Het statement wordt dan:
INSERT INTO programma (van_wie) VALUES ('Rogier''s programma')
En nu gaat de uitvoering van het statement wel goed.
<%
Function fnQuoteReplace(strtext)
fnQuoteReplace = "'" & Replace(strText, "'", "''") & "'"
End Function
%>
Het controleren en het bijwerken van het formulier wordt gedaan in de function fnUpdateForm. Deze form heeft de volgende validatie regels:
- controleer of de lengte van de datum invoer niet 0 is
- controleer of de datum invoer wel een datum is
- controleer of de lengte van de activiteit text invoer niet 0 is
- controleer of de datum niet verstreken is
Daarna wordt het SQL statement gemaakt en uitgevoerd.
Als het SQL statement zonder fouten uitgevoerd wordt heeft Err.Number de waarde 0. Een andere waarde geeft aan dat er een fout is opgetreden.
Het gebruik van On Error Resume Next heeft tot gevolg dat zelfs als er een fout in het SQL statement zit de applicatie niet aburpt stopt.
De returnwaarden 1 tot 5 worden later omgezet in specifieke foutmeldingen, terwijl we voor een SQL statement update error een standaard boodschap coderen. (zie aanroep functie)
Function fnUpdateForm(dtmEventDate, strEventText)
Dim strSQL
Dim oCnn
On Error Resume Next
If Not Len(dtmEventDate) > 0 Then
fnUpdateForm = 1
Exit Function
End if
If isDate(dtmEventDate) = False Then
fnUpdateForm = 2
Exit Function
End If
If Not Len(strEventText) > 0 Then
fnUpdateForm = 3
Exit Function
End If
If DateDiff("d", Date, Cdate(dtmEventDate)) < 0 Then
fnUpdateForm = 4
Exit Function
End If
strSQL = "INSERT INTO event (event_date, event_text)" & _
" values (" & _
fnDateReplace(dtmEventDate) & "," & _
fnQuoteReplace(strEventText) & ")"
Set oCnn = Server.CreateObject("ADODB.Connection")
oCnn.Open Application("connection")
If err.Number <> 0
fnUpdateForm = 5
oCnn.Close
Set oCnn = Nothing
Exit Function
End If
oCnn.Execute strSQL
fnUpdateForm = err.number
oCnn.Close
Set oCnn = Nothing
End Function
%>
Nu hebben we alle blokken gereed en kunnen we de verbindingen leggen.
Allereerst controleren we of het Request.Form("event") element de waarde "go" heeft. Als dat niet het geval moet moet de <FORM>
geschreven worden (fnWriteForm zonder meldingen). Als dat wel het geval is moeten de formulier elementen afgehandeld worden (fnUpdateForm gevolgd door
fnWriteForm met de meldingen).
<%
<HTML>
<HEAD>
<TITLE>nieuwe activiteit toevoegen</TITLE>
</HEAD>
<BODY>
%>
Option Explicit
Dim intReturnValue
Session.LCID = 1043
If Request.Form("event") = "go" Then
intReturnValue = fnUpdateForm( _
Request.Form("event_date"), _
Request.Form("event_text"))
Select Case intReturnValue
Case 0
Response.Write fnWriteForm("activiteit aangelegd", _
date, "")
Case 1
Response.Write fnWriteForm("datum is verplicht veld",_
Request.Form("event_date"), _
Request.Form("event_text"))
Case 2
Response.Write fnWriteForm("geen herkende datum", _
Request.Form("event_date"), _
Request.Form("event_text"))
Case 3
Response.Write _
fnWriteForm("activiteit is een verplicht veld", _
Request.Form("event_date"), _
Request.Form("event_text"))
Case 4
Response.Write _
fnWriteForm("ingevoerde datum is al verstreken", _
Request.Form("event_date"), _
Request.Form("event_text"))
Case 5
Response.Write _
fnWriteForm("fout in de dataconnectie", _
Request.Form("event_date"), _
Request.Form("event_text"))
Case Else
Response.Write fnWriteForm("fout in de update", _
Request.Form("event_date"), _
Request.Form("event_text"))
End Select
Else
Response.Write fnWriteForm("", date, "")
End If
%>
</BODY>
</HTML>
Download de code
|