<%@ Language=VBScript %>
<% Response.Buffer = TRUE %>
<%
' Script Name : aspWebCalendar
' File Name : date_picker.asp
' Version : 3.5
' Release Date : 12/20/2002
'
' Copyright (c) 2002 by Full Revolution, Inc., All Rights Reserved
%>
Select
<%
'******** Checking some things for the calendar pop ups **************************
If Request.Querystring("Form") <> "" Then
FormName = Request.Querystring("Form")
Session("FormName") = FormName
Else
FormName = Session("FormName")
End If
If Request.Querystring("Element") <> "" Then
ElementName = Request.Querystring("Element")
Session("ElementName") = ElementName
Else
ElementName = Session("ElementName")
End If
%>
<%
Dim MiniOutput
If Session("ConfigLoaded") <> "YES" then
Call LoadConfig
End If
User1 = Session("User1")
User2 = Session("User2")
User3 = Session("User3")
User4 = Session("User4")
User5 = Session("User5")
SiteTitle = Session("SiteTitle")
RequireLogin = Session("RequireLogin")
PopupBackColor = Session("PopupBackColor")
TimeZoneBias = Session("TimeZoneBias")
MiniSundayName = Session("MiniSundayName")
MiniMondayName = Session("MiniMondayName")
MiniTuesdayName = Session("MiniTuesdayName")
MiniWednesdayName = Session("MiniWednesdayName")
MiniThursdayName = Session("MiniThursdayName")
MiniFridayName = Session("MiniFridayName")
MiniSaturdayName = Session("MiniSaturdayName")
SkinFolder = Session("SkinFolder")
LanguageFolder = Session("LanguageFolder")
ScriptLCID = Session("ScriptLCID")
CountryCode = Session("CountryCode")
Session.LCID = ScriptLCID
Session("DateFormat") = CountryCode
PageHeader = "" & SiteTitle & ""
EventImagePath = "calendar/eventimages/"
FileDirectory = Server.MapPath("calendar/") & "\eventimages\"
SkinFolder = right(SkinFolder,len(SkinFolder)-9)
MonthSundayName = WeekDayName(1)
MonthMondayName = WeekDayName(2)
MonthTuesdayName = WeekDayName(3)
MonthWednesdayName = WeekDayName(4)
MonthThursdayName = WeekDayName(5)
MonthFridayName = WeekDayName(6)
MonthSaturdayName = WeekDayName(7)
'******* Pull In Config From DB ************************************
Sub LoadConfig
If UseSQLServer = "YES" then
SQL = "SELECT * FROM Cal_Config"
Else
SQL = "SELECT * FROM Cal_Config"
End If
Set RS=dbc.execute(SQL)
Session("User1") = RS("Cal_ConfigUserField1")
Session("User2") = RS("Cal_ConfigUserField2")
Session("User3") = RS("Cal_ConfigUserField3")
Session("User4") = RS("Cal_ConfigUserField4")
Session("User5") = RS("Cal_ConfigUserField5")
Session("SiteTitle") = RS("Cal_ConfigSiteTitle")
Session("RequireLogin") = RS("Cal_ConfigRequireLogin")
Session("PopupBackColor") = RS("Cal_ConfigPopupBackColor")
Session("TimeZoneBias") = RS("Cal_ConfigTimeZone")
Session("MiniSundayName") = RS("Cal_ConfigMiniSundayName")
Session("MiniMondayName") = RS("Cal_ConfigMiniMondayName")
Session("MiniTuesdayName") = RS("Cal_ConfigMiniTuesdayName")
Session("MiniWednesdayName") = RS("Cal_ConfigMiniWednesdayName")
Session("MiniThursdayName") = RS("Cal_ConfigMiniThursdayName")
Session("MiniFridayName") = RS("Cal_ConfigMiniFridayName")
Session("MiniSaturdayName") = RS("Cal_ConfigMiniSaturdayName")
Session("SkinFolder") = RS("Cal_ConfigSkinFolder")
Session("LanguageFolder") = RS("Cal_ConfigLanguageFolder")
Session("ScriptLCID") = RS("Cal_ConfigLCID")
Session("CountryCode") = RS("Cal_ConfigCountryCode")
Session("ConfigLoaded") = "YES"
RS.Close
Set RS=Nothing
End Sub
'********* Include the CSS from the current skin ********************************
If request.querystring("action") <> "eventlist" AND request.querystring("action") <> "embedmini" then
SkinFile= SkinFolder & "calendar.css"
Call ReadSkinFile(SkinFile)
End If
SUB ReadSkinFile(FileToRead)
SkinFile=server.mappath(FileToRead)
Set fs = CreateObject("Scripting.FileSystemObject")
Set thisfile = fs.OpenTextFile(Skinfile, 1, False)
tempSTR=thisfile.readall
response.write tempSTR
thisfile.Close
set thisfile=nothing
set fs=nothing
END SUB
If request.querystring("date") = "" then
theDate = Date()
Else
theDate = cDate(request.querystring("date"))
End If
Call DrawMiniCalendar(theDate)
'*********************************************************************************
'******** Draw Mini Calendar *****************************************************
'*********************************************************************************
Sub DrawMiniCalendar(theDate)
Dim ThisMonthsFirstDay
Dim NextMonthsFirstDay
Dim ThisMonthsLastDay
Dim LastMonthsLastDay
Dim StartDate
Dim Counter
PreviousLink = DateAdd("m", -1, theDate)
NextLink = DateAdd("m", 1, theDate)
PreviousYear = DateAdd("yyyy", -1, theDate)
NextYear = DateAdd("yyyy", 1, theDate)
'------- Setup some information about the month -----------------
If Session("DateFormat") = "US" then
ThisMonthsFirstDay = cDate(Month(theDate) & "/1/" & Year(theDate))
Else
ThisMonthsFirstDay = cDate("1/" & Month(theDate) & "/" & Year(theDate))
End If
NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay)
ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay)
LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay)
StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay)
'------- Containter for whole mini calendar ----------------------
response.write ""
response.write ""
'------- Draw the month heading ----------------------------------
response.write ""
response.write ""
response.write "![](" & SkinFolder & "mini_leftarrow.gif) ![](" & SkinFolder & "mini_leftarrow_2.gif) | "
response.write "" & MonthName(Month(theDate)) & " " & Year(theDate) & " | "
response.write "![](" & SkinFolder & "mini_rightarrow_2.gif) ![](" & SkinFolder & "mini_rightarrow.gif) | "
response.write " "
response.write " "
'------- Draw the beginning of the calendar ----------------------
response.write ""
'-------- Main Calendar Table -------------------------------------
response.write ""
response.write ""
'-------- If the first day is not sunday --------------------------
If weekday(ThisMonthsFirstDay) > 1 then
For Counter = day(StartDate) to day(LastMonthsLastDay)
Call DrawOtherMiniDay (Counter)
Next
End if
'-------- Draw normal days after Saturday, start a new row --------
For Counter = 1 to day(ThisMonthsLastDay)
If Session("DateFormat") = "US" then
DateToUse = cDate(Month(theDate) & "/" & Counter & "/" & Year(theDate))
Else
DateToUse = cDate(Counter & "/" & Month(theDate) & "/" & Year(theDate))
End If
Call DrawMiniNormalDay (Counter, DateToUse)
If weekday(DateToUse) = 7 then
response.write " "
If Counter <> day(ThisMonthsLastDay) then
response.write ""
End If
End if
Next
'-------- If last day is not saturday -----------------------------
If weekday(ThisMonthsLastDay) < 7 then
For Counter = 1 to 7 - weekday(ThisMonthsLastDay)
DrawOtherMiniDay (Counter)
Next
End if
'-------- Draw the last row of the calendar -----------------------
response.write " "
response.write " "
'-------- End of Container ----------------------------------------
response.write " |
"
End Sub
Sub DrawMiniNormalDay(DayNumber, theDate) '----------------------------------- Draw a Normal Day
If Session("DateFormat") = "US" then
DateToUse = Month(theDate) & "/" & DayNumber & "/" & Year(theDate)
Else
DateToUse = DayNumber & "/" & Month(theDate) & "/" & Year(theDate)
End If
If Date() = cDate(DateToUse) then
MonthCalDayClass = "TableMiniDayCellToday"
Else
MonthCalDayClass = "TableMiniDayCell"
End If
IsThereAnEvent = CheckForEvent(DateToUse)
If IsThereAnEvent = "YES" then
MonthCalDayClass = "TableMiniDayCellWithEvent"
End If
response.write " onMouseover="this.style.backgroundColor='#AAAAFF';"
onMouseout="this.style.backgroundColor='<%=TableMiniDayCell%>';"
onClick="calpopulate('<%=DateToUse%>');">
<%
response.write ""
response.write DayNumber
response.write ""
response.write " | "
End Sub
Sub DrawOtherMiniDay(DayNumber) '--------------------------------------- Draw Other Day
response.write ""
response.write " | "
End Sub
'******* Should We Show The Event ************************************************
Function IsEventVisible(EventGroup)
EventsVisible = Split(Session("Cal_FilterGroups"))
For I = 0 to Ubound(EventsVisible)
If cint(EventGroup) = cint(EventsVisible(I)) then
Return = "TRUE"
End If
Next
IsEventVisible = Return
End Function
'******* Check Day For Event *****************************************************
Function CheckForEvent(DateToUse)
If Session("Cal_User_ID") = "" then
GroupArray = GetGroupArray("Cal_Group_Type", "PUBLIC")
If UseSQLServer = "YES" then
SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= '" & FormatDateFix(DateToUse) & "' AND Cal_EventEndDate >= '" & FormatDateFix(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime"
Else
SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& GroupArray &") AND Cal_EventStartDate <= #" & FormatDateFix(DateToUse) & "# AND Cal_EventEndDate >= #" & FormatDateFix(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime"
End If
Set RS=dbc.execute(SQL)
Else
UserGroupArray1 = Session("Cal_User_NormalGroups")
UserGroupArray2 = Session("Cal_User_AdminGroups")
UserGroupArray = Session("Cal_User_AllGroups")
If UseSQLServer = "YES" then
SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= '" & FormatDateFix(DateToUse) & "' AND Cal_EventEndDate >= '" & FormatDateFix(DateToUse) & "' AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime"
Else
SQL = "SELECT * FROM Cal_Events WHERE Cal_EventGroupID IN("& UserGroupArray &") AND Cal_EventStartDate <= #" & FormatDateFix(DateToUse) & "# AND Cal_EventEndDate >= #" & FormatDateFix(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime"
End If
Set RS=dbc.execute(SQL)
End If
Do While NOT RS.EOF
If RS("Cal_EventGroupID") <> 2 OR RS("Cal_EventGroupID") = 2 AND RS("Cal_EventUserID") = Session("Cal_User_ID") then
If IsEventVisible(RS("Cal_EventGroupID")) = "TRUE" then
Return = "YES"
Exit Do
End If
End If
Return = "NO"
RS.MoveNext
Loop
CheckForEvent = Return
End Function
'******* Format Date Function for European Fix ***********************************
Function FormatDateFix(DateValue)
DateValueMonth = Month(DateValue)
DateValueDay = Day(DateValue)
DateValueYear = Year(DateValue)
DateValueFix = DateValueMonth & "/" & DateValueDay & "/" & DateValueYear
FormatDateFix = DateValueFix
End Function
%>