ASPNL logo (1 kb)
zaterdag 17 mei 2008




Microsoft MVP

.NET Codewise Community
<< vorige | overzicht | volgende >>

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

'definieren van de global variabelen
Dim g_aEvents 'array met de activeiten van deze maand
Dim g_intMonth   'geselecteerde maand
Dim g_intYear   'geselecteerde jaar
Dim g_lastDay   'laatste dag van de maand

'initiële waarden zijn huidige maand en jaar
If Len(Request.QueryString("month")) = 0 Or _
      Len(Request.QueryString("year")) = 0 Then

      g_intMonth = Month(date)
      g_intYear = Year(date)

'rommel in de querystring
ElseIf isNumeric(Request.QueryString("month")) = False Or _
   isNumeric(Request.QueryString("year")) = False Then

      g_intMonth = Month(date)
      g_intYear = Year(date)

'maand en jaar komt van de querystring
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)

<%
'laatste dag van de maand
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
kolomnaamdata typeomschrijving
Event_idautonumberprimary key
Event_datedate/timede dag van de activiteit
Event_texttext(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) 'as string
   'functie die zorgt dat MS access
   'de dag waarde kan lezen


   fnDateReplace = "#" & intYear & "/" & intMonth & "/" & intDay & "#"
End Function
%>

<%
Function fnGetEvents(intMonth, intYear, intEndDay) 'as variant
   'functie die de events voor de maand
   'ophaalt uit de database


   Dim oCnn 'connectie object
   Dim oRs 'recordset object
   Dim strSQL 'sql
   Set oCnn = Server.CreateObject("ADODB.Connection")
   'open connectie naar database
   ' de Application("connection") is gedefinieerd in de
   ' global.asa onder de Application_onStart
   ' en heeft de volgende waarde:
   ' "Driver={Microsoft Access Driver (*.mdb)};" & _
   ' "Dbq=" & Server.MapPath("calendar.mdb") & _
   ' ";Uid=;Pwd=;"


   oCnn.Open Application("connection")

   'bouw sql statement
   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"

   'haal records op
   Set oRs = oCnn.Execute(strSQL)

   'heck of de recordset records bevat
   If (oRs.EOF) or (oRs.BOF) Then

      'lege recordset.. return 0
      fnGetEvents = 0
   Else
      'bevat records.. return array met records
      fnGetEvents = oRs.GetRows

   End If
   'jasje uit en deurtje dicht
   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) 'as string
   functie die de hyperlinks schrijft
   Dim strOutput 'retourstring
   Dim intPreviousMonth 'integer voor vorige maand
   Dim intNextMonth 'integer voor volgende maand
   Dim intPreviousyear 'integer voor vorig jaar
   Dim intNextYear 'integer voor volgend jaar

   'vorige maand is december van het vorig jaar
   If intMonth = 1 Then

      intPreviousMonth = 12
      intPreviousYear = intYear -1

         intNextMonth = 2
         intNextYear = intYear

   'volgende maand is januari van het volgend jaar
   ElseIf intMonth = 12 Then

      intPreviousMonth = 11
      intPreviousYear = intYear

      intNextMonth = 1
      intNextYear = intYear + 1

   ' 1 + 1 = 2 (ongeveer)
   Else
      intPreviousMonth = intMonth - 1
      IntPreviousYear = intYear

      intNextMonth = intMOnth + 1
      intNextYear = intYear
   End If

   'schrijf de tabel met de hyperlinks
   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

   'retourneer string
   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)
   'functie die de calendar schrijft

   Dim strOutput 'text output
   Dim iDag 'dagteller
   Dim iEvent 'event index
   Dim strHeader 'header en footer string

   'creer de header en footer string
   strHeader = fnPrevNextMonth(intMonth, intYear)

   'In dit voorbeeld is de database amerikaans;
   'voor vergelijkingen moet de locale op Amerikaans gezet worden,
   'om de datum te kunnen matchen


   Session.LCID = 1033

   'table header en de hyperlinks naar de nieuwe maanden
   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

   'voor elke dag…
   For iDag = 1 To intEndDay

      '..wordt de dag geschreven
      strOutput = strOutput & _       "<TR>" & vbCrLf & _

      "<TD valign=top>" & _
         iDag & "-" & intMonth & "-" & intYear & _
         "</TD>" & vbCrLf & _
      "<TD>"

      '..als er ueberhaupt een event is voor deze maand
      If IsArray(aEvents) Then

         '..voor elk event op die dag
         For iEvent = 0 To Ubound(aEvents, 2)
            If Cdate(aEvents(0, iEvents)) = _
               Cdate(DateSerial(intYear, intMonth, iDag)) Then
               '.. wordt de event geschreven
               strOutput = strOutput & _
                  aEvents(1, iEvents) & ";"

               End If 'aEvents(0,i) = Date

            Next 'iEvent
         End If 'isArray

            strOutput = strOutput & _
            " </TD>" & vbCrLf & _
            "</TR>" & vbCrLf

      '..eind van de tabel en weer de hyperlinks
      ;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:

<%
'schrijf de kalendar
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
   'verwerk
Else
   'schrijf <FORM>
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)
   'functie die de form schrijft
   'met en zonder error messages
   'met en zonder al eerder ingevulde velden


   Dim strOutput 'return waarde

   'hier komt de error message
   strOutput = _
   "<P>" & strMessage & "</P>" & vbCrLf

   'rest van de form
   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) ' as integer
   'functie die de invoer checkt
   'en wanneer correct in de database update


   Dim strSQL 'as string
   Dim oCnn 'as ADODB.Connection

   'na een fout doorgaan met uitvoering
   On Error Resume Next

   'event_date veld is leeg
   If Not Len(dtmEventDate) > 0 Then
      fnUpdateForm = 1
      Exit Function
End if

   'event_date veld is geen datum
   If isDate(dtmEventDate) = False Then
      fnUpdateForm = 2
      Exit Function
   End If

   'event_text veld is leeg
   If Not Len(strEventText) > 0 Then
      fnUpdateForm = 3
      Exit Function
   End If

   'ingevoerde datum is al verstreken
   If DateDiff("d", Date, Cdate(dtmEventDate)) < 0 Then
      fnUpdateForm = 4
      Exit Function
   End If

   'maak het SQL statement
   strSQL = "INSERT INTO event (event_date, event_text)" & _
   " values (" & _
   fnDateReplace(dtmEventDate) & "," & _
   fnQuoteReplace(strEventText) & ")"

   'openen database connectie
   Set oCnn = Server.CreateObject("ADODB.Connection")
   oCnn.Open Application("connection")
   'applicatie kan geen connectie naar de database leggen
      If err.Number <> 0
      fnUpdateForm = 5

      oCnn.Close
      Set oCnn = Nothing
      Exit Function
   End If

   'uitvoeren sql statement
   oCnn.Execute strSQL

   'retourneer fout nummer (0 is OK, anders is fout in update)
   fnUpdateForm = err.number

   'database connectie sluiten, object weggooien
   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 'as integer

'nederlandse datum notatie
Session.LCID = 1043

If Request.Form("event") = "go" Then

   'intReturnValue houd de returnwaarde van fnUpdateForm
   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

<< vorige | ^ naar boven | overzicht | volgende >>
copyright 2000-2007 ASPNL