" & SiteTitle & ""
EventImagePath = "calendar/eventimages/"
FileDirectory = Server.MapPath("calendar/") & "\eventimages\"
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 ************************************
If request.querystring("action") = "modifyconfig" then
Call HasEmailComponent
End If
TimeFormatToUse = "12" 'Set to 12 or 24
UseInviteFunction = "NO"
ServerAddress = request.ServerVariables("HTTP_HOST")
CalendarURL2 = request.ServerVariables("URL")
FullURL = "http://" & ServerAddress & left(CalendarURL2, len(CalendarURL2) - 19) & "/calendar.asp"
UseEmailFunctions = "YES"
'******* 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 *************************************************
response.write PageHeader
'********* Include the CSS from the current skin ********************************
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 tempSTR
thisfile.Close
set thisfile=nothing
set fs=nothing
END SUB
%>
<%
'******** Find out what we should be doing **************************************
If request.querystring("date") = "" then
theDate = Date()
Else
If request.querystring("action") <> "addevent" then
theDate = cDate(request.querystring("date"))
End If
End If
ScriptAction = request.querystring("action")
SELECT CASE ScriptAction
CASE "manageusers"
Call CheckSecurity
Call ManageUsers
CASE "manageusers2"
If request.form("txtManageUserTask") = "AddUser" then
Call CheckSecurity
Call AddUser
End If
If request.form("txtManageUserTask") = "DeleteUser" then
Call CheckSecurity
Call DeleteUser
End If
If request.form("txtManageUserTask") = "ModifyUser" then
Call CheckSecurity
Call ModifyUser
End If
CASE "adduser"
Call CheckSecurity
Call AddUser
CASE "adduser2"
Call CheckSecurity
Call AddUser2
CASE "adduserprocess"
Call CheckSecurity
Call AddUserProcess
CASE "modifyuser2"
Call CheckSecurity
Call ModifyUser2
CASE "modifyuser3"
Call CheckSecurity
Call ModifyUser3
CASE "modifyuserprocess"
Call CheckSecurity
Call ModifyUserProcess
CASE "deleteuserprocess"
Call CheckSecurity
Call DeleteUserProcess
CASE "managegroups"
Call CheckSecurity
Call ManageGroups
CASE "managegroups2"
If request.form("txtManageGroupTask") = "AddGroup" then
Call CheckSecurity
Call AddGroup
End If
If request.form("txtManageGroupTask") = "DeleteGroup" then
Call CheckSecurity
Call DeleteGroup
End If
If request.form("txtManageGroupTask") = "ModifyGroup" then
Call CheckSecurity
Call ModifyGroup
End If
CASE "addgroup"
Call CheckSecurity
Call AddGroup
CASE "addgroupprocess"
Call CheckSecurity
Call AddGroupProcess
CASE "modifygroup2"
Call CheckSecurity
Call ModifyGroup2
CASE "modifygroup3"
Call CheckSecurity
Call ModifyGroup3
CASE "modifygroupprocess"
Call CheckSecurity
Call ModifyGroupProcess
CASE "deletegroup2"
Call CheckSecurity
Call DeleteGroup2
CASE "deletegroupprocess"
Call CheckSecurity
Call DeleteGroupProcess
CASE "addevent"
Call AddEvent
CASE "addeventprocess"
Call AddEventProcess
CASE "editevent"
Call AddEvent
CASE "editeventprocess"
Call EditEventProcess
CASE "deleteevent"
Call DeleteEvent
CASE "deleteeventprocess"
Call DeleteEventProcess
CASE "uploadfile"
Call UploadFile
CASE "uploadfileprocess"
Call UploadFileProcess
CASE "modifyconfig"
Call CheckSecurity
Call ModifyConfig
CASE "modifyconfigprocess"
Call CheckSecurity
Call ModifyConfigProcess
CASE "approveevents"
Call ApproveEvents
CASE "approveeventsprocess"
Call ApproveEventsProcess
CASE "manageviews"
Call ManageViews
CASE "embedcontent"
Call EmbedContent
CASE "embedcontent2"
Call EmbedContent2
CASE "embedcontent3"
Call EmbedContent3
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 ELSE
END SELECT
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'************************* Routines Below Here Only ******************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'******** Embed Content **********************************************************
'*********************************************************************************
Sub EmbedContent
Call DrawWindowHeader(Sub55Var1, " " & Sub55Var2, "calendar_admin.asp?action=embedcontent2", SkinFolder & "popup_head_embed.gif")
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 request.form("txtContentType") = "EventListing" then
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "" & Sub57Var3 & " "
EmbedURL = FullURL & "?action=eventlist&type=outside&range=" & request.form("txtRange")
If request.form("txtDate") <> "" then
EmbedURL = EmbedURL & "&date=" & request.form("txtDate")
End If
If request.form("txtFilter") <> "" then
EmbedURL = EmbedURL & "&filter=" & request.form("txtFilter")
End If
response.write ""
response.write "
"
End If
'---------------------------------------------------------------------------------
If request.form("txtContentType") = "Link" then
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "" & Sub57Var6 & " "
LinkURL = FullURL & "?caltype=" & request.form("txtCalType") & "&sidebar=" & request.form("txtShowSideBar") & "&expandfilter=" & request.form("txtExpandFilter") & "&expandlegend=" & request.form("txtExpandLegend") & "&expandquicklinks=" & request.form("txtExpandQuickLinks")
If request.form("txtDate") <> "" then
LinkURL = LinkURL & "&date=" & request.form("txtDate")
End If
If request.form("txtFilter") <> "" then
LinkURL = LinkURL & "&filter=" & request.form("txtFilter")
End If
response.write ""
response.write "
"
Call DrawWindowFooter(Sub20Var9, "10", "90", "TRUE", "USERS")
End Sub
'*********************************************************************************
'******** Add User Process *******************************************************
'*********************************************************************************
Sub AddUserProcess
txtCal_User_FirstName = request.form("txtCal_User_FirstName")
txtCal_User_LastName = request.form("txtCal_User_LastName")
txtCal_User_EmailAddress = request.form("txtCal_User_EmailAddress")
txtCal_User_UserName = request.form("txtCal_User_UserName")
txtCal_User_Password = request.form("txtCal_User_Password")
txtCal_User_RequireApproval = request.form("txtCal_User_RequireApproval")
txtCal_User_RightsLevel = request.form("txtCal_User_RightsLevel")
txtCal_User_EventColor = request.form("txtCal_User_EventColor")
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_User", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_User", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
RS.AddNew
RS("Cal_User_FirstName") = txtCal_User_FirstName
RS("Cal_User_LastName") = txtCal_User_LastName
RS("Cal_User_EmailAddress") = txtCal_User_EmailAddress
RS("Cal_User_UserName") = txtCal_User_UserName
RS("Cal_User_Password") = txtCal_User_Password
RS("Cal_User_RightsLevel") = txtCal_User_RightsLevel
RS("Cal_User_RequireApproval") = txtCal_User_RequireApproval
RS("Cal_User_EventColor") = txtCal_User_EventColor
RS.Update
RS.Close
Set RS=Nothing
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_User WHERE Cal_User_UserName = '" & txtCal_User_UserName & "'", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_User WHERE Cal_User_UserName = '" & txtCal_User_UserName & "'", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
Cal_User_ID = RS("Cal_User_ID")
RS.Close
Set RS=Nothing
If request.form("txtCal_User_GroupStandardMembership") <> "" then
txtCal_UG_Link_Standard = Split(request.form("txtCal_User_GroupStandardMembership"))
End If
If request.form("txtCal_User_GroupAdminMembership") <> "" then
txtCal_UG_Link_Admin = Split(request.form("txtCal_User_GroupAdminMembership"))
End If
If txtCal_UG_Link_Standard(0) <> "" then
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_UG_Link", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_UG_Link", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
For I = 0 to Ubound(txtCal_UG_Link_Standard)
RS.AddNew
RS("Cal_UG_Link_UserID") = Cal_User_ID
RS("Cal_UG_Link_GroupID") = txtCal_UG_Link_Standard(I)
RS("Cal_UG_Link_Type") = "NORMAL"
RS.Update
Next
RS.Close
Set RS=Nothing
End If
If txtCal_UG_Link_Admin(0) <> "" then
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_UG_Link", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_UG_Link", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
For I = 0 to Ubound(txtCal_UG_Link_Admin)
RS.AddNew
RS("Cal_UG_Link_UserID") = Cal_User_ID
RS("Cal_UG_Link_GroupID") = txtCal_UG_Link_Admin(I)
RS("Cal_UG_Link_Type") = "ADMIN"
RS.Update
Next
RS.Close
Set RS=Nothing
End If
response.redirect "calendar_admin.asp?action=summary&from=addusersuccess&linktype=window&message=" & Sub21Var1 & "."
End Sub
'*********************************************************************************
'******** Modify Users Page 1 ****************************************************
'*********************************************************************************
Sub ModifyUser
Call DrawWindowHeader(Sub22Var1, " " & Sub22Var2 & ":", "calendar_admin.asp?action=modifyuser2", SkinFolder & "popup_head_users.gif")
response.write "
"
Call DrawWindowFooter(Sub26Var6, "10", "90", "TRUE", "USERS")
End Sub
'*********************************************************************************
'******** Delete User Process ****************************************************
'*********************************************************************************
Sub DeleteUserProcess
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_User WHERE Cal_User_ID IN("& request.form("txtSelect_User") &")"
Else
SQL = "DELETE FROM Cal_User WHERE Cal_User_ID IN("& request.form("txtSelect_User") &")"
End If
dbc.Execute(SQL)
If request.form("txtDelete_PERSONAL") = "YES" then
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_Events WHERE Cal_EventUserID =" & request.form("txtSelect_User") & " AND Cal_EventGroupID = 2"
Else
SQL = "DELETE FROM Cal_Events WHERE Cal_EventUserID =" & request.form("txtSelect_User") & " AND Cal_EventGroupID = 2"
End If
dbc.Execute(SQL)
End If
If request.form("txtDelete_ALL") = "YES" then
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_Events WHERE Cal_EventUserID =" & request.form("txtSelect_User")
Else
SQL = "DELETE FROM Cal_Events WHERE Cal_EventUserID =" & request.form("txtSelect_User")
End If
dbc.Execute(SQL)
End If
response.redirect "calendar_admin.asp?action=summary&from=deleteusersuccess&linktype=window&message=" & Sub27Var1 & "."
End Sub
'*********************************************************************************
'******** Manage Groups Page *****************************************************
'*********************************************************************************
Sub ManageGroups
Call DrawWindowHeader(Sub28Var1, " " & Sub28Var2, "calendar_admin.asp?action=managegroups2", SkinFolder & "popup_head_groups.gif")
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "" & Sub28Var3 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "" & Sub28Var4 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "" & Sub28Var5 &"
"
response.write "
"
Call DrawWindowFooter(Sub28Var6, "25", "75", "FALSE", "GROUPS")
End Sub
'*********************************************************************************
'******** Add Groups Page 1 ******************************************************
'*********************************************************************************
Sub AddGroup
Call DrawWindowHeader(Sub29Var1, " " & Sub29Var2 & ":", "calendar_admin.asp?action=addgroupprocess", SkinFolder & "popup_head_groups.gif")
response.write "
"
response.write "
"
response.write "
"
response.write "Group Name: "
response.write ""
If request.querystring("error") = "duplicate" then
response.write " " & Sub29Var3 & "."
End If
response.write "
"
Call DrawWindowFooter(Sub31Var4, "10", "90", "TRUE", "GROUPS")
End Sub
'*********************************************************************************
'******** Modify Group Page 2 ****************************************************
'*********************************************************************************
Sub ModifyGroup2
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_Group WHERE Cal_Group_ID = " & request.form("txtSelect_Group"), dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_Group WHERE Cal_Group_ID = " & request.form("txtSelect_Group"), dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
Call DrawWindowHeader(Sub32Var1, " " & Sub32Var2 & ":", "calendar_admin.asp?action=modifygroupprocess", SkinFolder & "popup_head_groups.gif")
response.write ""
response.write "
"
response.write "
"
response.write "
"
response.write Sub32Var3 & ": "
%>
">
<%
'If request.querystring("error") = "duplicate" then
' response.write " The group name you entered already exists."
'End If
response.write "
"
Call DrawWindowFooter(Sub34Var4, "10", "90", "TRUE", "GROUPS")
End Sub
'*********************************************************************************
'******** Delete Group ***********************************************************
'*********************************************************************************
Sub DeleteGroup2
If UseSQLServer = "YES" then
SQLz = "SELECT * FROM Cal_Group WHERE Cal_Group_ID = " & request.form("txtSelect_Group")
Else
SQLz = "SELECT * FROM Cal_Group WHERE Cal_Group_ID = " & request.form("txtSelect_Group")
End If
Set RSz=dbc.execute(SQLz)
response.write "
"
response.write "
"
response.write "
"
response.write "
" & Sub35Var1 & " " & Sub35Var2 & ":
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
RSz.Close
Set RSz=Nothing
End Sub
'*********************************************************************************
'******** Delete Group Process ***************************************************
'*********************************************************************************
Sub DeleteGroupProcess
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_Group WHERE Cal_Group_ID = " & request.form("txtCal_Group_ID")
Else
SQL = "DELETE FROM Cal_Group WHERE Cal_Group_ID = " & request.form("txtCal_Group_ID")
End If
Set RS = dbc.Execute(SQL)
Set RS=Nothing
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_UG_Link WHERE Cal_UG_Link_GroupID = " & request.form("txtCal_Group_ID")
Else
SQL = "DELETE FROM Cal_UG_Link WHERE Cal_UG_Link_GroupID = " & request.form("txtCal_Group_ID")
End If
Set RS = dbc.Execute(SQL)
Set RS=Nothing
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_Events WHERE Cal_EventGroupID = " & request.form("txtCal_Group_ID")
Else
SQL = "DELETE FROM Cal_Events WHERE Cal_EventGroupID = " & request.form("txtCal_Group_ID")
End If
Set RS = dbc.Execute(SQL)
Set RS=Nothing
response.redirect "calendar_admin.asp?action=summary&from=deletegroupsuccess&linktype=window&message=" & Sub36Var1 & "."
End Sub
'*********************************************************************************
'******** Add An Event ***********************************************************
'*********************************************************************************
Sub AddEvent
If request.querystring("action") = "editevent" then
If UseSQLServer = "YES" then
SQLz = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventid")
Else
SQLz = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventid")
End If
Set RSz=dbc.execute(SQLz)
If RSz("Cal_EventRecurrID") <> "" then
If UseSQLServer = "YES" then
SQLr = "SELECT * FROM Cal_Recurr WHERE Cal_RecurrID = " & RSz("Cal_EventRecurrID")
Else
SQLr = "SELECT * FROM Cal_Recurr WHERE Cal_RecurrID = " & RSz("Cal_EventRecurrID")
End If
Set RSr=dbc.execute(SQLr)
HasRecurr = "YES"
If request.querystring("recurredit") = "ALL" then
If UseSQLServer = "YES" then
SQLd = "SELECT * FROM Cal_Events WHERE Cal_EventRecurrID = " & RSz("Cal_EventRecurrID") & " ORDER BY Cal_EventStartDate"
Else
SQLd = "SELECT * FROM Cal_Events WHERE Cal_EventRecurrID = " & RSz("Cal_EventRecurrID") & " ORDER BY Cal_EventStartDate"
End If
Set RSd=dbc.execute(SQLd)
EventStartDate = RSd("Cal_EventStartDate")
EventEndDate = RSd("Cal_EventEndDate")
RSd.Close
Set RSd=Nothing
Else
EventStartDate = RSz("Cal_EventStartDate")
EventEndDate = RSz("Cal_EventEndDate")
End If
Else
EventStartDate = RSz("Cal_EventStartDate")
EventEndDate = RSz("Cal_EventEndDate")
End If
End If
%>
<%
If request.querystring("action") = "editevent" then
response.write "
"
response.write "
"
response.write "
"
response.write "
" & Sub37Var17 & " " & Sub37Var18 & ":
"
response.write "
"
response.write "
"
response.write "
"
Else
response.write "
"
response.write "
"
response.write "
"
response.write "
" & Sub37Var19 & " " & Sub37Var20 & ":
"
response.write "
"
response.write "
"
response.write "
"
End If
If request.querystring("action") = "editevent" and HasRecurr = "YES" AND request.querystring("recurredit") = "" then
response.write "
"
If UseInviteFunction <> "NO" then
%>
<%
Else
%>
<%
End If
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
If request.querystring("action") = "editevent" then
response.write "
"
Else
response.write "
"
End If
response.write "
"
response.write "
"
If request.querystring("action") = "editevent" then
'----- Fill Standard Page Items ------------------------------------
%>
'">
<%
If DateFormat = "US" then
%>
'">
'">
<%
Else
%>
'">
'">
<%
End If
If RSz("Cal_EventAllDay") = "TRUE" then
%>
<%
End If
'----- Fill Advanced Page Items ------------------------------------
%>
'">
'">
<%
If User1 <> "" then
%>
'">
<%
End If
If User2 <> "" then
%>
'">
<%
End If
If User3 <> "" then
%>
'">
<%
End If
If User4 <> "" then
%>
'">
<%
End If
If User5 <> "" then
%>
'">
<%
End If
'----- Fill Recurr Options ------------------------------------
If RSz("Cal_EventRecurrID") <> "" and request.querystring("recurredit") <> "THIS" then
If RSr("Cal_RecurrType") = "DAILY" then
%>'"><%
End If
End If
'RSr.Close
'Set RSr=Nothing
RSz.Close
Set RSz=Nothing
End If
response.write ""
End If
End Sub
'*********************************************************************************
'******** Add Event Process ******************************************************
'*********************************************************************************
Sub AddEventProcess
'----------- If Recurr then store it ---------------------------------------------
If request.form("txtCalRecurrPattern") <> "" then
If request.form("txtCalRecurrPattern") = "DAILY" then
Cal_RecurrType = "DAILY"
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_Recurr", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_Recurr", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
RS.AddNew
RS("Cal_RecurrType") = "DAILY"
RS("Cal_RecurrEndDate") = request.form("txtRecurrEndDate")
RS("Cal_RecurrEndAfterNum") = request.form("txtNumRecurrences")
RS("Cal_RecurrDailyNumDays") = request.form("txtDailyRecurrEveryNumDays")
If request.form("txtDailyRecurrType") = "EVERYWEEKDAY" then
RS("Cal_RecurrDailyWeekdays") = "YES"
End If
RS.Update
RS.Close
Set RS=Nothing
If UseSQLServer = "YES" then
SQL = "Select Cal_RecurrID FROM Cal_Recurr ORDER BY Cal_RecurrID DESC"
Else
SQL = "Select Cal_RecurrID FROM Cal_Recurr ORDER BY Cal_RecurrID DESC"
End If
Set RS=dbc.execute(SQL)
RS.MoveFirst
Cal_EventRecurrID = RS("Cal_RecurrID")
RS.Close
Set RS=Nothing
'--------------- # of Times to Run the Loop ------------------------------------
If request.form("txtNumRecurrences") = "" then
EventStartDate = request.form("txtCal_Event_StartDate")
RecEndDate = request.form("txtRecurrEndDate")
If request.form("txtDailyRecurrType") <> "EVERYWEEKDAY" then
LoopToNumberTemp = DateDiff("d", EventStartDate, RecEndDate)
LoopToNumber = LoopToNumberTemp / request.form("txtDailyRecurrEveryNumDays")
LoopToNumber = LoopToNumber - 1
Else
LoopToNumber = DateDiff("d", EventStartDate, RecEndDate)
End If
Else
If request.form("txtDailyRecurrType") <> "EVERYWEEKDAY" then
EventStartDate = request.form("txtCal_Event_StartDate")
LoopToNumber = request.form("txtNumRecurrences")
LoopToNumber = LoopToNumber - 1
Else
EventStartDate = request.form("txtCal_Event_StartDate")
LoopToNumber = request.form("txtNumRecurrences") - 1
LoopToNumber = LoopToNumber
End If
End If
End If
If request.form("txtCalRecurrPattern") = "WEEKLY" then
Cal_RecurrType = "WEEKLY"
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_Recurr", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_Recurr", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
RS.AddNew
RS("Cal_RecurrType") = "WEEKLY"
RS("Cal_RecurrEndDate") = request.form("txtRecurrEndDate")
RS("Cal_RecurrEndAfterNum") = request.form("txtNumRecurrences")
RS("Cal_RecurrWeeklyDay") = request.form("txtWeeklyRecurrDay")
RS("Cal_RecurrWeeklyNumWeeks") = request.form("txtWeeklyRecurrNumWeeks")
RS.Update
RS.Close
Set RS=Nothing
If UseSQLServer = "YES" then
SQL = "Select Cal_RecurrID FROM Cal_Recurr ORDER BY Cal_RecurrID DESC"
Else
SQL = "Select Cal_RecurrID FROM Cal_Recurr ORDER BY Cal_RecurrID DESC"
End If
Set RS=dbc.execute(SQL)
RS.MoveFirst
Cal_EventRecurrID = RS("Cal_RecurrID")
RS.Close
Set RS=Nothing
'--------------- # of Times to Run the Loop ------------------------------------
TotalRecs = request.form("txtNumRecurrences")
If TotalRecs = "" then
TotalRecs = 1000
End If
OnWeek = int(request.form("txtWeeklyRecurrNumWeeks"))
OnWeekCounter = OnWeek
If request.form("txtNumRecurrences") = "" then
EventStartDate = request.form("txtCal_Event_StartDate")
RecEndDate = request.form("txtRecurrEndDate")
LoopToNumber = DateDiff("d", EventStartDate, RecEndDate)
Else
EventStartDate = request.form("txtCal_Event_StartDate")
LoopToNumber = ((7 * request.form("txtNumRecurrences")) * OnWeek) - 7
LoopToNumber = LoopToNumber + 1
End If
End If
If request.form("txtCalRecurrPattern") = "MONTHLY" then
Cal_RecurrType = "MONTHLY"
Set RS=Server.CreateObject("ADODB.RecordSet")
If UserSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_Recurr", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_Recurr", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
RS.AddNew
RS("Cal_RecurrType") = "MONTHLY"
RS("Cal_RecurrEndDate") = request.form("txtRecurrEndDate")
RS("Cal_RecurrEndAfterNum") = request.form("txtNumRecurrences")
RS("Cal_RecurrMonthlyType") = request.form("txtMonthlyRecurrType")
RS("Cal_RecurrMonthlyDay") = request.form("txtMonthlyRecurrDayNum")
RS("Cal_RecurrMonthlyMonths") = request.form("txtMonthlyRecurrDayMonths")
RS("Cal_RecurrMonthlyFirst") = request.form("txtMonthlyFirstValue")
RS("Cal_RecurrMonthlySecond") = request.form("txtMonthlySecondValue")
RS("Cal_RecurrMonthlyThird") = request.form("txtMonthlyThirdValue")
RS.Update
RS.Close
Set RS=Nothing
If UseSQLServer = "YES" then
SQL = "Select Cal_RecurrID FROM Cal_Recurr ORDER BY Cal_RecurrID DESC"
Else
SQL = "Select Cal_RecurrID FROM Cal_Recurr ORDER BY Cal_RecurrID DESC"
End If
Set RS=dbc.execute(SQL)
RS.MoveFirst
Cal_EventRecurrID = RS("Cal_RecurrID")
RS.Close
Set RS=Nothing
'--------------- # of Times to Run the Loop ------------------------------------
If request.form("txtMonthlyRecurrType") = "DAYOFMONTH" then
OnMonth = int(request.form("txtMonthlyRecurrDayMonths"))
OnMonthCounter = OnMonth
If request.form("txtNumRecurrences") = "" then
EventStartDate = request.form("txtCal_Event_StartDate")
RecEndDate = request.form("txtRecurrEndDate")
LoopToNumber = DateDiff("m", EventStartDate, RecEndDate)
Else
'EventStartDate = request.form("txtCal_Event_StartDate")
If DateFormat = "US" then
EventStartDate = month(request.form("txtCal_Event_StartDate")) & "/" & request.form("txtMonthlyRecurrDayNum") & "/" & Year(request.form("txtCal_Event_StartDate"))
Else
EventStartDate = request.form("txtMonthlyRecurrDayNum") & "/" & month(request.form("txtCal_Event_StartDate")) & "/" & Year(request.form("txtCal_Event_StartDate"))
End If
LoopToNumber = (OnMonth * request.form("txtNumRecurrences")) - 1
End If
TotalRecs = request.form("txtNumRecurrences")
If TotalRecs = "" then
TotalRecs = 1000
End If
Else
OnMonth = int(request.form("txtMonthlyThirdValue"))
OnMonthCoutner = OnMonth
If request.form("txtNumRecurrences") = "" then
EventStartDate = request.form("txtCal_Event_StartDate")
RecEndDate = request.form("txtRecurrEndDate")
LoopToNumber = DateDiff("m", EventStartDate, RecEndDate) + 1
Else
EventStartDate = request.form("txtCal_Event_StartDate")
LoopToNumber = (OnMonth * request.form("txtNumRecurrences"))
End If
TotalRecs = request.form("txtNumRecurrences")
If TotalRecs = "" then
TotalRecs = 1000
End If
End If
End If
If request.form("txtCalRecurrPattern") = "YEARLY" then
Cal_RecurrType = "YEARLY"
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_Recurr", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_Recurr", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
RS.AddNew
RS("Cal_RecurrType") = "YEARLY"
RS("Cal_RecurrEndDate") = request.form("txtRecurrEndDate")
RS("Cal_RecurrEndAfterNum") = request.form("txtNumRecurrences")
RS("Cal_RecurrYearlyType") = request.form("txtYearlyRecurrType")
RS("Cal_RecurrYearlyMonth") = request.form("txtYearlyMonth")
RS("Cal_RecurrYearlyDay") = request.form("txtYearlyDayNum")
RS("Cal_RecurrYearlyFirst") = request.form("txtYearlyFirstValue")
RS("Cal_RecurrYearlySecond") = request.form("txtYearlySecondValue")
RS("Cal_RecurrYearlyThird") = request.form("txtYearlyMonth2")
RS.Update
RS.Close
Set RS=Nothing
If UseSQLServer = "YES" then
SQL = "Select Cal_RecurrID FROM Cal_Recurr ORDER BY Cal_RecurrID DESC"
Else
SQL = "Select Cal_RecurrID FROM Cal_Recurr ORDER BY Cal_RecurrID DESC"
End If
Set RS=dbc.execute(SQL)
RS.MoveFirst
Cal_EventRecurrID = RS("Cal_RecurrID")
RS.Close
Set RS=Nothing
'--------------- # of Times to Run the Loop ------------------------------------
TotalRecs = request.form("txtNumRecurrences")
If TotalRecs = "" then
TotalRecs = 1000
End If
If request.form("txtYearlyRecurrType") = "DAYOFMONTH" then
If DateFormat = "US" then
EventStartDate = request.form("txtYearlyMonth") & "/" & request.form("txtYearlyDayNum") & "/" & Year(Date())
Else
EventStartDate = request.form("txtYearlyDayNum") & "/" & request.form("txtYearlyMonth") & "/" & Year(Date())
End If
Else
If DateFormat = "US" then
EventStartDate = cDate(request.form("txtYearlyMonth2") & "/1/" & Year(Date()))
Else
EventStartDate = cDate("1/" & request.form("txtYearlyMonth2") & "/" & Year(Date()))
End If
DayNumber = WeekDay(EventStartDate)
Do While cint(DayNumber) <> cint(request.form("txtYearlySecondValue"))
EventStartDate = DateAdd("d", 1, EventStartDate)
DayNumber = WeekDay(EventStartDate)
Loop
If request.form("txtYearlyFirstValue") > 1 then
EventStartDate = DateAdd("d", ((request.form("txtYearlyFirstValue") * 7) - 7), EventStartDate)
End If
If request.form("txtYearlyFirstValue") = 5 then
If cint(request.form("txtYearlyMonth2")) <> cint(Month(EventStartDate)) then
EventStartDate = DateAdd("d", -7, EventStartDate)
End If
End If
End If
If request.form("txtNumRecurrences") = "" then
RecEndDate = request.form("txtRecurrEndDate")
LoopToNumber = DateDiff("yyyy", EventStartDate, RecEndDate) - 1
Else
LoopToNumber = request.form("txtNumRecurrences") - 1
End If
End If
Else
LoopToNumber = ""
End If
'----------- Setup the Event Variables -------------------------------------------
Cal_EventTitle = request.form("txtCal_Event_Title")
Cal_EventBody = request.form("txtCal_Event_Description")
Cal_EventStartDate = request.form("txtCal_Event_StartDate")
Cal_EventStartTime = request.form("txtCal_Event_StartTime")
Cal_EventEndDate = request.form("txtCal_Event_EndDate")
Cal_EventEndTime = request.form("txtCal_Event_EndTime")
Cal_EventAllDay = request.form("txtCal_Event_AllDay")
If request.form("txtCal_Event_AllDay") = "" then
Cal_EventAllDay = "NO"
End If
Cal_EventLink = request.form("txtCal_Event_Link")
Cal_EventImage = request.form("txtCal_Event_Image")
Cal_EventUser1 = request.form("txtCal_Event_User1")
Cal_EventUser2 = request.form("txtCal_Event_User2")
Cal_EventUser3 = request.form("txtCal_Event_User3")
Cal_EventUser4 = request.form("txtCal_Event_User4")
Cal_EventUser5 = request.form("txtCal_Event_User5")
If request.form("txtCal_Event_UserID") <> "" then
Cal_EventUserID = request.form("txtCal_Event_UserID")
Else
Cal_EventUserID = Session("Cal_User_ID")
End If
Cal_EventGroupID = request.form("txtCal_Event_GroupID")
Cal_EventInviteUsers = request.form("txt_Cal_SystemUsers")
If Session("Cal_User_RequireApproval") <> "YES" then
Cal_EventStatus = "APPROVED"
Else
If Cal_EventGroupID <> 2 then
Cal_EventStatus = "PENDING"
Else
Cal_EventStatus = "APPROVED"
End If
End If
If Cal_RecurrID <> "" OR Cal_EventGroupID <> 2 then
Cal_EventInviteUsers = ""
End If
Cal_EventInviteByID = Session("Cal_User_ID")
Cal_EventSendEmail = request.form("txt_Cal_SendEmail")
'-------------------------------------------------------------------
If LoopToNumber = "" then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
If Cal_EventInviteUsers <> "" then
Cal_EventStatus = "INVITE"
UserArray = Split(Cal_EventInviteUsers)
For I = 0 to Ubound(UserArray)
Cal_EventUserID = UserArray(I)
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
'---- Send Email to Invitees ----------
If Cal_EventSendEmail = "YES" then
If UseSQLServer = "YES" then
SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & int(Cal_EventUserID)
Else
SQLe = "SELECT Cal_User_EmailAddress FROM Cal_User WHERE Cal_User_ID = " & int(Cal_EventUserID)
End If
Set RSe=dbc.execute(SQLe)
SendTo = RSe("Cal_User_EmailAddress")
If request.form("txtPreviousEventID") <> "" then
EmailSubject = Sub38Var1
Else
EmailSubject = Sub38Var2
End If
RSe.Close
Set RSe=Nothing
If Cal_EventAllDay <> "TRUE" then
MessageToSend = Sub38Var3 & ":
" & Sub38Var5
End If
If UseEmailFunctions <> "NO" then
Call SendAnEmail(SendTo, EmailSubject, MessageToSend)
End If
End If
'--------------------------------------
Next
End If
Else
For I = 1 to LoopToNumber + 1
'-------- Daily Recurrence -------------------------------------
If request.form("txtCalRecurrPattern") = "DAILY" then
If request.form("txtDailyRecurrType") <> "EVERYWEEKDAY" then
If I > 1 then
Cal_EventStartDate = DateAdd("d", request.form("txtDailyRecurrEveryNumDays"), Cal_EventStartDate)
Cal_EventEndDate = Cal_EventStartDate
End If
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
Else
If I > 1 then
Cal_EventStartDate = DateAdd("d", 1, Cal_EventStartDate)
If WeekDay(Cal_EventStartDate) = 1 then
Cal_EventStartDate = DateAdd("d", 1, Cal_EventStartDate)
End If
If WeekDay(Cal_EventStartDate) = 7 then
Cal_EventStartDate = DateAdd("d", 2, Cal_EventStartDate)
End If
Cal_EventEndDate = Cal_EventStartDate
End If
If WeekDay(Cal_EventStartDate) >= 2 AND WeekDay(Cal_EventStartDate) <= 6 then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
End If
End If
End If
'-------- Weekly Recurrence ------------------------------------
If request.form("txtCalRecurrPattern") = "WEEKLY" then
If I > 1 then
Cal_EventStartDate = DateAdd("d", 1, Cal_EventStartDate)
Cal_EventEndDate = Cal_EventStartDate
End If
If OnWeekCounter = OnWeek then
If WeekDay(Cal_EventStartDate) = 1 AND request.form("txtWeeklyRecurrDay") = "SUNDAY" AND RecCounter < TotalRecs then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
RecCounter = RecCounter + 1
End If
If WeekDay(Cal_EventStartDate) = 2 AND request.form("txtWeeklyRecurrDay") = "MONDAY" AND RecCounter < TotalRecs then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
RecCounter = RecCounter + 1
End If
If WeekDay(Cal_EventStartDate) = 3 AND request.form("txtWeeklyRecurrDay") = "TUESDAY" AND RecCounter < TotalRecs then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
RecCounter = RecCounter + 1
End If
If WeekDay(Cal_EventStartDate) = 4 AND request.form("txtWeeklyRecurrDay") = "WEDNESDAY" AND RecCounter < TotalRecs then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
RecCounter = RecCounter + 1
End If
If WeekDay(Cal_EventStartDate) = 5 AND request.form("txtWeeklyRecurrDay") = "THURSDAY" AND RecCounter < TotalRecs then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
RecCounter = RecCounter + 1
End If
If WeekDay(Cal_EventStartDate) = 6 AND request.form("txtWeeklyRecurrDay") = "FRIDAY" AND RecCounter < TotalRecs then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
RecCounter = RecCounter + 1
End If
If WeekDay(Cal_EventStartDate) = 7 AND request.form("txtWeeklyRecurrDay") = "SATURDAY" AND RecCounter < TotalRecs then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
RecCounter = RecCounter + 1
End If
OnWeekCounter = 1
Else
OnWeekCounter = OnWeekCounter + 1
End If
End If
'-------- Monthly Recurrence ------------------------------------
If request.form("txtCalRecurrPattern") = "MONTHLY" then
If request.form("txtMonthlyRecurrType") = "DAYOFMONTH" then
If I = 1 then
Cal_EventStartDate = EventStartDate
Cal_EventEndDate = EventStartDate
End If
If I > 1 then
Cal_EventStartDate = DateAdd("m", 1, Cal_EventStartDate)
Cal_EventEndDate = Cal_EventStartDate
End If
If OnMonthCounter = OnMonth AND RecCounter < TotalRecs then
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
RecCounter = RecCounter + 1
OnMonthCounter = 1
Else
OnMonthCounter = OnMonthCounter + 1
End If
Else
If I = 1 then
Cal_EventStartDate = GetXDayOfMonth(CDate(Cal_EventStartDate), int(request.form("txtMonthlySecondValue")), int(request.form("txtMonthlyFirstValue")))
Cal_EventEndDate = Cal_EventStartDate
End If
If I > (1 + int(request.form("txtMonthlyThirdValue"))) then
Cal_EventStartDate = DateAdd("m", 1, Cal_EventStartDate)
Cal_EventEndDate = Cal_EventStartDate
End If
If OnMonthCounter = OnMonth AND RecCounter < TotalRecs then
If I > (1 + int(request.form("txtMonthlyThirdValue"))) then
Cal_EventStartDate = GetXDayOfMonth(CDate(Cal_EventStartDate), int(request.form("txtMonthlySecondValue")), int(request.form("txtMonthlyFirstValue")))
Cal_EventEndDate = Cal_EventStartDate
End If
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
RecCounter = RecCounter + 1
OnMonthCounter = 1
Else
OnMonthCounter = OnMonthCounter + 1
End If
End If
End If
'---------- Yearly Recurrence ------------------------------------
If request.form("txtCalRecurrPattern") = "YEARLY" then
If request.form("txtYearlyRecurrType") = "DAYOFMONTH" then
If I = 1 then
Cal_EventStartDate = EventStartDate
Cal_EventEndDate = EventStartDate
End If
If I > 1 then
Cal_EventStartDate = DateAdd("yyyy", 1, Cal_EventStartDate)
Cal_EventEndDate = DateAdd("yyyy", 1, Cal_EventEndDate)
End If
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
Else
If I = 1 then
Cal_EventStartDate = EventStartDate
Cal_EventEndDate = EventStartDate
End If
If I > 1 then
If DateFormat = "US" then
EventStartDate = request.form("txtYearlyMonth2") & "/1/" & Year(Date())
Else
EventStartDate = "1/" & request.form("txtYearlyMonth2") & "/" & Year(Date())
End If
EventStartDate = DateAdd("yyyy", I-1, EventStartDate)
DayNumber = WeekDay(EventStartDate)
Do While cint(DayNumber) <> cint(request.form("txtYearlySecondValue"))
EventStartDate = DateAdd("d", 1, EventStartDate)
DayNumber = WeekDay(EventStartDate)
Loop
If request.form("txtYearlyFirstValue") > 1 then
EventStartDate = DateAdd("d", ((request.form("txtYearlyFirstValue") * 7) - 7), EventStartDate)
End If
If request.form("txtYearlyFirstValue") = 5 then
If cint(request.form("txtYearlyMonth2")) <> cint(Month(EventStartDate)) then
EventStartDate = DateAdd("d", -7, EventStartDate)
End If
End If
Cal_EventStartDate = EventStartDate
Cal_EventEndDate = EventStartDate
End If
Call WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
End If
End If
Next
End If
'-------------------------------------------------------------------
If request.form("txtPreviousEventID") = "" then
response.redirect "calendar_admin.asp?action=summary&from=addeventsuccess&linktype=window&message=" & Sub38Var7 & "."
Else
If request.form("txtRecurrEdit") = "ALL" then
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_Events WHERE Cal_EventRecurrID = " & request.form("txtPreviousRecurrID")
Else
SQL = "DELETE FROM Cal_Events WHERE Cal_EventRecurrID = " & request.form("txtPreviousRecurrID")
End If
Set RS = dbc.Execute(SQL)
Set RS=Nothing
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_Recurr WHERE Cal_RecurrID = " & request.form("txtPreviousRecurrID")
Else
SQL = "DELETE FROM Cal_Recurr WHERE Cal_RecurrID = " & request.form("txtPreviousRecurrID")
End If
Set RS = dbc.Execute(SQL)
Set RS=Nothing
Else
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_Events WHERE Cal_EventID = " & request.form("txtPreviousEventID")
Else
SQL = "DELETE FROM Cal_Events WHERE Cal_EventID = " & request.form("txtPreviousEventID")
End If
Set RS = dbc.Execute(SQL)
Set RS=Nothing
End If
response.redirect "calendar_admin.asp?action=summary&from=modifyeventsuccess&linktype=window&message=" & Sub38Var8 & "."
End If
End Sub
'*********************************************************************************
'******** Write The Event to DB **************************************************
'*********************************************************************************
Sub WriteEvent(Cal_EventTitle, Cal_EventBody, Cal_EventStartDate, Cal_EventStartTime, Cal_EventEndDate, Cal_EventEndTime, Cal_EventAllDay, Cal_EventRecurrID, Cal_EventLink, Cal_EventImage, Cal_EventUser1, Cal_EventUser2, Cal_EventUser3, Cal_EventUser4, Cal_EventUser5, Cal_EventUserID, Cal_EventGroupID, Cal_EventInviteUsers, Cal_EventInviteByID, Cal_EventStatus)
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_Events", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_Events", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
RS.AddNew
RS("Cal_EventTitle") = Cal_EventTitle
RS("Cal_EventBody") = Cal_EventBody
RS("Cal_EventStartDate") = Cal_EventStartDate
RS("Cal_EventStartTime") = Cal_EventStartTime
RS("Cal_EventEndDate") = Cal_EventEndDate
RS("Cal_EventEndTime") = Cal_EventEndTime
RS("Cal_EventAllDay") = Cal_EventAllDay
RS("Cal_EventRecurrID") = Cal_EventRecurrID
RS("Cal_EventLink") = Cal_EventLink
RS("Cal_EventImage") = Cal_EventImage
RS("Cal_EventUser1") = Cal_EventUser1
RS("Cal_EventUser2") = Cal_EventUser2
RS("Cal_EventUser3") = Cal_EventUser3
RS("Cal_EventUser4") = Cal_EventUser4
RS("Cal_EventUser5") = Cal_EventUser5
RS("Cal_EventUserID") = Cal_EventUserID
RS("Cal_EventGroupID") = Cal_EventGroupID
RS("Cal_EventInviteUsers") = Cal_EventInviteUsers
RS("Cal_EventInviteByID") = Cal_EventInviteByID
RS("Cal_EventStatus") = Cal_EventStatus
RS.Update
RS.Close
Set RS=Nothing
End Sub
'*********************************************************************************
'******** Delete Event ***********************************************************
'*********************************************************************************
Sub DeleteEvent
If UseSQLServer = "YES" then
SQLz = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventid")
Else
SQLz = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventid")
End If
Set RSz=dbc.execute(SQLz)
response.write "
"
response.write "
"
response.write "
"
response.write "
" & Sub39Var1 & " " & Sub39Var2 & ":
"
response.write "
"
response.write "
"
response.write "
"
If RSz("Cal_EventRecurrID") <> "" AND request.querystring("recurredit") = "" then
response.write "
"
If Sum_LinkType = "window" then
response.write ""
Else
response.write "" & Sub41Var14 & ""
End If
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
End Sub
'**********************************************************************************
'**********************************************************************************
'**********************************************************************************
'**********************************************************************************
'**********************************************************************************
Sub DrawWindowHeader(Window_Message, Window_Message2, Window_Action, Window_Icon)
response.write "
"
response.write "
"
response.write "
"
response.write "
" & Window_Message & " " & Window_Message2 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
response.write "
"
response.write "
"
response.write "
"
End Sub
Sub CreateTimeDropDown(TimeToWrite, PartOfDay, WhichField)
If TimeFormatToUse = "12" then
If TimeToWrite <> "12" then
response.write ""
response.write ""
response.write ""
response.write ""
Else
If PartOfDay = "AM" then
response.write ""
response.write ""
response.write ""
response.write ""
Else
response.write ""
End If
End If
Else
If TimeToWrite <> "12" then
response.write ""
response.write ""
response.write ""
response.write ""
Else
response.write ">" & TimeToWrite & ":00 "
response.write ""
response.write ""
response.write ""
End If
Else
response.write ">" & cint(TimeToWrite) + 12 & ":00 "
response.write ""
response.write ""
response.write ""
End If
Else
If PartOfDay = "AM" then
response.write ""
response.write ""
response.write ""
response.write ""
Else
response.write ""
End If
End If
End If
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
'*********************************************************************************
'******** Upload A File **********************************************************
'*********************************************************************************
Sub UploadFile
formname = request.querystring("form")
elementname = request.querystring("element")
%>
<%
response.write ""
response.write "
"
response.write "
"
response.write "
" & Sub44Var1 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write ""
End Sub
'*********************************************************************************
'******** Upload File Process ****************************************************
'*********************************************************************************
Sub UploadFileProcess
Dim Uploader, File
Set Uploader = New FileUploader
formname = request.querystring("form")
elementname = request.querystring("element")
%>
<%
response.write ""
response.write "
"
response.write "
"
response.write "
" & Sub45Var1 & "
"
response.write "
"
response.write "
"
Uploader.Upload()
If Uploader.Files.Count = 0 Then
Response.Write Sub45Var2 & "."
Else
For Each File In Uploader.Files.Items
File.SaveToDisk FileDirectory
Next
response.write "" & Sub45Var3 & " "
response.write "
onClick="calpopulate('<% response.write Session("frFileName") %>')" return false;
<%
response.write ">" & Sub45Var4 & ""
End If
End Sub
'*********************************************************************************
'******** Modify Config **********************************************************
'*********************************************************************************
Sub ModifyConfig
Call DrawWindowHeader(Sub46Var1, " " & Sub46Var2 & ":", "calendar_admin.asp?action=modifyconfigprocess", SkinFolder & "popup_head_config.gif")
If UseSQLServer = "YES" then
SQL = "SELECT * FROM Cal_Config"
Else
SQL = "SELECT * FROM Cal_Config"
End If
Set RS=dbc.execute(SQL)
response.write "
"
response.write ""
Set RS=Server.CreateObject("ADODB.RecordSet")
If UseSQLServer = "YES" then
RS.Open "SELECT * FROM Cal_Events WHERE Cal_EventStatus = 'PENDING' AND Cal_EventGroupID <> 2 ORDER BY Cal_EventStartDate DESC", dbc, adOpenDynamic, adLockPessimistic, adCMDText
Else
RS.Open "SELECT * FROM Cal_Events WHERE Cal_EventStatus = 'PENDING' AND Cal_EventGroupID <> 2 ORDER BY Cal_EventStartDate DESC", dbc, adOpenDynamic, adLockPessimistic, adCMDText
End If
response.write "
"
response.write "
" & Sub52Var3 & "
"
response.write "
"
If NOT RS.EOF then
response.write "
"
response.write "
"
Else
response.write "
"
response.write "
" & Sub52Var8 & "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
End If
RS.CLOSE
SET RS=Nothing
response.write ""
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
response.write "
"
End Sub
'*********************************************************************************
'******** Approve Events *********************************************************
'*********************************************************************************
Sub ApproveEventsProcess
If request.form("txtApproveEvents") <> "" then
If UseSQLServer = "YES" then
SQL = "UPDATE Cal_Events SET Cal_EventStatus = 'APPROVED' WHERE Cal_EventID IN("&request.form("txtApproveEvents")&")"
Else
SQL = "UPDATE Cal_Events SET Cal_EventStatus = 'APPROVED' WHERE Cal_EventID IN("&request.form("txtApproveEvents")&")"
End If
Set RS = dbc.Execute(SQL)
End If
If request.form("txtDeleteEvents") <> "" then
If UseSQLServer = "YES" then
SQL = "DELETE FROM Cal_Events WHERE Cal_EventID IN("& request.form("txtDeleteEvents") &")"
Else
SQL = "DELETE FROM Cal_Events WHERE Cal_EventID IN("& request.form("txtDeleteEvents") &")"
End If
Set RS = dbc.Execute(SQL)
End If
response.redirect "calendar_admin.asp?action=summary&from=approveevents&linktype=window&message=" & Sub53Var1 & "."
End Sub
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'************************* Functions Below Here Only *****************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'******* Check Security **********************************************************
Sub CheckSecurity
If Session("Cal_User_RightsLevel") <> 1 then
response.redirect "calendar_admin.asp?action=summary&from=notallowed&linktype=window&message=" & Sub48Var1 & "."
End If
End Sub
'******* Check for Email Components **********************************************
Sub HasEmailComponent
Err.Clear
On Error Resume Next
Set EmailComp = Server.CreateObject("CDONTS.NewMail")
If Err.Number = 0 Then
Session("HasCDONTS") = "YES"
Else
Session("HasCDONTS") = "NO"
End If
Set EmailComp = Nothing
On Error Goto 0
Err.Clear
On Error Resume Next
Set EmailComp = Server.CreateObject("Persits.MailSender")
If Err.Number = 0 Then
Session("HasASPEmail") = "YES"
Else
Session("HasASPEmail") = "NO"
End If
Set EmailComp = Nothing
On Error Goto 0
Err.Clear
On Error Resume Next
Set EmailComp = Server.CreateObject("JMail.Message")
If Err.Number = 0 Then
Session("HasJMail") = "YES"
Else
Session("HasJMail") = "NO"
End If
Set EmailComp = Nothing
On Error Goto 0
Err.Clear
On Error Resume Next
Set EmailComp = Server.CreateObject("SMTPsvg.Mailer")
If Err.Number = 0 Then
Session("HasASPMail") = "YES"
Else
Session("HasASPMail") = "NO"
End If
Set EmailComp = Nothing
On Error Goto 0
End Sub
'******* 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
'******* 24 hour to 12 hour time ***********************************************
Function StandardTime(time)
dim hour
dim minute
dim clocktime
hour = left(time, 2)
minute = left(time, 5)
minute = right(minute, 2)
If left(hour, 1) = "0" then
hour = right(hour, 1)
End If
If hour <= 12 then
clocktime = hour & ":" & minute & " AM"
Else
hour = hour - 12
clocktime = hour & ":" & minute & " PM"
End If
StandardTime = clocktime
End Function
'******* Get X DayName from a given date *****************************************
Function GetXDayOfMonth(CurrentDate, DayNeeded, Xth)
NumberOfDay = 0
CurrentMonth = Month(CurrentDate)
CurrentYear = Year(CurrentDate)
FirstDayOfMonth = CDate(CurrentMonth & "/1/" & CurrentYear)
ReturnValue = FirstDayOfMonth
Counter = 1
Do While ExitLoop <> "YES"
If Counter <> 1 then
ReturnValue = DateAdd("d", 1, ReturnValue)
End If
If WeekDay(ReturnValue) = DayNeeded then
NumberOfDay = NumberOfDay + 1
If NumberOfDay = Xth then
ExitLoop = "YES"
End If
End If
Counter = Counter + 1
Loop
If Xth = 5 then
If Month(ReturnValue) <> Month(CurrentDate) then
ReturnValue = DateAdd("d", -7, ReturnValue)
End If
End If
GetXDayOfMonth = ReturnValue
End Function
'******* Fix String Function *****************************************************
Function FixString(strSource)
strSource = Replace(strSource, "'", "''")
strSource = Replace(strSource, "''''", "''")
FixString = Replace(strSource, "'''", "''")
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
'******* 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
%>