codice:
<%
Option Explicit
Response.Buffer = True
'*** Declare the global variables ***
Dim strMonth ' Array string for months
Dim strday
Dim objDate ' Object for the Calendar Date
Dim intStartDay ' starting day of Calendar
'*** Set the Month string array and Date Object ***
strMonth = Array("Gennaio","Febbraio","Marzo","Aprile","Maggio","Giugno","Luglio","Agosto","Settembre","Ottobre","Novembre","Dicembre")
strday = Array ("Domenica", "Lunedi", "Martedi", "Mercoledi", "Giovedi", "Venerdi", "Sabato")
objDate = Date
'*** Set the Begining Day of the Calendar ***
'***1-Domenica, 2-Lunedi, 3-Martedi, 4-Mercoledi, 5-Giovedi, 6-Venerdi, 7-Sabato
intStartDay = 1
'*** Check for user input data ***
If GetRequest("date") <> "" Then
objDate = CDate(GetRequest("date"))
ElseIf GetRequest("month") <> "" And GetRequest("year") <> "" Then
objDate = CDate(GetRequest("month") & "/" & GetRequest("year"))
End If
If GetRequest("day") <> "" Then
intStartDay = CInt(GetRequest("day"))
End If
Function GetEvent(srcDate)
'*** Declare the function variables ***
Dim objFile ' object variable for event file
Dim strFile ' string for object text
Dim strLine ' holder for current line
Dim objEvent ' dict object for results
Dim strEvent ' array of event data
Dim item ' counter for object items
'*** Set the file and dict objects ***
Set objFile = CreateObject("Scripting.FileSystemObject")
Set strFile = objFile.OpenTextFile(Left(Server.MapPath(Request.ServerVariables("PATH_INFO")),InStrRev(Server.MapPath(Request.ServerVariables("PATH_INFO")),"\")) & "event.txt", 1, FALSE)
Set objEvent = CreateObject("Scripting.Dictionary")
'*** Loop through file and store events ***
Do While strFile.AtEndOfStream <> True
strLine = strFile.ReadLine
If Left(strLine,1) <> "'" Then
objEvent.Add strFile.Line, strLine
End If
Loop
strFile.Close
'*** Check for events on this date ***
For Each item In objEvent
strLine = Split(objEvent(item),VbTab)
If (strLine(1) = CStr(Month(srcDate)) Or strLine(1) = "Every") And (strLine(2) = CStr(Day(srcDate)) Or strLine(2) = "Every") And (strLine(0) = CStr(Year(srcDate)) Or strLine(0) = "Every") Then
strEvent = strEvent & strLine(3) & "
"
End If
Next
GetEvent = strEvent
End Function
Function GetRequest(name)
If Request.QueryString(name) <> "" Then
GetRequest = Request.QueryString(name)
Else
GetRequest = Request.Form(name)
End If
End Function
Function BuildCalendar(srcDate,size)
'*** Declare the function variables ***
Dim objFirstDOM ' first day of month
Dim objLastDOM ' last day of month
Dim intDayCount ' increment value for day of week
Dim intDateCount ' increment value for date of month
Dim objDateDisplay ' calendar display date
Dim strTable ' HTML string
Dim strEventText ' HTML string for event
Dim intHeight ' height for table cells
Dim intWidth ' width for table cells
Dim intTblBorder ' table border
Dim intTblCpad ' cellpadding
Dim intTblCspc ' cellspacing
Dim strBGColor1 ' background color option
Dim strTDColor1 ' table color option
Dim strTDColor2 ' table color option
Dim strTDColor3 ' table color option
Dim strTHColor1 ' table color option
Dim strTHColor2 ' table color option
Dim strFileName ' name of ASP file
Dim strTip ' tool tip message (IE only)
Dim i ' Loop counter
Dim intPrevMth ' previous month
Dim intNextMth ' next month
strBGColor1 = "#ffffff" ' color of table background
strTDColor1 = "#ffffff" ' color of default calendar cells
strTDColor2 = "#cccccc" ' color of event cells
strTDColor3 = "#ffffff" ' color of current day cell
strTHColor1 = "#ffffff" ' color of table header
strTHColor2 = "#ff0000" ' use this if you want 2 header cell colors
intTblBorder = 0 ' table border
intTblCpad = 0 ' cellpadding
intTblCspc = 0 ' cellspacing
strFileName = "index.asp" ' name of the webpage displaying the calendar
strTip = "clicca per i dettagli sull'evento" ' set to an empty string ("") to disable tool tip
'*** Set the size of the Calendar table ***
'Select Case size
' Case "small"
intHeight = 5
intWidth = 5
' Case "med"
' intHeight = 30
' intWidth = 30
' Case "large"
' intHeight = 80
' intWidth = 80
' Case "view"
' intHeight = 200
' intWidth = 200
' Case Else
' intHeight = 30
' intWidth = 30
' size = "med"
'End Select
'*** Set the First and Last Day's of the Month ***
objFirstDOM = CDate(Month(srcDate) & "/1/" & Year(srcDate))
objLastDOM = DateAdd("d", -1, DateAdd("m", 1, objFirstDOM))
intPrevMth = Month(srcDate)-1
If intPrevMth <= 0 Then
intPrevMth = 12
End If
intNextMth = Month(srcDate)+1
If intNextMth > 12 Then
intNextMth = 1
End If
'*** Set the Day, Date counters and Calendar Date ***
intDayCount = intStartDay
intDateCount = intStartDay
objDateDisplay = objFirstDOM
strTable = "<table bgcolor=" & strBGColor1 & " border=" & intTblBorder & " cellpadding=" & intTblCpad & " cellspacing=" & intTblCspc & ">" & VbCrLf &_
"<tr bgcolor=" & strTHColor1 & ">" & VbCrLf
'*** Build the Calendar Event View ***
If size = "view" Then
strEventText = GetEvent(GetRequest("date"))
strTable = strTable & "<th>Eventi di " & Day(srcDate) & UCase(strMonth(Month(srcDate)-1)) & Year(srcDate) & "</th>" & VbCrLf &_
"</tr>" & VbCrLf &_
"<tr>" & VbCrLf &_
"<td valign=top bgcolor=" & strTDColor2 & " height=" & intHeight & " width=" & intWidth & ">" & strEventText &_
"</td>" & VbCrLf
strEventText = ""
'*** Build the Calendar View ***
Else
'*** Build the Month header for the Calendar ***
strTable = strTable & "<th><a href=" & strFileName & "?date=" & intPrevMth & "/" & Year(srcDate) & "&day=" & intDayCount & "&size=" & size & ">"
If size = "small" Then
strTable = strTable & "<"
Else
strTable = strTable & Left(strMonth(intPrevMth-1),3)
End If
strTable = strTable & "</a></th>" & VbCrLf &_
"<th colspan=5>" & UCase(strMonth(Month(srcDate)-1)) & " - " & Year(srcDate) & "</th>" & VbCrLf &_
"<th><a href=" & strFileName & "?date=" & intNextMth & "/" & Year(srcDate) & "&day=" & intDayCount & "&size=" & size & ">"
If size = "small" Then
strTable = strTable & ">"
Else
strTable = strTable & Left(strMonth(intNextMth-1),3)
End If
strTable = strTable & "</a></th>" & VbCrLf &_
"</tr>" & VbCrLf &_
"<tr>" & VbCrLf
'*** Build the Day header for the Calendar ***
For i = 1 To 7
If intDayCount > 7 Then
intDayCount = 1
End If
strTable = strTable & "<th><a href=" & strFileName & "?date=" & Month(srcDate) & "/" & Year(srcDate) & "&day=" & intDayCount & "&size=" & size & ">"
If size = "small" Then
strTable = strTable & UCase(Left(WeekDayName(intDayCount,1),1)
)
Else
strTable = strTable & UCase(WeekDayName(intDayCount,1))
End If
strTable = strTable & "</a></th>" & VbCrLf
intDayCount = intDayCount + 1
Next
strTable = strTable & "</tr>" & VbCrLf
'*** Build the Rows for the Calendar ***
Do While DateDiff("d", objDateDisplay, objLastDOM) => 0
strTable = strTable & "<tr>" & VbCrLf
For i = 1 To 7
'*** Write blanks if the calendar start date is ***
'*** greater than the first day of the month ***
If intStartDay > WeekDay(objFirstDOM) Then
strTable = strTable & "<td height=" & intHeight & " width=" & intWidth & "> </td>" & VbCrLf
intStartDay = intStartDay + 1
If intStartDay > 7 Then
intStartDay = 1
End If
'*** Write blanks if the calendar start date is ***
'*** less than the first day of the month or if ***
'*** the date is past the end of the month ***
ElseIf (intDateCount < WeekDay(objDateDisplay)) Or (DateDiff("d", objDateDisplay, objLastDOM) < 0) Or (intStartDay < WeekDay(objFirstDOM)) Then
strTable = strTable & "<td height=" & intHeight & " width=" & intWidth & "> </td>" & VbCrLf
intStartDay = intStartDay + 1
If intStartDay > 7 Then
intStartDay = 1
End If
'*** Else write the date to the calendar table ***
Else
strEventText = GetEvent(objDateDisplay)
strTable = strTable & "<td valign=top bgcolor="
'*** highlight today's cell ***
If objDateDisplay = Date Then
strTable = strTable & strTDColor3
'*** highlight event cell ***
ElseIf strEventText <> "" Then
strTable = strTable & strTDColor2
Else
strTable = strTable & strTDColor1
End If
strTable = strTable & " height=" & intHeight & " width=" & intWidth & ">"
If size = "large" Then
strTable = strTable & Day(objDateDisplay) & "
"
If strEventText <> "" Then
strTable = strTable & strEventText
strEventText = ""
End If
Else
If strEventText <> "" Then
strTable = strTable & "" & Day(objDateDisplay) & ""
strEventText = ""
Else
strTable = strTable & Day(objDateDisplay)
End If
End If
strTable = strTable & "</td>" & VbCrLf
objDateDisplay = DateAdd("d", 1, objDateDisplay)
End If
intDateCount = intDateCount + 1
Next
strTable = strTable & "</tr>" & VbCrLf
Loop
End If
strTable = strTable & "</tr>" & VbCrLf &_
"</table>" & VbCrLf
BuildCalendar = strTable
End Function
Function BuildDropDown(srcDate,strType)
Dim strHTML
Dim i
Dim j
Dim objFirstDOM
Dim objLastDOM
'*** Set the First and Last Day's of the Month ***
objFirstDOM = CDate(Month(srcDate) & "/1/" & Year(srcDate))
objLastDOM = DateAdd("d", -1, DateAdd("m", 1, objFirstDOM))
strHTML = "<select name=" & LCase(strType) & ">" & VbCrLf
Select Case LCase(strType)
Case "month"
j = 12
Case "day"
j = 7
Case "year"
j = 5
Case "date"
j = Day(objLastDOM)
End Select
For i = 1 To j
Select Case LCase(strType)
Case "month"
strHTML = strHTML & "<option value=" & i
If GetRequest("month") = i Or Month(srcDate) = i Then
strHTML = strHTML & " selected"
End If
strHTML = strHTML & ">" & UCase(strMonth(i-1)) & VbCrLf
Case "day"
strHTML = strHTML & "<option value=" & i
If GetRequest("day") = i Or intStartDay = i Then
strHTML = strHTML & " selected"
End If
strHTML = strHTML & ">" & UCase(WeekDayName(i)) & VbCrLf
Case "year"
strHTML = strHTML & "<option value=" & Year(DateAdd("m", 12 * (i - 3), srcDate))
If GetRequest("year") = Year(DateAdd("m", 12 * (i - 3), srcDate)) Or Year(srcDate) = Year(DateAdd("m", 12 * (i - 3), srcDate)) Then
strHTML = strHTML & " selected"
End If
strHTML = strHTML & ">" & Year(DateAdd("m", 12 * (i - 3), srcDate)) & VbCrLf
Case "date"
strHTML = strHTML & "<option value=" & i
If GetRequest("date") = i Or Day(srcDate) = i Then
strHTML = strHTML & " selected"
End If
strHTML = strHTML & ">" & i & VbCrLf
End Select
Next
strHTML = strHTML & "</select>" & VbCrLf
BuildDropDown = strHTML
End Function
%>
Rispondi quotando
