<%
' #################################
public Function CAL_SUBSCRIBER_ADD()
dim sH : sH = ""
dim Categories
sH = sH & "" & VbCrLf
sH = sH & "" & VbCrLf
sH = sH & "" & VbCrLf
sH = sH & "
" & VbCrLf
CAL_SUBSCRIBER_ADD= funcs.BOXCreator(application(session("LANG") & "_wcal66"), sH, strDEFTHEME, "", "90%")
end Function
' #################################
public Function CAL_SUBSCRIBER_ADDEXE
dim sH : sH = ""
dim SubsID, MaxID, strSubject, strMessage, ID, strSQL, lock
if EmailTESTINC then
strSQL = "select IDSubscriber, Validate from wcal_subscribers where Email='" & request("Email") & "'"
set SubsID = Server.CreateObject("ADODB.Recordset")
SubsID.CursorLocation = 3
SubsID.Open strSQL, my_conn
SubsID.CacheSize = 100
if (SubsID.BOF or SubsID.EOF) then
lock = false
else
lock = SubsID("Validate")
end if
if not (SubsID.BOF or SubsID.EOF or lock) then
my_conn.execute("delete from wcal_subscriberscats where IDSubscriber=" & SubsID("IDSubscriber"))
my_conn.execute("delete from wcal_subscribers where IDSubscriber=" & SubsID("IDSubscriber"))
end if
if (lock) then
sH = sH & application(session("LANG") & "_wcal110")
elseif (lock = false) then
my_conn.execute("INSERT INTO wcal_subscribers (Email, SubsPassword) values ('" & request("Email") & "', '" & request("SubsPassword") & "')")
MaxID = my_conn.execute("Select IDSubscriber from wcal_subscribers where Email='" & request("Email") & "' AND SubsPassword='" & request("SubsPassword") & "'")("IDSubscriber")
for each ID in request.form("SUBSwcal_category")
my_conn.execute("INSERT INTO wcal_subscriberscats (IDSubscriber, IDCat) Values (" & clng(MaxID) & ", " & clng(ID) & ")")
next
sH = sH & "" & application(session("LANG") & "_wcal61") & "
"
sH = sH & "" & application(session("LANG") & "_wcal62") & ""
'send info
strMessage = ""
strSubject = "Subscribtion confirmation"
if MAILOBJ.HTMLFormat then
strMessage = strMessage & "Someone probable you have registered for newsletter from WebCalendar system at " & ServerAddress&".
" & VbCrLf
strMessage = strMessage & "Your subscription information is: " & request("Email") & "
" & VbCrLf
strMessage = strMessage & " and password:" & request("SubsPassword") & "." & "
" & VbCrLf
strMessage = strMessage & "If you want to be removed please follow the link bellow." & "
" & VbCrLf
strMessage = strMessage & "UNSUBSCRIBE" & "
" & VbCrLf
else
strMessage = strMessage & "Someone probable you have registered for newsletter from WebCalendar system at " & ServerAddress&"." & VbCrLf
strMessage = strMessage & "Your subscription information is: " & request("Email") & VbCrLf
strMessage = strMessage & "and password:" & request("SubsPassword") & "." & VbCrLf
strMessage = strMessage & "If you want to be removed please follow the link bellow." & VbCrLf & VbCrLf & VbCrLf
strMessage = strMessage & "UNSUBSCRIBE:"
strMessage = strMessage & ""&ServerAddress & "?Client=" & session("Client") & "&Lang=" & Session("LANG") & "&DoAction=Calendar&CHANGE=UnSubscribeExe&Email="&request("Email") &"&SubsPassword="& request("SubsPassword") & VbCrLf
strMessage = strMessage & VbCrLf
end if
if IsObject(MAILOBJ) then
MAILOBJ.Recepient = request("Email")
MAILOBJ.Subject = strSubject
MAILOBJ.Message = strMessage
MAILOBJ.Send()
end if
end if
SubsID.Close
set SubsID = nothing
end if
CAL_SUBSCRIBER_ADDEXE = sH
end Function
' #################################
public function CAL_SUBSCRIBER_UNSUBSCRIBE
dim sH : sH = ""
sH = sH & "" & VbCrLf
sH = sH & "" & VbCrLf
sH = sH & "
" & VbCrLf
CAL_SUBSCRIBER_UNSUBSCRIBE = funcs.BOXCreator(application(session("LANG") & "_wcal67"), sH, strDEFTHEME, "", "90%")
end Function
' #################################
public function CAL_SUBSCRIBER_UNSUBSCRIBEEXE
dim sH : sH = ""
dim SubsID, strMessage, strSubject
if EmailTESTINC then
strSQL = "select * from wcal_subscribers where Email='" & request("Email") & "' AND SubsPassword='" & request("SubsPassword") & "'"
set SubsID = Server.CreateObject("ADODB.Recordset")
SubsID.CursorLocation = 3
SubsID.Open strSql, my_conn
SubsID.CacheSize = 100
if not (SubsID.BOF or SubsID.EOF) then
my_conn.execute("delete from wcal_subscriberscats where IDSubscriber=" & SubsID("IDSubscriber"))
my_conn.execute("delete from wcal_subscribers where IDSubscriber=" & SubsID("IDSubscriber"))
sH = sH & "" & application(session("LANG") & "_wcal59") & "
"
sH = sH & "" & application(session("LANG") & "_wcal60") & ""
strMessage = ""
'send info
strSubject = "UnSubscribtion confirmation"
if blSUBSCRIBER_ADDINFO then
strMessage = "This email confirms that you have been removed from our mailing list.
" & VbCrLf &_
"WebEcalendar system at " & ServerAddress&".
" & VbCrLf
else
strMessage = "This email confirms that you have been removed from our mailing list. " & VbCrLf &_
"WebEcalendar system at " & ServerAddress&"." & VbCrLf
end if
if IsObject(MAILOBJ) then
MAILOBJ.Recepient = request("Email")
MAILOBJ.Subject = strSubject
MAILOBJ.Message = strMessage
MAILOBJ.Send()
end if
else
sH = sH & "Wrong e-mail or password
"
end if
SubsID.Close
set SubsID = nothing
end if
CAL_SUBSCRIBER_UNSUBSCRIBEEXE = sH
end Function
' #################################
public function CAL_SUBSCRIBER_SENDPASSWORD
dim sH : sH = ""
sH = sH &"" & VbCrLf
sH = sH &"" & VbCrLf
sH = sH &"
" & VbCrLf
CAL_SUBSCRIBER_SENDPASSWORD = funcs.BOXCreator(application(session("LANG") & "_wcal63"), sH, strDEFTHEME, "", "90%")
end Function
' #################################
public Function CAL_SUBSCRIBER_SENDPASSWORDEXE
dim sH : sH = ""
dim Email
dim SubsPassword, SubsID, strSubject
if EmailTESTINC then
strSQL = "select * from wcal_subscribers where Email='" & request("Email") & "'"
set SubsID = Server.CreateObject("ADODB.Recordset")
SubsID.CursorLocation = 3
SubsID.Open strSql, my_conn
SubsID.CacheSize = 100
if not (SubsID.BOF or SubsID.EOF) then
Email = SubSID("Email")
SubsPassword = SubSID("SubsPassword")
end if
SubsID.Close
set SubsID = nothing
sH = sH & "" & application(session("LANG") & "_wcal64") & "
"
sH = sH & "" & application(session("LANG") & "_wcal65") & ""
' Edit this for your own
' ============================================================
strSubject = "Subscribtion confirmation"
if MAILOBJ.HTMLFormat then
strMessage = strMessage & "Someone probable you have registered for newsletter from WebCalendar system at " & ServerAddress & ".
" & VbCrLf
strMessage = strMessage & "Your subscription information is: " & request("Email") & "
" & VbCrLf
strMessage = strMessage & " and password:" & request("SubsPassword") & "." & "
" & VbCrLf
strMessage = strMessage & "If you want to be removed please follow the link bellow." & "
" & VbCrLf
strMessage = strMessage & "UNSUBSCRIBE" & "
" & VbCrLf
else
strMessage = strMessage & "Someone probable you have registered for newsletter from WebCalendar system at " & ServerAddress&"." & VbCrLf
strMessage = strMessage & "Your subscription information is: " & request("Email") & VbCrLf
strMessage = strMessage & " and password:" & request("SubsPassword") & "." & VbCrLf
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="&request("Email") &"&SubsPassword="& request("SubsPassword") & VbCrLf
end if
if IsObject(MAILOBJ) then
MAILOBJ.Recepient = Email
MAILOBJ.Subject = strSubject
MAILOBJ.Message = strMessage
MAILOBJ.Send()
end if
end if
CAL_SUBSCRIBER_SENDPASSWORDEXE = sH
end Function
' #################################
Public function CAL_SUBSCRIBER_LIST
dim sH : sH = ""
dim strSQL, SubsList, Categories, filter_cat, SubsCat, box
'*************************
'FILTERS
'*************************
if NOT (request("filter_cat") = "") then
session("filter_cat") = request("filter_cat")
end if
if (session("filter_cat") = "") then
session("filter_cat") = "-2"
end if
sH = sH & "" & VbCrLf
box = box & "
" & VbCrLf
sH = sH & funcs.BOXCreator(ucase(application(session("LANG") & "_wcal108")), box, strDEFTHEME, "", "31%")
'************************************
'FILTERS - SQL QUERIES CONSTRUCTION
'************************************
if (session("filter_cat") = "-2") then 'NO FILTER choosed
strSQL = "SELECT * FROM wcal_subscribers"
if NOT (request("strSRCH") = "") then strSQL = strSQL & " WHERE EMail LIKE '%" & request("strSRCH") & "%'"
strSQL = strSQL & " ORDER BY Email"
elseif (session("filter_cat") = "-1") then 'NO CATEGORY choosed
strSQL = "SELECT * FROM wcal_subscribers WHERE IDSubscriber NOT IN (SELECT wcal_subscribers.IDSubscriber FROM wcal_subscribers RIGHT JOIN wcal_subscriberscats ON wcal_subscribers.IDSubscriber = wcal_subscriberscats.IDSubscriber)"
if NOT (request("strSRCH") = "") then strSQL = strSQL & " AND EMail LIKE '%" & request("strSRCH") & "%'"
strSQL = strSQL & " ORDER BY Email"
elseif (session("filter_cat") = "-3") then 'NO CATEGORY choosed
strSQL = "SELECT * FROM wcal_subscribers WHERE Validate=true"
if NOT (request("strSRCH") = "") then strSQL = strSQL & " AND EMail LIKE '%" & request("strSRCH") & "%'"
strSQL = strSQL & " ORDER BY Email"
else 'SOME CATEGORY choosed
' strSQL = "SELECT * FROM wcal_subscribers left JOIN wcal_subscriberscats ON wcal_subscribers.IDSubscriber = wcal_subscriberscats.IDSubscriber WHERE wcal_subscriberscats.IDCat=" & session("filter_category")
strSQL = "SELECT IDSubscriber FROM wcal_subscriberscats WHERE IDCat=" & session("filter_cat")
set SubsCat = Server.CreateObject("ADODB.Recordset")
SubsCat.CursorLocation = 3
SubsCat.Open strSQL, my_conn
SubsCat.CacheSize = 100
if NOT (SubsCat.BOF or SubsCat.EOF) then
strSQL = "SELECT * FROM wcal_subscribers WHERE IDSubscriber=" & SubsCat("IDSubscriber")
SubsCat.MoveNext
do until SubsCat.EOF
strSQL = strSQL & " OR IDSubscriber=" & SubsCat("IDSubscriber")
SubsCat.MoveNext
loop
strSQL = strSQL & " ORDER BY Email"
end if
SubsCat.Close
set SubsCat = nothing
end if
'*** FILTERS - END ***
'*************************
'SEARCH
'*************************
box = ""
box = box & "
" & VbCrLf
sH = sH & funcs.BOXCreator(ucase(application(session("LANG") & "_wcal93")), box, strDEFTHEME, "", "31%")
sH = sH & "
" & VbCrLf
sH = sH & "" & VbCrLf
sH = sH & "
" & VbCrLf
end if
set SubsList = nothing
CAL_SUBSCRIBER_EDIT = sH
end function
' #################################
Public Function CAL_SUBSCRIBER_EDITEXE
dim strSQL, Subscriber, SubsCat, item, Validation
'***********************************
'UPDATE IN LIST OF SUBSCRIBERS
'***********************************
strSQL = "SELECT IDSubscriber FROM wcal_subscribers WHERE IDSubscriber=" & request("ID")
set Subscriber = Server.CreateObject("ADODB.Recordset")
Subscriber.CursorLocation = 3
Subscriber.Open strSQL, my_conn
Subscriber.CacheSize = 100
if (request("Validation") = "") then
Validation = false
else
Validation = true
end if
if NOT (Subscriber.BOF or Subscriber.EOF) then
my_conn.execute ("UPDATE wcal_subscribers SET " &_
"Email='" & request("Email") & "', " &_
"SubsPassword='" & request("SubsPassword") & "', " &_
"Validate=" & Validation & " " &_
"WHERE IDSubscriber=" & request("ID"))
end if
Subscriber.Close
set Subscriber = nothing
'***********************************
'UPDATE IN SUBSCRIBED CATEGORIES
'***********************************
strSQL = "SELECT IDSubsCats FROM wcal_subscriberscats WHERE IDSubscriber=" & request("ID")
set SubsCat = Server.CreateObject("ADODB.Recordset")
SubsCat.CursorLocation = 3
SubsCat.Open strSQL, my_conn
SubsCat.CacheSize = 100
if NOT (SubsCat.BOF or SubsCat.EOF) then
my_conn.execute ("DELETE FROM wcal_subscriberscats WHERE IDSubscriber=" & request("ID"))
end if
for each item in request.form("SUBSwcal_category")
my_conn.execute ("INSERT INTO wcal_subscriberscats (IDSubscriber, IDCat) VALUES (" & request("ID") & "," & item & ")")
next
SubsCat.Close
set SubsCat = nothing
response.redirect CalendarSRC & "?DoAction=Calendar&CHANGE=SUBSCRIBER_LIST&Page=" & request("Page")
End Function
' #################################
Public Function CAL_SUBSCRIBER_DELETE
dim strSQL, Subscriber, SubsCat
'*************************
'DELETE FROM SUBSCRIBERS
'*************************
strSQL = "SELECT IDSubscriber FROM wcal_subscribers WHERE IDSubscriber=" & request("ID")
set Subscriber = Server.CreateObject("ADODB.Recordset")
Subscriber.CursorLocation = 3
Subscriber.Open strSQL, my_conn
Subscriber.CacheSize = 100
if NOT (Subscriber.BOF or Subscriber.EOF) then
my_conn.execute("DELETE FROM wcal_subscribers WHERE IDSubscriber=" & request("ID"))
end if
Subscriber.Close
set Subscriber = nothing
'***********************************
'DELETE FROM SUBSCRIBED CATEGORIES
'***********************************
strSQL = "SELECT IDSubsCats FROM wcal_subscriberscats WHERE IDSubscriber=" & request("ID")
set SubsCat = Server.CreateObject("ADODB.Recordset")
SubsCat.CursorLocation = 3
SubsCat.Open strSQL, my_conn
SubsCat.CacheSize = 100
if NOT (SubsCat.BOF or SubsCat.EOF) then
my_conn.execute("DELETE FROM wcal_subscriberscats WHERE IDSubscriber=" & request("ID"))
end if
SubsCat.Close
set SubsCat = nothing
response.redirect CalendarSRC & "?DoAction=Calendar&CHANGE=SUBSCRIBER_LIST&Page=" & request("Page")
End Function
' #################################
Public Function CAL_SUBSCRIBER_LOCKEXE
dim strSQL
strSQL = "SELECT Validate FROM wcal_subscribers WHERE IDSubscriber=" & request("ID")
set Subs = Server.CreateObject("ADODB.Recordset")
Subs.CursorLocation = 3
Subs.Open strSQL, my_conn
Subs.CacheSize = 100
if NOT (Subs.BOF or Subs.EOF) then
if (Subs("Validate")=true) then
my_conn.execute("UPDATE wcal_subscribers SET Validate=false WHERE IDSubscriber=" & request("ID"))
elseif (Subs("Validate")=false) then
my_conn.execute("UPDATE wcal_subscribers SET Validate=true WHERE IDSubscriber=" & request("ID"))
end if
end if
Subs.Close
set Subs = nothing
response.redirect CalendarSRC & "?DoAction=Calendar&CHANGE=SUBSCRIBER_LIST&Page=" & request("Page")
End Function
' #################################
Public Function CAL_SUBSCRIBER_SELECT
dim strSQL, Subs
dim sH : sH = ""
strSQL = "SELECT * FROM wcal_eventrec WHERE (EventDate BETWEEN NOW() AND NOW()+30)"
' strSQL = "SELECT Email FROM wcal_subscribers"
set Subs = Server.CreateObject("ADODB.Recordset")
Subs.CursorLocation = 3
Subs.Open strSQL, my_conn
Subs.CacheSize = 100
sH = sH & ""
if NOT (Subs.EOF or Subs.BOF) then
do until Subs.EOF
sH = sH & "| " & Subs("IDEventRec") & " |
"
' strSQL = "SELECT * FROM wcal_eventrec WHERE (EventDate BETWEEN NOW() AND NOW()+30)"
Subs.MoveNext
loop
end if
sH = sH & "
"
Subs.Close
set Subs = nothing
CAL_SUBSCRIBER_SELECT = sH
End Function
%>