" & SiteTitle & ""
MonthSundayName = WeekDayName(1)
MonthMondayName = WeekDayName(2)
MonthTuesdayName = WeekDayName(3)
MonthWednesdayName = WeekDayName(4)
MonthThursdayName = WeekDayName(5)
MonthFridayName = WeekDayName(6)
MonthSaturdayName = WeekDayName(7)
'******* Added for 3.5 release ************************************
UseEmailFunctions = "YES"
UseInviteFunction = "NO"
StartDaysAtEight = "YES"
ServerAddress = request.ServerVariables("HTTP_HOST")
CalendarURL2 = request.ServerVariables("URL")
FullURL = "http://" & ServerAddress & left(CalendarURL2, len(CalendarURL2) - 19) & "/calendar.asp"
PathToCalendar = "http://" & ServerAddress & left(CalendarURL2, len(CalendarURL2) - 12)
ShowRollInfo = "YES"
TimeFormatToUse = "12" 'Set to 12 or 24
'******* 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"
Session("EmailComponent") = RS("Cal_ConfigEmailComponent")
Session("EmailHost") = RS("Cal_ConfigEmailHost")
Session("SendFromEmailAddress") = RS("Cal_ConfigSendFromAddress")
RS.Close
Set RS=Nothing
End Sub
'****** Some Java Functions and Page Header *************************************************
If request.querystring("action") <> "eventlist" AND request.querystring("action") <> "embedmini" and request.querystring("action") <> "vcalexport" then
response.write PageHeader
%>
<%
End If
'********* Include the CSS from the current skin ********************************
If request.querystring("action") <> "eventlist" AND request.querystring("action") <> "embedmini" and request.querystring("action") <> "vcalexport" then
SkinFile= SkinFolder & "calendar.css"
Call ReadSkinFile(SkinFile)
SUB ReadSkinFile(FileToRead)
SkinFile=server.mappath(FileToRead)
Set fs = CreateObject("Scripting.FileSystemObject")
Set thisfile = fs.OpenTextFile(Skinfile, 1, False)
tempSTR=thisfile.readall
response.write replace(tempSTR, "$$SKINFOLDER", SkinFolder)
thisfile.Close
set thisfile=nothing
set fs=nothing
END SUB
%>
<%
End If
'******** Find out what we should be doing **************************************
'----------- Figure out the current view information -----------------------------
'If request.querystring("view") <> "" and request.querystring("view") <> "0" then
' Session("Cal_CurrentView") = cint(request.querystring("view"))
' SQL = "SELECT * FROM Cal_Views WHERE Cal_ViewID = " & request.querystring("view")
' Set RS=dbc.execute(SQL)
' CalendarType = RS("Cal_ViewCalType")
' Session("Cal_ShowSideBar") = RS("Cal_ViewSideBar")
' Session("Cal_FilterGroups") = RS("Cal_ViewGroups")
' RS.Close
' Set RS=Nothing
'End If
If request.querystring("expandlegend") <> "" then
Session("Cal_ExpandLegend") = request.querystring("expandlegend")
End If
If request.querystring("expandfilter") <> "" then
Session("Cal_ExpandFilter") = request.querystring("expandfilter")
End If
If request.querystring("expandlinks") <> "" then
Session("Cal_ExpandLinks") = request.querystring("expandlinks")
End If
If request.querystring("view") = "" or request.querystring("view") = "0" and request.querystring("caltype") = "" then
CalendarType = "month"
Session("Cal_ShowSideBar") = "YES"
End If
If request.querystring("date") = "" then
theDate = Date()
Else
theDate = cDate(request.querystring("date"))
End If
If request.querystring("sidebar") <> "" then
Session("Cal_ShowSideBar") = request.querystring("sidebar")
End If
If Session("Cal_User_ID") = "" then
Session("Cal_User_AllGroups") = GetGroupArray("Cal_Group_Type", "PUBLIC")
Session("Cal_User_PublicGroups") = Session("Cal_User_AllGroups")
If Session("Cal_FilterGroups") = "" then
Session("Cal_FilterGroups") = Session("Cal_User_PublicGroups")
End If
End If
If request.querystring("view") = "0" then
Session("Cal_CurrentView") = ""
Session("Cal_FilterGroups") = Session("Cal_User_AllGroups")
End If
If request.querystring("filter") <> "" then
Session("Cal_FilterGroups") = request.querystring("filter")
End If
ScriptAction = request.querystring("action")
If RequireLogin = "YES" and Session("Cal_User_ID") = "" and request.querystring("action") <> "login" then
If request.querystring("action") <> "embedmini" or request.querystring("action") <> "eventlist" then
Call MustLogin
End If
End If
If request.querystring("caltype") <> "" then
CalendarType = request.querystring("caltype")
End If
SELECT CASE ScriptAction
CASE ""
If RequireLogin = "YES" and Session("Cal_User_ID") <> "" OR RequireLogin = "NO" then
If CalendarType = "month" or request.querystring("caltype") = "month" then
CalendarType = "month"
Call WriteHeaderOrFooter("cal_header.asp")
Call DrawHeaderBar
Call DrawContainerStart
Call DrawMonthCalendar(theDate)
Call DrawContainerEnd
Call WriteHeaderOrFooter("cal_footer.asp")
End If
If request.querystring("caltype") = "day" or CalendarType = "day" then
CalendarType = "day"
Call WriteHeaderOrFooter("cal_header.asp")
Call DrawHeaderBar
Call DrawContainerStart
Call DrawDayCalendar(theDate)
Call DrawContainerEnd
Call WriteHeaderOrFooter("cal_footer.asp")
End If
If request.querystring("caltype") = "mini" then
CalendarType = "mini"
Call DrawMiniCalendar(theDate)
End If
If request.querystring("caltype") = "week" or CalendarType = "week" then
CalendarType = "week"
Call WriteHeaderOrFooter("cal_header.asp")
Call DrawHeaderBar
Call DrawContainerStart
Call DrawWeekCalendar(theDate)
Call DrawContainerEnd
Call WriteHeaderOrFooter("cal_footer.asp")
End If
If request.querystring("caltype") = "year" or CalendarType = "year" then
CalendarType = "year"
Call WriteHeaderOrFooter("cal_header.asp")
Call DrawHeaderBar
Call DrawContainerStart
Call DrawYearCalendar(theDate)
Call DrawContainerEnd
Call WriteHeaderOrFooter("cal_footer.asp")
End If
If request.querystring("caltype") = "listing" or CalendarType = "listing" then
CalendarType = "listing"
Call WriteHeaderOrFooter("cal_header.asp")
Call DrawHeaderBar
Call DrawContainerStart
Call DrawEventListView(theDate)
Call DrawContainerEnd
Call WriteHeaderOrFooter("cal_footer.asp")
End If
End If
CASE "summary"
Sum_Message = request.querystring("message")
Sum_LinkType = request.querystring("linktype")
Sum_From = request.querystring("from")
Call DrawSummary(Sum_Message, Sum_LinkType, Sum_From)
CASE "login"
Call DrawLoginPage
CASE "processlogin"
Call ProcessLogin
Case "logoff"
Call Logoff
CASE "viewoptions"
Call ViewOptions
CASE "eventdetail"
Call DrawEventPopup
CASE "eventlist"
Call DrawEventListing(request.querystring("date"), request.querystring("range"), request.querystring("type"))
CASE "embedmini"
Call DrawMiniCalendar(theDate)
CASE "processinvites"
Call ProcessInvites
CASE "processfilter"
Call ProcessFilter
CASE "vcalexport"
Call ExportVCal(theDate, request.querystring("caltype"))
CASE "emailuser"
Call SendUserEmail
CASE "emailuserprocess"
SendFromEmailAddress = Session("Cal_User_EmailAddress")
Call SendUserEmailProcess
CASE ELSE
END SELECT
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'************************* Routines Below Here Only ******************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'******** Draw Container Table Start *********************************************
'*********************************************************************************
Sub DrawContainerStart
If Session("Cal_ShowSideBar") = "YES" then
response.write "
"
response.write "
"
response.write "
"
Call DrawSideBar
response.write "
"
response.write "
"
Else
response.write "
"
response.write "
"
response.write "
"
End If
End Sub
'*********************************************************************************
'******** Draw Container Table End ***********************************************
'*********************************************************************************
Sub DrawContainerEnd
response.write "
"
response.write "
"
response.write "
"
End Sub
'*********************************************************************************
'******** Draw Side Bar **********************************************************
'*********************************************************************************
Sub DrawSideBar
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
If Session("Cal_ExpandFilter") = "NO" then
response.write " "
Else
response.write " "
End If
response.write Sub1Var24
response.write "
"
response.write "
"
If Session("Cal_ExpandFilter") <> "NO" then
'Call DrawViews
Call DrawFilter
End If
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
If Session("Cal_ExpandLegend") = "NO" then
response.write " "
Else
response.write " "
End If
response.write Sub1Var19
response.write "
"
response.write "
"
If Session("Cal_ExpandLegend") <> "NO" then
Call DrawLegend
End If
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
If Session("Cal_ExpandLinks") = "NO" then
response.write " "
Else
response.write " "
End If
response.write Sub1Var29
response.write "
"
response.write "
"
If Session("Cal_ExpandLinks") <> "NO" then
Call DrawQuickLinks
End If
response.write "
"
response.write "
"
response.write "
"
End Sub
'*********************************************************************************
'******** Draw Views *************************************************************
'*********************************************************************************
Sub DrawViews
response.write "
"
response.write ""
SQL = "SELECT * FROM Cal_Views WHERE Cal_ViewUserID = 0 ORDER BY Cal_ViewName"
Set RS=dbc.execute(SQL)
If RS.EOF then
response.write Sub1Var27
End If
response.write " onclick="window.location.href='calendar.asp?view=0'"<%
response.write "> " & Sub1Var32 & " "
Do While NOT RS.EOF
response.write " onclick="window.location.href='calendar.asp?view=<%=RS("Cal_ViewID")%>'"<%
response.write "> " & RS("Cal_ViewName") & ""
response.write " "
RS.MoveNext
Loop
RS.Close
Set RS=Nothing
response.write "
"
response.write "
"
response.write "
"
If Session("Cal_User_ID") <> "" then
response.write "
"
response.write ""
SQL = "SELECT * FROM Cal_Views WHERE Cal_ViewUserID = " & Session("Cal_User_ID") & " ORDER BY Cal_ViewName"
Set RS=dbc.execute(SQL)
If RS.EOF then
response.write Sub1Var28
End If
Do While NOT RS.EOF
response.write " " & RS("Cal_ViewName") & " "
RS.MoveNext
Loop
RS.Close
Set RS=Nothing
response.write "
"
response.write "
"
response.write "
"
End If
End Sub
'*********************************************************************************
'******** Draw Quick Links *******************************************************
'*********************************************************************************
Sub DrawQuickLinks
response.write "
"
End Sub
'*********************************************************************************
'******** Draw Legend ************************************************************
'*********************************************************************************
Sub DrawLegend
LegendColCounter = 1
FilterGroups = Session("Cal_User_AllGroups")
response.write "
"
If UseSQLServer = "YES" then
SQL = "SELECT * FROM Cal_Group WHERE Cal_Group_ID IN("& FilterGroups &") ORDER BY Cal_Group_Name"
Else
SQL = "SELECT * FROM Cal_Group WHERE Cal_Group_ID IN("& FilterGroups &") ORDER BY Cal_Group_Name"
End If
Set RS=dbc.execute(SQL)
Do While NOT RS.EOF
If RS("Cal_Group_ID") <> 2 then
GroupColor = RS("Cal_Group_Color")
GroupName = RS("Cal_Group_Name")
Else
GroupColor = Session("Cal_User_EventColor")
GroupName = RS("Cal_Group_Name")
End If
If LegendColCounter = 1 then
response.write "
<%
End If
If Session("Cal_ShowSideBar") <> "YES" then
response.write "
"
Else
response.write "
"
End If
If Session("Cal_User_ID") = "" then
%>
<%
End If
response.write "
"
If Session("Cal_User_ID") <> "" Then
If Session("Cal_User_RightsLevel") = 1 then
response.write "
"
%>
<%
%>
<%
%>
<%
%>
<%
%>
<%
response.write "
"
End If
response.write "
"
End If
response.write "
"
End Sub
'*********************************************************************************
'******** Draw Day View ********************************************************
'*********************************************************************************
Sub DrawDayCalendar(theDate)
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)
response.write "
"
response.write "
"
'response.write "
"
'response.write "
"
'response.write "
"
'response.write "All Day"
'response.write "
"
'response.write "
"
'response.write "
"
'response.write "
"
'response.write "
"
'response.write "
"
'response.write "
"
'response.write "
"
'response.write "
"
If BrowserType <> "OTHER" then
response.write "
"
Else
response.write "
"
End If
If TimeFormatToUse = "12" then
response.write "
"
Call WriteAgendaRow("12", "am")
For I = 1 to 11
Call WriteAgendaRow(I,"00")
Next
Call WriteAgendaRow("12", "pm")
For I = 1 to 11
Call WriteAgendaRow(I, "OO")
Next
response.write "
"
Call WriteAgendaRow("00", "00")
For I = 1 to 9
Call WriteAgendaRow("0" & I,"00")
Next
For I = 10 to 23
Call WriteAgendaRow(I,"00")
Next
response.write "
"
Call WriteEvent(theDate, "DAY")
End If
response.write "
"
End Sub
'------ Write Agenda Row --------------------------------------------------------
Sub WriteAgendaRow(TimeToWrite1, TimeToWrite2)
response.write "
"
response.write "
"
If TimeToWrite1 = 8 then
response.write ""
End If
response.write "" & TimeToWrite1 & " " & TimeToWrite2 & ""
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
End Sub
'*********************************************************************************
'******** Draw Week View *********************************************************
'*********************************************************************************
Sub DrawWeekCalendar(theDate)
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)
WeekDayTitleName = Weekday(theDate, 2)
HeaderInfo = Sub3Var1 & DateAdd("w", 1-WeekDayTitleName, theDate)
DateToSend = DateAdd("w", 1-WeekDayTitleName, theDate)
DayNameNumber = Weekday(theDate, 2)
response.write "
"
End Sub
'*********************************************************************************
'******** Draw Month View ********************************************************
'*********************************************************************************
Sub DrawMonthCalendar(theDate)
Dim ThisMonthsFirstDay
Dim NextMonthsFirstDay
Dim ThisMonthsLastDay
Dim LastMonthsLastDay
Dim StartDate
Dim Counter
'------- 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)
'------- Draw the beginning of the calendar ----------------------
response.write "
"
response.write "
"
response.write "
" & MonthSundayName & "
"
response.write "
" & MonthMondayName & "
"
response.write "
" & MonthTuesdayName & "
"
response.write "
" & MonthWednesdayName & "
"
response.write "
" & MonthThursdayName & "
"
response.write "
" & MonthFridayName & "
"
response.write "
" & MonthSaturdayName & "
"
response.write "
"
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 DrawOtherMonthDay (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
DrawMonthNormalDay (Counter)
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)
DrawOtherMonthDay (Counter)
Next
End if
'-------- Draw the last row of the calendar -----------------------
response.write "
"
response.write "
"
End Sub
Sub DrawMonthNormalDay(DayNumber) '----------------------------------- 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 = "TableMonthDayCellToday"
Else
MonthCalDayClass = "TableMonthDayCell"
End If
response.write "
"
End Sub
'*********************************************************************************
'******** Draw Mini Calendar *****************************************************
'*********************************************************************************
Sub DrawMiniCalendar(theDate)
Dim ThisMonthsFirstDay
Dim NextMonthsFirstDay
Dim ThisMonthsLastDay
Dim LastMonthsLastDay
Dim StartDate
Dim Counter
'------- 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 ----------------------
MiniOutput = "
"
'-------- 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
MiniOutput = MiniOutput & "
"
If Counter <> day(ThisMonthsLastDay) then
MiniOutput = MiniOutput & "
"
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 -----------------------
MiniOutput = MiniOutput & "
"
MiniOutput = MiniOutput & "
"
'-------- End of Container ----------------------------------------
MiniOutput = MiniOutput & "
"
If request.querystring("action") <> "embedmini" then
response.write MiniOutput
Else
MiniOutput = Replace(MiniOutput, "'", "\'")
%>
function ShowMiniCal() {
var tmpStr;
tmpStr = ('<%=MiniOutput%>');
document.write(tmpStr);
}
<%
End If
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
MiniOutput = MiniOutput & "
"
End Sub
'*********************************************************************************
'******** Write Event Month ******************************************************
'*********************************************************************************
Sub WriteEvent(DateToUse, CalViewType)
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=Server.CreateObject("adodb.Recordset")
RS.Open SQL, dbc, adopenstatic
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=Server.CreateObject("adodb.Recordset")
RS.Open SQL, dbc, adopenstatic
End If
If CalViewType <> "DAY" then
Do While NOT RS.EOF
If RS("Cal_EventGroupID") = 2 then
If UseSQLServer = "YES" then
SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID")
Else
SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID")
End If
Set RSc=dbc.execute(SQLc)
EventColor = RSc("Cal_User_EventColor")
RSc.Close
Set RSc=Nothing
Else
If UseSQLServer = "YES" then
SQLc = "SELECT Cal_Group_Color, Cal_Group_Icon FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID")
Else
SQLc = "SELECT Cal_Group_Color, Cal_Group_Icon FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID")
End If
Set RSc=dbc.execute(SQLc)
EventColor = RSc("Cal_Group_Color")
GroupIcon = RSc("Cal_Group_Icon")
RSc.Close
Set RSc=Nothing
End If
If RS("Cal_EventGroupID") <> 2 OR RS("Cal_EventGroupID") = 2 AND RS("Cal_EventUserID") = Session("Cal_User_ID") then
IsVisible = IsEventVisible(RS("Cal_EventGroupID"))
If IsVisible = "TRUE" then
If RS("Cal_EventAllDay") <> "TRUE" then
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
If Session("DateFormat") = "US" then
response.write FormatTime(RS("Cal_EventStartTime"))
Else
TempTime = FormatTime(RS("Cal_EventStartTime"))
response.write FormatTimeFix(TempTime, "MONTH")
End If
response.write "
"
End If
End If
End If
RS.MoveNext
Loop
Else
If RS.RecordCount >= 1 then
RS.MoveFirst
EventCounter = 0
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
IsVisible = IsEventVisible(RS("Cal_EventGroupID"))
If IsVisible = "TRUE" then
If RS("Cal_EventAllDay") <> "TRUE" then
If EventCounter > 0 then
If RS.RecordCount <= 4 then
AddtoLeft = 110
Else
AddtoLeft = (800 / RS.RecordCount) + 5
End If
EventLeft = EventLeft + AddtoLeft
Else
EventLeft = 80
End If
If RS.RecordCount <= 4 then
EventWidth = 100
Else
EventWidth = (800 / RS.RecordCount)
End If
If Session("DateFormat") = "US" then
StartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3)
EndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3)
Else
StartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3)
EndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3)
StartTime = FormatTimeFix(StartTime, "")
EndTime = FormatTimeFix(EndTime, "")
End If
EventHeight = DateDiff("n", StartTime, EndTime)
EventTop = DateDiff("n", "12:00a", StartTime)
'EventHeight = ((EventHeight * 19) * 2) / 60 + 1
'EventTop = (((EventTop * 19) * 2)) / 60
EventHeight = ((EventHeight * 29) * 2) / 60 + 1
EventTop = (((EventTop * 29) * 2)) / 60
If RS("Cal_EventGroupID") = 2 then
If UseSQLServer = "YES" then
SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID")
Else
SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID")
End If
Set RSc=dbc.execute(SQLc)
EventColor = RSc("Cal_User_EventColor")
RSc.Close
Set RSc=Nothing
Else
If UseSQLServer = "YES" then
SQLc = "SELECT Cal_Group_Color FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID")
Else
SQLc = "SELECT Cal_Group_Color FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID")
End If
Set RSc=dbc.execute(SQLc)
EventColor = RSc("Cal_Group_Color")
RSc.Close
Set RSc=Nothing
End If
response.write "
"
EventCounter = EventCounter + 1
End If
End If
End If
RS.MoveNext
Loop
End If
End Sub
'*********************************************************************************
'******** Write Event Listing ****************************************************
'*********************************************************************************
Sub DrawEventListing(DateToUse, Range, CalType)
If DateToUse = "" then
DateToUse = Date()
Else
DateToUse = cDate(DateToUse)
End If
If Range = "" then
NumOfTimes = 1
Else
If Range = "TODAY" then
NumOfTimes = 1
End If
If Range = "WEEK" then
NumOfTimes = 7
End If
If Range = "MONTH" then
NumOfTimes = 31
End If
End If
For I = 1 to NumOfTimes
If I > 1 then
DateToUse = DateAdd("d", DateToUse, 1)
End If
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 then
If UseSQLServer = "YES" then
SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID")
Else
SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID")
End If
Set RSc=dbc.execute(SQLc)
EventColor = RSc("Cal_User_EventColor")
RSc.Close
Set RSc=Nothing
Else
If UseSQLServer = "YES" then
SQLc = "SELECT Cal_Group_Color FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID")
Else
SQLc = "SELECT Cal_Group_Color FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID")
End If
Set RSc=dbc.execute(SQLc)
EventColor = RSc("Cal_Group_Color")
RSc.Close
Set RSc=Nothing
End If
If RS("Cal_EventGroupID") <> 2 OR RS("Cal_EventGroupID") = 2 AND RS("Cal_EventUserID") = Session("Cal_User_ID") then
IsVisible = IsEventVisible(RS("Cal_EventGroupID"))
If IsVisible = "TRUE" then
FoundEvent = "YES"
TempOutput = "
"
If CalType = "inside" then
response.write TempOutput
End If
FinalOutput = FinalOutput & TempOutput
End If
End If
RS.MoveNext
Loop
Next
If FoundEvent <> "YES" then
FinalOutput = "" & Sub1Var33 & ""
If CalType = "inside" then
response.write FinalOutput
End If
End If
FinalOutput = Replace(FinalOutput, "'", "\'")
If CalType = "outside" then
%>
function ShowListing() {
var tmpStr;
tmpStr = ('<%=FinalOutput%>');
document.write(tmpStr);
}
<%
End If
End Sub
'*********************************************************************************
'******** Draw Event Popup *******************************************************
'*********************************************************************************
Sub DrawEventPopup
If UseSQLServer = "YES" then
SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventID")
Else
SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventID")
End If
Set RS=dbc.execute(SQL)
If NOT RS.EOF then
response.write "
"
response.write "
"
response.write "
"
response.write "
" & Sub10Var1 & " " & Sub10Var2 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "" & Sub10Var3 & ":
"
response.write "
"
%><%=RS("Cal_EventTitle")%><%
If RS("Cal_EventRecurrID") <> "" then
response.write " "
End If
If RS("Cal_EventLink") <> "" then
response.write ""
response.write ""
End If
response.write "
"
If RS("Cal_EventStartDate") <> RS("Cal_EventEndDate") then
response.write "" & RS("Cal_EventStartDate") & " - " & RS("Cal_EventEndDate") & ""
Else
response.write "" & RS("Cal_EventStartDate") & ""
End If
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "" & Sub10Var8 & ":
"
response.write "
"
If RS("Cal_EventAllDay") <> "TRUE" then
If Session("DateFormat") = "US" then
response.write "" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & ""
Else
TempStartTime = FormatDateTime(CDate(RS("Cal_EventStartTime")),3)
TempStartTime = FormatTimeFix(TempStartTime,"")
TempEndTime = FormatDateTime(CDate(RS("Cal_EventEndTime")),3)
TempEndTime = FormatTimeFix(TempEndTime,"")
response.write "" & TempStartTime & " - " & TempEndTime & ""
End If
Else
response.write "" & Sub10Var9 & ""
End If
response.write "
"
response.write "
"
If RS("Cal_EventGroupID") = 2 then
If UseSQLServer = "YES" then
SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID")
Else
SQLc = "SELECT Cal_User_EventColor FROM Cal_User WHERE Cal_User_ID = " & Session("Cal_User_ID")
End If
Set RSc=dbc.execute(SQLc)
EventColor = RSc("Cal_User_EventColor")
EventGroup = "Personal"
RSc.Close
Set RSc=Nothing
Else
If UseSQLServer = "YES" then
SQLc = "SELECT Cal_Group_Color, Cal_Group_Name FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID")
Else
SQLc = "SELECT Cal_Group_Color, Cal_Group_Name FROM Cal_Group WHERE Cal_Group_ID = " & RS("Cal_EventGroupID")
End If
Set RSc=dbc.execute(SQLc)
EventColor = RSc("Cal_Group_Color")
EventGroup = RSc("Cal_Group_Name")
RSc.Close
Set RSc=Nothing
End If
response.write "
"
End If
RS.Close
Set RS=Nothing
End Sub
'*********************************************************************************
'******** Draw Login Page ********************************************************
'*********************************************************************************
Sub DrawLoginPage
response.write "
"
response.write "
"
response.write "
"
response.write "
" & Sub11Var1 & " " & Sub11Var2 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
response.write "
"
response.write "
"
response.write "
"
End Sub
'*********************************************************************************
'******** Process The Login ******************************************************
'*********************************************************************************
Sub ProcessLogin
If UseSQLServer = "YES" then
SQL = "SELECT * FROM Cal_User WHERE Cal_User_UserName = '" & request.form("txtUserName") & "'"
Else
SQL = "SELECT * FROM Cal_User WHERE Cal_User_UserName = '" & request.form("txtUserName") & "'"
End If
Set RS=dbc.execute(SQL)
If NOT RS.EOF then
If RS("Cal_User_Password") = request.form("txtPassword") then
Session("Cal_User_ID") = RS("Cal_User_ID")
Session("Cal_User_UserName") = RS("Cal_User_UserName")
Session("Cal_User_FirstName") = RS("Cal_User_FirstName")
Session("Cal_User_LastName") = RS("Cal_User_LastName")
Session("Cal_User_EmailAddress") = RS("Cal_User_EmailAddress")
Session("Cal_User_RightsLevel") = RS("Cal_User_RightsLevel")
Session("Cal_User_RequireApproval") = RS("Cal_User_RequireApproval")
Session("Cal_User_EventColor") = RS("Cal_User_EventColor")
Session("Cal_User_NormalGroups") = GetUserGroupArray("NORMAL")
Session("Cal_User_AdminGroups") = GetUserGroupArray("ADMIN")
Session("Cal_User_AllGroups") = Session("Cal_User_NormalGroups") & ", " & Session("Cal_User_PublicGroups") & "," & Session("Cal_User_AdminGroups") & ", 2"
If RS("Cal_User_LastFilter") <> "" then
Session("Cal_FilterGroups") = RS("Cal_User_LastFilter")
Else
Session("Cal_FilterGroups") = Session("Cal_User_AllGroups")
End If
response.redirect "calendar.asp?action=summary&message=" & Sub12Var1 & "&linktype=window&from=loginscreen"
Else
response.redirect "calendar.asp?action=login&error=wrongpassword"
End If
Else
response.redirect "calendar.asp?action=login&error=nouser"
End If
End Sub
'*********************************************************************************
'******** Draw View Options Page *************************************************
'*********************************************************************************
Sub ViewOptions
response.write "
"
response.write "
"
response.write "
"
response.write "
" & Sub13Var1 & " " & Sub13Var2 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
response.write "
"
response.write "
"
response.write "
"
End Sub
'*********************************************************************************
'******** Process Logoff *********************************************************
'*********************************************************************************
Sub Logoff
Session.Abandon
response.redirect "calendar.asp"
End Sub
'*********************************************************************************
'******** Draw the Summary Page **************************************************
'*********************************************************************************
Sub DrawSummary(Sum_Message, Sum_LinkType, Sum_From)
SELECT CASE Sum_From
CASE "loginscreen"
TopIconImage = SkinFolder & "popup_head_login.gif"
TopMessage = Sub14Var1
TopMessage2 = " " & Sub14Var2 & ":"
CASE "filterview"
TopIconImage = SkinFolder & "popup_head_filter.gif"
TopMessage = Sub14Var3
TopMessage2 = " " & Sub14Var2
CASE "emailuser"
TopIconImage = SkinFolder & "popup_head_email.gif"
TopMessage = Sub14Var9
TopMessage2 = " " & Sub14Var10
CASE ELSE
END SELECT
response.write "
"
response.write "
"
response.write "
"
response.write "
" & TopMessage & " " & TopMessage2 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
If Sum_From <> "loginscreen" or UseInviteFunction = "NO" then
response.write "" & Sum_Message & "
"
If Sum_LinkType = "window" then
response.write ""
Else
response.write "Continue"
End If
Else
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_Events WHERE Cal_EventUserID = " & Session("Cal_User_ID") & " AND Cal_EventStatus = 'INVITE'", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_Events WHERE Cal_EventUserID = " & Session("Cal_User_ID") & " AND Cal_EventStatus = 'INVITE'", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
response.write "
"
response.write "
" & Sub14Var5 & "
"
response.write "
"
If NOT RS.EOF then
response.write "
"
response.write "
"
Else
response.write "
"
response.write "
" & Sub14Var7 & "
"
response.write "
"
End If
RS.CLOSE
SET RS=Nothing
response.write ""
response.write "
"
response.write "
"
If Sum_LinkType = "window" then
response.write ""
Else
response.write "" & Sub14Var8 & ""
End If
End If
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
End Sub
'*********************************************************************************
'******** Must Login *************************************************************
'*********************************************************************************
Sub MustLogin
response.write "
"
End Sub
'*********************************************************************************
'******** Process Invites ********************************************************
'*********************************************************************************
Sub ProcessInvites
If request.form("txtApproveInvites") <> "" then
SendEmailToUsers = split(request.form("txtApproveInvites"))
For I = 0 to Ubound(SendEmailToUsers)
'---- Send Email to Invitees ----------
If UseSQLServer = "YES" then
SQLu = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & int(SendEmailToUsers(I))
Else
SQLu = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & int(SendEmailToUsers(I))
End If
Set RSu = dbc.execute(SQLu)
SendFromUserID = RSu("Cal_EventInviteByID")
Cal_EventTitle = RSu("Cal_EventTitle")
Cal_EventStartDate = RSu("Cal_EventStartDate")
Cal_EventStartTime = RSu("Cal_EventStartTime")
Cal_EventEndTime = RSu("Cal_EventEndTime")
Cal_EventBody = RSu("Cal_EventBody")
RSu.Close
Set RSu=Nothing
If UseSQLServer = "YES" then
SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & SendFromUserID
Else
SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & SendFromUserID
End If
Set RSe=dbc.execute(SQLe)
SendTo = RSe("Cal_User_EmailAddress")
EmailSubject = Sub49Var2
RSe.Close
Set RSe=Nothing
If Cal_EventAllDay <> "TRUE" then
MessageToSend = Session("Cal_User_FirstName") & " " & Session("Cal_User_LastName")& " " & Sub49Var3 & ":
"
End If
If UseEmailFunctions <> "NO" then
Call SendAnEmail(SendTo, EmailSubject, MessageToSend)
End If
'--------------------------------------
Next
If UseSQLServer = "YES" then
SQL = "UPDATE Cal_Events SET Cal_EventStatus = 'APPROVED' WHERE Cal_EventID IN("&request.form("txtApproveInvites")&")"
Else
SQL = "UPDATE Cal_Events SET Cal_EventStatus = 'APPROVED' WHERE Cal_EventID IN("&request.form("txtApproveInvites")&")"
End If
Set RS = dbc.Execute(SQL)
End If
If request.form("txtDeclineInvites") <> "" then
SendEmailToUsers = split(request.form("txtDeclineInvites"))
For I = 0 to Ubound(SendEmailToUsers)
'---- Send Email to Invitees ----------
If UseSQLServer = "YES" then
SQLu = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & int(SendEmailToUsers(I))
Else
SQLu = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & int(SendEmailToUsers(I))
End If
Set RSu = dbc.execute(SQLu)
SendFromUserID = RSu("Cal_EventInviteByID")
Cal_EventTitle = RSu("Cal_EventTitle")
Cal_EventStartDate = RSu("Cal_EventStartDate")
Cal_EventStartTime = RSu("Cal_EventStartTime")
Cal_EventEndTime = RSu("Cal_EventEndTime")
Cal_EventBody = RSu("Cal_EventBody")
RSu.Close
Set RSu=Nothing
If UseSQLServer = "YES" then
SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & SendFromUserID
Else
SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & SendFromUserID
End If
Set RSe=dbc.execute(SQLe)
SendTo = RSe("Cal_User_EmailAddress")
EmailSubject = Sub49Var2
RSe.Close
Set RSe=Nothing
If Cal_EventAllDay <> "TRUE" then
MessageToSend = Session("Cal_User_FirstName") & " " & Session("Cal_User_LastName")& " " & Sub49Var5 & ":
"
End If
If UseEmailFunctions <> "NO" then
Call SendAnEmail(SendTo, EmailSubject, MessageToSend)
End If
'--------------------------------------
Next
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_Events WHERE Cal_EventID IN("& request.form("txtDeclineInvites") &")"
Else
SQL = "DELETE FROM Cal_Events WHERE Cal_EventID IN("& request.form("txtDeclineInvites") &")"
End If
Set RS = dbc.Execute(SQL)
End If
response.redirect "calendar.asp?action=summary&message=" & Sub15Var3 & "&linktype=window&from=loginscreen"
End Sub
'*********************************************************************************
'******** Process Filter *********************************************************
'*********************************************************************************
Sub ProcessFilter
Session("Cal_FilterGroups") = request.form("txtGroupFilter")
If UseSQLServer = "YES" then
SQL="UPDATE Cal_User SET "
Else
SQL="UPDATE Cal_User SET "
End If
If Session("Cal_User_ID") <> "" then
SQL = SQL & "Cal_User_LastFilter = '" & Session("Cal_FilterGroups") & "' "
SQL = SQL & " WHERE [Cal_User_ID] ="& Session("Cal_User_ID")
dbc.Execute(SQL)
End If
response.redirect "calendar.asp?date=" & request.querystring("date") & "&caltype=" & request.querystring("caltype")
End Sub
'*********************************************************************************
'******** Send An Email **********************************************************
'*********************************************************************************
Sub SendAnEmail(SendTo, EmailSubject, MessageToSend)
'------ Fill the Variables --------------------------
txtSendTo = SendTo
txtSendFrom = SendFromEmailAddress
txtSubject = EmailSubject
txtBody = MessageToSend
If EmailComponent = "CDONTS" then
Set sMail = Server.CreateObject("CDONTS.NewMail")
sMail.BodyFormat = 0
sMail.MailFormat = 0
sMail.From = txtSendFrom
sMail.To = txtSendTo
sMail.Subject = txtSubject
sMail.Body = txtBody
sMail.Send( )
End If
If EmailComponent = "ASPEmail" then
Set sMail = Server.CreateObject("Persits.MailSender")
sMail.Host = EmailHost
sMail.From = txtSendFrom
sMail.FromName = txtSendFrom
sMail.AddReplyTo txtSendFrom
sMail.AddAddress txtSendTo 'This needs to be changed to handle multiples!!!
sMail.Subject = txtSubject
sMail.Body = txtBody
sMail.Send
End If
If EmailComponent = "JMail" then
Set sMail = Server.CreateObject("JMail.Message")
sMail.Logging = true
sMail.silent = true
sMail.From = txtSendFrom
sMail.FromName = txtSendFrom
sMail.AddRecipient txtSendTo 'This needs to be changed to handle multiples!!!
sMail.Subject = txtSubject
sMail.Body = txtBody
sMail.Send(EmailHost)
End If
If EmailComponent = "ASPMail" then
Set sMail = Server.CreateObject("SMTPsvg.Mailer")
sMail.RemoteHost = EmailHost
sMail.FromAddress = txtSendFrom
sMail.FromName = txtSendFrom
sMail.AddRecipient txtEmailUser, txtSendTo 'This needs to be changed to handle multiples!!!
sMail.ContentType = "text/html"
sMail.Subject = txtSubject
sMail.BodyText = txtBody
sMail.SendMail
End If
End Sub
'*********************************************************************************
'******** Export To VCAL *********************************************************
'*********************************************************************************
Sub ExportVCal(DateToUse, CalType)
If DateToUse = "" then
DateToUse = Date()
Else
DateToUse = cDate(DateToUse)
End If
If CalType = "" then
NumOfTimes = 31
Else
If CalType = "day" then
NumOfTimes = 1
End If
If CalType = "week" then
NumOfTimes = 7
WeekDayTitleName = Weekday(theDate, 2)
DateToUse = DateAdd("w", 1-WeekDayTitleName, DateToUse)
End If
If CalType = "month" then
NumOfTimes = 31
If Session("DateFormat") = "US" then
DateToUse = Month(DateToUse) & "/1/" & Year(DateToUse)
DateToUse = cDate(DateToUse)
Else
DateToUse = "/1/" & Month(DateToUse) & Year(DateToUse)
DateToUse = cDate(DateToUse)
End If
End If
End If
EventToUse = request.querystring("eventid")
If EventToUse <> "" then
NumOfTimes = 1
End If
VCalTemp = ""
VCalTemp = VCalTemp & "BEGIN:VCALENDAR" & vbCrLF
VCalTemp = VCalTemp & "VERSION:1.0" & vbCrLF
For I = 1 to NumOfTimes
If I > 1 then
DateToUse = DateAdd("d", DateToUse, 1)
End If
If EventToUse = "" then
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 <= '" & CDate(DateToUse) & "' AND Cal_EventEndDate >= '" & CDate(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 <= #" & CDate(DateToUse) & "# AND Cal_EventEndDate >= #" & CDate(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 <= '" & CDate(DateToUse) & "' AND Cal_EventEndDate >= '" & CDate(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 <= #" & CDate(DateToUse) & "# AND Cal_EventEndDate >= #" & CDate(DateToUse) & "# AND Cal_EventStatus = 'APPROVED' ORDER BY Cal_EventStartTime, Cal_EventEndTime"
End If
Set RS=dbc.execute(SQL)
End If
Else
If UseSQLServer = "YES" then
SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & EventToUse
Else
SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & EventToUse
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
IsVisible = IsEventVisible(RS("Cal_EventGroupID"))
If IsVisible = "TRUE" then
TimeZoneBias = TimeZoneBias * (-1)
If RS("Cal_EventAllDay") = "TRUE" then
FixStartDay = Day(RS("Cal_EventStartDate"))
If len(FixStartDay) = 1 then
FixStartDay = "0" & FixStartDay
End If
FixStartMonth = Month(RS("Cal_EventStartDate"))
If len(FixStartMonth) = 1 then
FixStartMonth = "0" & FixStartMonth
End If
FixEndDay = Day(RS("Cal_EventEndDate"))
If len(FixEndDay) = 1 then
FixEndDay = "0" & FixEndDay
End If
FixEndMonth = Month(RS("Cal_EventEndDate"))
If len(FixEndMonth) = 1 then
FixEndMonth = "0" & FixEndMonth
End If
EventStartDate = Year(RS("Cal_EventStartDate")) & FixStartMonth & FixStartDay
EventEndDate = Year(RS("Cal_EventEndDate")) & FixEndMonth & FixEndDay
'EventStartDate = Year(RS("Cal_EventStartDate")) & Month(RS("Cal_EventStartDate")) & Day(RS("Cal_EventStartDate"))
'EventEndDate = Year(RS("Cal_EventEndDate")) & Month(RS("Cal_EventEndDate")) & Day(RS("Cal_EventEndDate"))
VCalEventStart = EventStartDate & "T050000Z"
VCalEventEnd = EventEndDate & "T050000Z"
Else
FixStartDay = Day(RS("Cal_EventStartDate"))
If len(FixStartDay) = 1 then
FixStartDay = "0" & FixStartDay
End If
FixStartMonth = Month(RS("Cal_EventStartDate"))
If len(FixStartMonth) = 1 then
FixStartMonth = "0" & FixStartMonth
End If
FixEndDay = Day(RS("Cal_EventEndDate"))
If len(FixEndDay) = 1 then
FixEndDay = "0" & FixEndDay
End If
FixEndMonth = Month(RS("Cal_EventEndDate"))
If len(FixEndMonth) = 1 then
FixEndMonth = "0" & FixEndMonth
End If
EventStartDate = Year(RS("Cal_EventStartDate")) & FixStartMonth & FixStartDay
EventEndDate = Year(RS("Cal_EventEndDate")) & FixEndMonth & FixEndDay
'EventStartDate = Year(RS("Cal_EventStartDate")) & Month(RS("Cal_EventStartDate")) & Day(RS("Cal_EventStartDate"))
'EventEndDate = Year(RS("Cal_EventEndDate")) & Month(RS("Cal_EventEndDate")) & Day(RS("Cal_EventEndDate"))
EventStartTime = FormatDateTime(RS("Cal_EventStartTime"), 4)
EventStartTime = Replace(EventStartTime, ":", "")
EventEndTime = FormatDateTime(RS("Cal_EventEndTime"), 4)
EventEndTime = Replace(EventEndTime, ":", "")
VCalEventStart = EventStartDate & "T" & EventStartTime & "00"
VCalEventEnd = EventEndDate & "T" & EventEndTime & "00"
End If
FixedBody = replace(RS("Cal_EventBody"), " ", "")
FixedBody = replace(FixedBody, vbcrlf, "")
VCalTemp = VCalTemp & "BEGIN: VEVENT" & vbCrLF
VCalTemp = VCalTemp & "DTStart:" & VCalEventStart & vbCrLF
VCalTemp = VCalTemp & "DTEnd:" & VCalEventEnd & vbCrLF
VCalTemp = VCalTemp & "Location;ENCODING=QUOTED-PRINTABLE:" & EventLocation & vbCrLF
VCalTemp = VCalTemp & "SUMMARY;ENCODING=QUOTED-PRINTABLE:" & RS("Cal_EventTitle") & vbCrLF
VCalTemp = VCalTemp & "DESCRIPTION;ENCODING=QUOTED-PRINTABLE:" & FixedBody & vbCrLF
VCalTemp = VCalTemp & "UID:" & VCalEventStart & VCalEventEnd & RS("Cal_EventTitle") & vbCrLF
VCalTemp = VCalTemp & "PRIORITY:3" & vbCrLF
VCalTemp = VCalTemp & "End:VEVENT" & vbCrLF
End If
End If
RS.MoveNext
Loop
Next
VCalTemp = VCalTemp & "End:VCALENDAR" & chr(13)
'------ Write Stream to a file and send it to the browser... then delete the file... ------------------
'Dim objStream
'Set objStream = Server.CreateObject("ADODB.Stream")
'objStream.Open
'objStream.Type = 2
'objStream.Charset = "ascii"
'objStream.WriteText VCalTemp
'objStream.SaveToFile Server.MapPath("calendar\eventimages\vcalexport.vcs"), 2
'objStream.Close
'Set objStream = Nothing
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
Dim objTextStream
Set objTextStream = FSO.OpenTextFile(Server.MapPath("calendar\eventimages\vcalexport.vcs"), 8, True)
objTextStream.Write VCalTemp
objTextStream.Close
Set objTextStream = Nothing
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
Response.ContentType = "application/octet-stream"
Response.AddHeader "Content-Disposition", "attachment;filename=vcalexport.vcs"
objStream.Type = 1
objStream.Open
objStream.LoadFromFile Server.MapPath("calendar\eventimages\vcalexport.vcs")
Response.BinaryWrite objStream.Read
objStream.Close
Set objStream = Nothing
If FSO.FileExists(Server.MapPath("calendar\eventimages\vcalexport.vcs")) then
FSO.DeleteFile(Server.MapPath("calendar\eventimages\vcalexport.vcs"))
Else
response.write "THIS FILE DOESN'T EXISTS"
End If
Set FSO = Nothing
'-------- Old method use this if you cant write to the file for permission reasons ----------------
'response.write "
"
End Sub
'*********************************************************************************
'******** Email A User **********************************************************
'*********************************************************************************
Sub SendUserEmail
response.write "
"
response.write "
"
response.write "
"
response.write "
" & Sub50Var1 & " " & Sub50Var2 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
response.write "
"
response.write "
"
response.write "
"
End Sub
'*********************************************************************************
'******** Email A User **********************************************************
'*********************************************************************************
Sub SendUserEmailProcess
SendTo = request.form("txtEmailUser")
EmailSubject = request.form("txtEmailSubject")
MessageToSend = request.form("txtEmailBody")
Call SendAnEmail(SendTo, EmailSubject, MessageToSend)
response.redirect "calendar.asp?action=summary&message=" & Sub51Var1 & "&linktype=window&from=emailuser"
End Sub
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'************************* Functions Below Here Only *****************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'********* Write the page header or footer **************************************
SUB WriteHeaderOrFooter(FileToRead)
HFFile=server.mappath(FileToRead)
Set fs = CreateObject("Scripting.FileSystemObject")
Set thisfile = fs.OpenTextFile(HFFile, 1, False)
tempSTR=thisfile.readall
response.write tempSTR
thisfile.Close
set thisfile=nothing
set fs=nothing
END SUB
'******* Can User Modify Event ***************************************************
Function CanUserModify(EventGroup)
CanModify = Split(Session("Cal_User_AdminGroups"))
For I = 0 to Ubound(CanModify)
If cint(EventGroup) = cint(CanModify(I)) then
Return = "TRUE"
End If
Next
CanUserModify = Return
End Function
'******* 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)
'RS.Filter = "Cal_EventUserID = " & Session("Cal_User_ID")
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
'******* Get Group Array Function ************************************************
Function GetGroupArray(GroupField, GroupValue)
If UseSQLServer = "YES" then
SQLg = "SELECT Cal_Group_ID FROM Cal_Group WHERE " & GroupField & " = '" & GroupValue & "'"
Else
SQLg = "SELECT Cal_Group_ID FROM Cal_Group WHERE " & GroupField & " = '" & GroupValue & "'"
End If
Set RSg=dbc.execute(SQLg)
Do While NOT RSg.EOF
GroupArray = GroupArray & RSg("Cal_Group_ID")
GroupArray = GroupArray & ", "
RSg.MoveNext
Loop
RSg.Close
Set RSg=Nothing
GroupArray = Left(GroupArray, len(GroupArray) -2)
GetGroupArray = GroupArray
End Function
'******* Get User Group Array Function ********************************************
Function GetUserGroupArray(RightsType)
If UseSQLServer = "YES" then
SQLg = "SELECT Cal_UG_Link_GroupID FROM Cal_UG_Link WHERE Cal_UG_Link_Type = '" & RightsType & "' AND Cal_UG_Link_UserID = " & Session("Cal_User_ID")
Else
SQLg = "SELECT Cal_UG_Link_GroupID FROM Cal_UG_Link WHERE Cal_UG_Link_Type = '" & RightsType & "' AND Cal_UG_Link_UserID = " & Session("Cal_User_ID")
End If
Set RSg=dbc.execute(SQLg)
Do While NOT RSg.EOF
If RSg("Cal_UG_Link_GroupID") = "9999" then
InAll = "YES"
End If
UserGroupArray = UserGroupArray & RSg("Cal_UG_Link_GroupID")
UserGroupArray = UserGroupArray & ", "
RSg.MoveNext
Loop
RSg.Close
Set RSg=Nothing
If InAll = "YES" then
UserGroupArray = ""
If UseSQLServer = "YES" then
SQLg = "SELECT Cal_Group_ID FROM Cal_Group"
Else
SQLg = "SELECT Cal_Group_ID FROM Cal_Group"
End If
Set RSg=dbc.execute(SQLg)
Do While NOT RSg.EOF
UserGroupArray = UserGroupArray & RSg("Cal_Group_ID")
UserGroupArray = UserGroupArray & ", "
RSg.MoveNext
Loop
RSg.Close
Set RSg=Nothing
End If
UserGroupArray = Left(UserGroupArray, len(UserGroupArray) -2)
UserGroupArray = UserGroupArray & ", 2"
GetUserGroupArray = UserGroupArray
End Function
'******* Format Time Function ****************************************************
Function FormatTime(timeValue)
Dim timeReturn
If UseSQLServer = "YES" then
timeReturnAMPM = right(timeValue, 2)
If Len(timeValue) = 6 or Len(timeValue) = 10 then
timeValue = left(timeValue,4)
timeValue = timeValue + timeReturnAMPM
Else
timeValue = left(timeValue,5)
timeValue = timeValue + timeReturnAMPM
End If
FormatTime = timeValue
Else
timeReturnAMPM = right(timeValue, 2)
If Len(timeValue) = 10 then
timeValue = left(timeValue,4)
timeValue = timeValue + timeReturnAMPM
Else
timeValue = left(timeValue,5)
timeValue = timeValue + timeReturnAMPM
End If
FormatTime = timeValue
End If
End Function
'******* Fix String Function *****************************************************
Function FixString(strSource)
strSource = Replace(strSource, "'", "''")
strSource = Replace(strSource, "''''", "''")
FixString = Replace(strSource, "'''", "''")
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
'******* Format Time Function 24 or 12 hour **************************************
Function FormatTimeFix(TimeValue, FromArea)
Dim Hour
Dim Minute
Dim ClockTime
If TimeFormatToUse = "12" then
Hour = DatePart("h", TimeValue)
Minute = DatePart("n", TimeValue)
If Minute < 10 then
Minute = "0" & Minute
End If
If cDate(TimeValue) > #11:59am# and cDate(TimeValue) =< #12:59pm# then
If FromArea = "MONTH" then
Clocktime = Hour & ":" & Minute & "PM"
Else
Clocktime = Hour & ":" & Minute & " PM"
End If
Else
If cDate(TimeValue) => #1:00pm# and cDate(TimeValue) =< #11:59pm# then
If FromArea = "MONTH" then
Clocktime = cInt(Hour) - 12 & ":" & Minute & "PM"
Else
Clocktime = cInt(Hour) - 12 & ":" & Minute & " PM"
End If
Else
If cDate(TimeValue) => #12:00am# and cDate(TimeValue) < #1:00am# then
If FromArea = "MONTH" then
Clocktime = cInt(Hour) + 12 & ":" & Minute & "AM"
Else
Clocktime = cInt(Hour) + 12 & ":" & Minute & " AM"
End If
Else
If FromArea = "MONTH" then
Clocktime = Hour & ":" & Minute & "AM"
Else
Clocktime = Hour & ":" & Minute & " AM"
End If
End If
End If
End If
FormatTimeFix = ClockTime
Else
TempTimeValue = left(TimeValue, 5)
FormatTimeFix = TempTimeValue
End If
End Function
%>