<%
' #################################
public function CAL_EVENT_ADD()
dim sH : sH = ""
dim SqlEvent
dim StartDate
dim EndDate
dim SqlEventrec
dim IDCat
dim ViewTab
dim EFIDRecur
dim EFAction
dim EFRecurentView
dim dtText
dim TimeFrom
dim TimeTo
dim Grouppublic
dim Test
dim Places
dim strOUT
dim strHEADER
dim i
StartDate = date()
EndDate = date()
sH = sH & "" &VbCrLf
strHEADER = strHEADER & application(session("LANG") & "_wcal20")
sH = sH & "" & VbCrLf
CAL_EVENT_ADD = funcs.BOXCreator(strHEADER, sH, strDEFTHEME, "", "99%")
end function
' #################################
public function CAL_RecVal
dim RecurentVal
' RecurentVal
select case request.form("SelType")
case 1 RecurentVal = "1;" & request.form("DAILY_repeat")
case 2 RecurentVal = "2;" & request.form("WEEKLY_repeat") & ";" & request.form("WEEKLY_DAY")
case 3
if request.form("MONTHLY_SELtype")="EVERY" then
RecurentVal = "3;" & request.form("MONTHLY_SELtype") & ";" & request.form("MONTHLY_repeat1") & ";" & request.form("MONTHLY_DAY1")
else
RecurentVal = "3;" & request.form("MONTHLY_SELtype") & ";" & request.form("MONTHLY_repeat2") & ";" & request.form("MONTHLY_DAY2") & ";" & request.form("MONTHLY_repeat2")
end if
case 4
if request.form("YEARLY_SELtype")="EVERY" then
RecurentVal = "4;" & request.form("YEARLY_SELtype") & ";" & request.form("YEARLY_DAYrepeat1") & ";" & request.form("YEARLY_MONTHrepeat1")
else
RecurentVal = "4;" & request.form("YEARLY_SELtype") & ";" & request.form("YEARLY_DAYrepeat2") & ";" & request.form("YEARLY_MONTHrepeat2") & ";" & request.form("YEARLY_DAY2")
end if
case "5"
RecurentVal = "5;" & request.form("Unusual")
case ELSE RecurentVal = "0"
end select
CAL_RecVal= RecurentVal
end function
' #################################
public function CAL_RepeatEvent(LastID)
dim sD
sD=request("DATEFROM")
if intDateFormat=1 then
StartDate = dateserial(right(sD,4), mid(sD,4,2), left(sD,2))
' Is there any recurence
if isempty(request("DATETO")) OR IsNull(request("DATETO")) OR request("DATETO")="" then
EndDate = StartDate
else
sD=request("DATETO")
EndDate = dateserial(right(sD,4), mid(sD,4,2), left(sD,2))
end if
else
StartDate = dateserial(right(sD,4), left(sD,2), mid(sD,4,2))
' Is there any recurence
if isempty(request("DATETO")) OR IsNull(request("DATETO")) OR request("DATETO")="" then
EndDate = StartDate
else
sD=request("DATETO")
EndDate = dateserial(right(sD,4), left(sD,2), mid(sD,4,2))
end if
end if
' If there is date difference
if StartDate<> EndDate then
' REPEATING
I = cdate(StartDate)
select case request.form("SelType")
case 1 '"DAILY"
intStep = request.form("DAILY_repeat")
do until I >= EndDate
FoundDate = cdate(I)
if NOT( (weekday(FoundDate, session("FirstDayOfWeek")) = VbSaturday or weekday(FoundDate, session("FirstDayOfWeek")) = VbSunday) AND WorkingDays) then
strSQL = "INSERT INTO wcal_eventrec (IDEvent, EventDate, StartTime, EndTime, Client, Lang) values ("
strSQL =strSQL & LastID & ", " & funcs.VDate(FoundDate) & ",'" & request("StartTime") & "','" & request("EndTime")& "'," & session("Client") & "," & session("LANG") & ")"
my_conn.execute(strSQL)
I=dateAdd("D", intStep, I)
else
' skip weekends
I=dateAdd("D", 1, I)
end if
loop
case 2 '"WEEKLY"
intStep = clng(request.form("WEEKLY_repeat"))
DaysArray = split(request.form("WEEKLY_DAY"),",")
do until I >= EndDate
for each Days in DaysArray
FoundDate = CAL_searchDate(I, Days)
' response.write WeekdayName(weekday(FoundDate, session("FirstDayOfWeek")), False, session("FirstDayOfWeek")) & "-" & FoundDate & " "
strSQL = "INSERT INTO wcal_eventrec (IDEvent, EventDate, StartTime, EndTime, Client, Lang) values ("
strSQL =strSQL & LastID & ", " & funcs.VDate(FoundDate) & ",'" & request("StartTime") & "','" & request("EndTime")& "'," & session("Client") & "," & session("LANG") & ")"
my_conn.execute(strSQL)
next
I=dateAdd("WW", intStep, I)
loop
case 3 '"MONTHLY"
strCASETYPE = request.form("MONTHLY_SELtype")
I = dateSerial(year(I), month(I),1)
select case strCASETYPE
case "EVERY"
intStep = request.form("MONTHLY_repeat1")
xDay = request.form("MONTHLY_DAY1")
do until I >= EndDate
FoundDate = dateSerial(year(I), Month(I), xDay)
if FoundDate>=StartDate then
' response.write WeekdayName(weekday(FoundDate, session("FirstDayOfWeek")), False, session("FirstDayOfWeek")) & "-" & FoundDate & " "
strSQL = "INSERT INTO wcal_eventrec (IDEvent, EventDate, StartTime, EndTime, Client, Lang) values ("
strSQL =strSQL & LastID & ", " & funcs.VDate(FoundDate) & ",'" & request("StartTime") & "','" & request("EndTime")& "'," & session("Client") & "," & session("LANG") & ")"
my_conn.execute(strSQL)
end if
I=dateAdd("M", intStep, I)
loop
case "EACH"
intStep = request.form("MONTHLY_repeat2")
xDay = request.form("MONTHLY_DAYrepeat")
DaysArray = split(request.form("MONTHLY_DAY2"),",")
' xDay - event repeats on 1.,2.,3. ... X-tý day(s) of the month
J = I
for each Days in DaysArray
I=J
do until I >= EndDate
' We are going to find specific day of the month
FoundDate = CAL_searchDate(dateAdd("W", (xDay-1)*7, I), Days)
if FoundDate>=StartDate then
' response.write WeekdayName(weekday(FoundDate, session("FirstDayOfWeek")), False, session("FirstDayOfWeek")) & "-" & FoundDate & " "
strSQL = "INSERT INTO wcal_eventrec (IDEvent, EventDate, StartTime, EndTime, Client, Lang) values ("
strSQL =strSQL & LastID & ", " & funcs.VDate(FoundDate) & ",'" & request("StartTime") & "','" & request("EndTime")& "'," & session("Client") & "," & session("LANG") & ")"
my_conn.execute(strSQL)
end if
I=dateAdd("M", intStep, I)
loop
next
end select
case 4 ' "YEARLY"
strCASETYPE = request.form("YEARLY_SELtype")
select case strCASETYPE
case "EVERY"
I = dateSerial(year(StartDate), request.form("YEARLY_MONTHRepeat1"),request.form("YEARLY_DAYRepeat1"))
do until I >= EndDate
if I>StartDate then
' response.write WeekdayName(weekday(FoundDate, session("FirstDayOfWeek")), False, session("FirstDayOfWeek")) & "-" & FoundDate & " "
strSQL = "INSERT INTO wcal_eventrec (IDEvent, EventDate, StartTime, EndTime, Client, Lang) values ("
strSQL =strSQL & LastID & ", " & funcs.VDate(I) & ",'" & request("StartTime") & "','" & request("EndTime")& "'," & session("Client") & "," & session("LANG") & ")"
my_conn.execute(strSQL)
end if
I=dateAdd("YYYY", 1, I)
loop
case "EACH"
xDay = request.form("YEARLY_DAYrepeat2")
DaysArray = split(request.form("YEARLY_DAY2"),",")
I = dateSerial(year(StartDate), request.form("YEARLY_MONTHRepeat2"), 1)
' xDay - event repeats on 1.,2.,3. ... X-tý day(s) of the month
J = I
for each Days in DaysArray
I=J
do until I >= EndDate
' We are going to find specific day of the month
FoundDate = CAL_searchDate(dateAdd("W", (xDay-1)*7, I), Days)
if FoundDate>=StartDate then
' response.write WeekdayName(weekday(FoundDate, session("FirstDayOfWeek")), False, session("FirstDayOfWeek")) & "-" & FoundDate & " "
strSQL = "INSERT INTO wcal_eventrec (IDEvent, EventDate, StartTime, EndTime, Client, Lang) values ("
strSQL =strSQL & LastID & ", " & funcs.VDate(FoundDate) & ",'" & request("StartTime") & "','" & request("EndTime")& "'," & session("Client") & "," & session("LANG") & ")"
my_conn.execute(strSQL)
end if
I=dateAdd("YYYY", 1, I)
loop
next
end select
strStepDates = "YYYY"
case 5 ' UnUsual
dim dtUNUSUAL
dim itemUNUSUAL
dtUNUSUAL = split(request.form("UnUsual"),VbCrLf)
for each itemUNUSUAL in dtUNUSUAL
if IsDate(itemUNUSUAL) then
strSQL = "INSERT INTO wcal_eventrec (IDEvent, EventDate, StartTime, EndTime, Client, Lang) values (" & LastID & ", " & funcs.VDate(itemUNUSUAL) & ",'" & request("StartTime") & "','" & request("EndTime") & "'," & session("Client") & "," & session("LANG") & ")"
my_conn.execute(strSQL)
end if
next
case ELSE
strSQL = "INSERT INTO wcal_eventrec (IDEvent, EventDate, StartTime, EndTime, Client, Lang) values (" & LastID & ", " & funcs.VDate(StartDate) & ",'" & request("StartTime") & "','" & request("EndTime") & "'," & session("Client") & "," & session("LANG") & ")"
my_conn.execute(strSQL)
end select
else
strSQL = "INSERT INTO wcal_eventrec (IDEvent, EventDate, StartTime, EndTime, Client, Lang) values (" & LastID & ", " & funcs.VDate(StartDate) & ",'" & request("StartTime") & "','" & request("EndTime") & "'," & session("Client") & "," & session("LANG") & ")"
my_conn.execute(strSQL)
end if
end function
' #################################
public function CAL_EVENT_ADDEXE()
dim Grouppublic
dim UserPrivate
dim StartDate
dim EndDate
dim StrMessageEvent
dim LastID
dim value
dim pom
dim DiffStr
dim DiffVal
dim ThisDate
dim Help
dim AletrTEXT
if EmailTESTINC then
if session("WCAL_USERID")=0 then session("WCAL_USERID")=-1
' We will check Time format and validity
if TimeCheck(AletrTEXT) then
CAL_EVENT_ADDEXE = funcs.ShowMessage(application(session("LANG") & "_wcal70") & VbCrLf & AletrTEXT)
exit function
end if
' We will check Date format and validity
if DatesCheck(AletrTEXT) then
CAL_EVENT_ADDEXE = funcs.ShowMessage(application(session("LANG") & "_wcal69") & VbCrLf & AletrTEXT)
exit function
end if
' Is there any colission event
session("COUNT_EVENT")=0
if CAL_ColissionCheck(AletrTEXT) then
CAL_EVENT_ADDEXE = funcs.ShowMessage(application(session("LANG") & "_wcal58") & VbCrLf & AletrTEXT)
exit function
end if
if session("COUNT_EVENT")>intMaxEventsPosted then
dim strMESSAGE
strMESSAGE = application(session("LANG") & "_wcal58a") & VbCrLf & replace(application(session("LANG") & "_wcal58b"), "XXX", intMaxEventsPosted)
strMESSAGE = replace(strMESSAGE, "YYY", session("COUNT_EVENT"))
session("COUNT_EVENT")=""
CAL_EVENT_ADDEXE = funcs.ShowMessage(strMESSAGE)
exit function
end if
UserPrivate = 0
Grouppublic = "-" & replace(request.form("Grouppublic"),", ","-,-") & "-"
if NOT IsEmpty(request("UserPrivate")) then UserPrivate = session("WCAL_USERID")
dim strPLACE
' we will add new location into DB
if request.form("NEWPLACE")<>"" then
strPLACE = request.form("NEWPLACE")
strSQL= "INSERT INTO wcal_location (Location, Client, Lang) values ("&_
"'" & funcs.sqlencode(request.form("NEWPLACE")) & "', " &_
"" & session("Client") & ", " &_
"" & session("Lang") & ") "
my_conn.execute(strSQL)
else
strPLACE = request.form("PLACE")
end if
' Create SQL string to add new event
strSql = "INSERT INTO wcal_events (EventName, Description, Cust1, Cust2, Cust3, "&_
"Cust4, Cust5, IDUSer, Place, UrlName, " &_
"URLLink, ContactEmail, ContactEmailDesc, Recurentval, ExcludeConflict, "&_
"Client, Lang, UserPrivate) Values (" &_
"'" & funcs.SQLEncode(request("EventName")) & "', " &_
"'" & funcs.SQLEncode(request("BodyText")) & "', " &_
"'" & funcs.SQLEncode(request("Cust1")) & "', " &_
"'" & funcs.SQLEncode(request("Cust2")) & "', " &_
"'" & funcs.SQLEncode(request("Cust3")) & "', " &_
"'" & funcs.SQLEncode(request("Cust4")) & "', " &_
"'" & funcs.SQLEncode(request("Cust5")) & "', " &_
"'" & session("WCAL_USERID") & "', " &_
"'" & funcs.SQLEncode(strPlace) & "', " &_
"'" & funcs.SQLEncode(request("URLName")) & "', " &_
"'" & request("URL") & "', " &_
"'" & request("Email") & "', " &_
"'" & request("ContactEmailDesc") & "', " &_
"'" & CAL_RecVal() & "', " &_
"" & clng(request("ExcludeConflict")) & ", " &_
"" & session("Client") & ", " &_
"" & session("LANG") & ", " &_
"'" & UserPrivate & "') "
' execute command
my_conn.Execute (StrSql)
' Create SQL string to add new event
StartDate = cdate(request("DATEFROM"))
session("StartDAY") = StartDate
' Create message string for outgoing messages
' Edit this for your own (Part 1)
if MAILOBJ.HTMLFormat then
' ============================================================
StrMessageEvent = ""
StrMessageEvent = StrMessageEvent & "Event Name: " & request("EventName") & " " & VbCRLf
StrMessageEvent = StrMessageEvent & "Description: " & request("BodyText") & " " & VbCRLf
StrMessageEvent = StrMessageEvent & "Place: " & request("Place") & " " & VbCRLf
StrMessageEvent = StrMessageEvent & "EventDate: " & StartDate & " " & VbCRLf
StrMessageEvent = StrMessageEvent & "More information " & VbCRLf
' ============================================================
else
' ============================================================
StrMessageEvent = ""
StrMessageEvent = StrMessageEvent & "Event Name: " & request("EventName") & VbCRLf
StrMessageEvent = StrMessageEvent & "Description: " & request("BodyText") & VbCRLf
StrMessageEvent = StrMessageEvent & "Place: " & request("Place") & VbCRLf
StrMessageEvent = StrMessageEvent & "EventDate: " & StartDate & VbCRLf
StrMessageEvent = StrMessageEvent & ServerAddress&"?Client=" & session("Client") & "&Lang=" & Session("LANG") & "&DoAction=Calendar&View=Day&Q_DATE="&funcs.QryDate(StartDate) & VbCRLf
' ============================================================
end if
'Find out ID of new event
LastID = my_conn.execute("SELECT max(IDEvent) as LastID from wcal_events where IDUser = " & session("WCAL_USERID"))("LastID")
' looping - adding new items into category×event table
' - sending messages to subscribers
for each value in request("wcal_category")
' We need to know what type of category is
dim CatType
CatType = my_conn.execute("SELECT CatType from wcal_category where IDCat=" & value)("CatType")
' Update Category vs Event table (This table allows us to have multiple category events)
my_conn.execute("INSERT INTO wcal_eventcat (IDEvent, IDCat, CatType) values (" & LastID & ", " & value & "," & CatType & ")")
' if It is HOLIDAY Type (CatType=3); we have to CHANGE event place to HOLIDAYS
if CatType=3 then my_conn.execute("UPDATE wcal_events set Place='" & application(session("LANG") & "_wcal102") & "' where IDEvent=" & LastID)
' send message feature
' this will be execute only if this event is public UserPrivate=0
if UserPrivate=0 then call CAL_SendNewsletter(value,StrMessageEvent)
next
call CAL_RepeatEvent(LastID)
' Update descriptions in repeating
strSQL="UPDATE wcal_eventrec set Description='" & funcs.SQLEncode(request("BodyText")) & "'where IDEvent=" & LastID
my_conn.execute(strSQL)
end if
if session("WCAL_USERID")=-1 then
CAL_EVENT_ADDEXE=funcs.ShowMessage(application(session("LANG") & "_wcal45a") & ";;" & application(session("LANG") & "_wcal45c"))
else
CAL_EVENT_ADDEXE=funcs.ShowMessage(application(session("LANG") & "_wcal45b")) 'Event has been added
end if
if session("WCAL_USERID")=-1 then CAL_UNCERTEVENT_NOTE()
if request("SUBM")="OK" then
CAL_EVENT_ADDEXE = CAL_EVENT_ADDEXE & ""
end if
end function
' #################################
public function CAL_searchDate(byval dtStartDate, FindWeekDay)
Do Until WeekDay(dtStartDate, session("FirstDayOfWeek")) = clng(FindWeekDay)
dtStartDate = DateAdd("D", 1, dtStartDate)
Loop
CAL_searchDate = dtStartDate
End Function
' #################################
public function CAL_SendNewsletter(IDCat,StrMessageEvent)
' function for sending messages foe subscribers
' select subscribers assigned in specified category
dim Subscribers
dim Email
dim Password
dim strMessage
dim strSubject
set Subscribers = my_conn.execute("SELECT * from wcal_subscribers left join wcal_subscriberscats ON wcal_subscribers.IDSubscriber=wcal_subscriberscats.IDSubscriber where wcal_subscriberscats.IDCat=" & IDCat)
strSQL = "SELECT * from wcal_subscribers left join wcal_subscriberscats ON wcal_subscribers.IDSubscriber=wcal_subscriberscats.IDSubscriber where wcal_subscriberscats.IDCat=" & IDCat
set Subscribers = Server.CreateObject("ADODB.Recordset")
Subscribers.CursorLocation = 3
Subscribers.Open strSql, my_conn
Subscribers.CacheSize = 100
if not (Subscribers.BOF or Subscribers.EOF) then
do until Subscribers.EOF
' subscribers info
Email = Subscribers("Email")
SubsPassword = Subscribers("SubsPassword")
' create message body
' Edit this for your own (Part 2)
' ============================================================
strSubject = "New event in calendar system"
if MAILOBJ.HTMLFormat then
strMessage = "" & StrMessageEvent & ""
if blSUBSCRIBER_ADDINFO then
strMessage = strMessage & "Someone probable you have registered for newsletter from WebEcalendar system at " & ServerAddress&". " & VbCrLf
strMessage = strMessage & "Your subscription information is: " & Email & " " & VbCrLf
strMessage = strMessage & " and password:" & SubsPassword & "." & " " & VbCrLf
end if
strMessage = strMessage & "If you want to be removed please follow the link bellow." & " " & VbCrLf
strMessage = strMessage & "UNSUBSCRIBE" & " " & VbCrLf
' ============================================================
else
strMessage = VbCrLf & StrMessageEvent & VbCrLf
if blSUBSCRIBER_ADDINFO then
strMessage = strMessage & "Someone probable you have registered for newsletter from WebEcalendar system at " & ServerAddress&". " & VbCrLf
strMessage = strMessage & "Your subscription information is: " & Email & VbCrLf
strMessage = strMessage & " and password:" & SubsPassword & "." & VbCrLf
end if
strMessage = strMessage & "If you want to be removed please follow the link bellow." & VbCrLf
strMessage = strMessage & "UNSUBSCRIBE: " & ServerAddress & "?Client=" & session("Client") & "&Lang=" & Session("LANG") & "&DoAction=Calendar&CHANGE=UnSubscribeExe&Email="&Email &"&SubsPassword="& SubsPassword & VbCrLf
' ============================================================
end if
if IsObject(MAILOBJ) then
' MAILOBJ.Sender = strDefaultEmail
MAILOBJ.Recepient = Email
MAILOBJ.Subject = strSubject
MAILOBJ.Message = strMessage
MAILOBJ.Send()
end if
Subscribers.MoveNext
Loop
end if
Subscribers.Close
set Subscribers = nothing
end function
' #################################
Function TrimHTML (lstrHTML)
Dim RegX
Dim MyString, SearchPattern, ReplacedText
Set RegX = NEW RegExp
SearchPattern = "(<[^>]*>)"
ReplaceString = ""
RegX.Pattern = SearchPattern
RegX.Global = True
RegX.IgnoreCase = True
TrimHTML = RegX.Replace(lstrHTML, ReplaceString)
Set RegX = Nothing
End function
' #################################
Public Function CAL_UNCERTEVENT_NOTE()
dim strSQL, strSubject, strMessage, Notify
strSQL = "SELECT IDUser, Email FROM wcal_Users WHERE Wcal_Permission = 1"
strSubject = "WebCalendar - New ucertified event"
set Notify = Server.CreateObject("ADODB.Recordset")
Notify.CursorLocation = 3
Notify.Open strSQL, my_conn
Notify.CacheSize = 100
if NOT (Notify.BOF or Notify.EOF) then
do until Notify.EOF
if IsObject(MAILOBJ) then
if MAILOBJ.HTMLFormat then
strMessage = "
Someone has inserted new uncertified event to WebCalendar system at " & ServerAddress & "." & VbCrLf
strMessage = strMessage & CAL_EVENT_LIST("VALIDATE", Notify("IDUser"))
else
strMessage = "Someone has inserted new uncertified event to WebCalendar system at " & ServerAddress & "." & VbCrLf
strMessage = strMessage & "If you want to validate or delete this event, please login to WebCalendar system and choose List of uncertified events." & VbCrLf
strMessage = strMessage & TrimHTML(CAL_EVENT_LIST("VALIDATE", Notify("IDUser")))
end if
strMessage = replace(strMessage,EmailValidatePath,ServerAddress)
strMessage = replace(strMessage,"ADMIN.asp","calendar.asp")
MAILOBJ.Recepient = Notify("Email")
MAILOBJ.Subject = strSubject
MAILOBJ.Message = strMessage
MAILOBJ.Send()
end if
Notify.MoveNext
loop
end if
Notify.Close
set Notify = nothing
End Function
%>