Code:
<%
'BindEvents Method @1-94AC5643
Sub BindEvents()
Set events_rec.event_time_hrs.CCSEvents("BeforeShow") = GetRef("events_rec_event_time_hrs_BeforeShow")
Set events_rec.time_hrs_end.CCSEvents("BeforeShow") = GetRef("events_rec_time_hrs_end_BeforeShow")
Set events_rec.Button_Delete.CCSEvents("BeforeShow") = GetRef("events_rec_Button_Delete_BeforeShow")
Set events_rec.Button_Cancel.CCSEvents("OnClick") = GetRef("events_rec_Button_Cancel_OnClick")
Set events_rec.CCSEvents("BeforeShow") = GetRef("events_rec_BeforeShow")
Set events_rec.CCSEvents("BeforeInsert") = GetRef("events_rec_BeforeInsert")
Set events_rec.CCSEvents("BeforeUpdate") = GetRef("events_rec_BeforeUpdate")
Set events_rec.CCSEvents("OnValidate") = GetRef("events_rec_OnValidate")
Set events_rec.DataSource.CCSEvents("AfterExecuteInsert") = GetRef("events_rec_DataSource_AfterExecuteInsert")
Set events_rec.DataSource.CCSEvents("AfterExecuteUpdate") = GetRef("events_rec_DataSource_AfterExecuteUpdate")
Set events_rec.DataSource.CCSEvents("AfterExecuteDelete") = GetRef("events_rec_DataSource_AfterExecuteDelete")
Set CCSEvents("AfterInitialize") = GetRef("Page_AfterInitialize")
generateCalendarFile
End Sub
'End BindEvents Method
Function events_rec_event_time_hrs_BeforeShow(Sender) 'events_rec_event_time_hrs_BeforeShow @25-E6758C9B
'Custom Code @102-73254650
' -------------------------
Dim I
If calendar_config("time_format") = "2" OR (calendar_config("time_format") = "1" AND UBound(CCSLocales.Locale.ShortTime) = 2) Then
For I = 1 To 24
events_rec.event_time_hrs.ItemsList(I) = CCAddZero(CStr(I-1),2)
Next
End if
' -------------------------
'End Custom Code
End Function 'Close events_rec_event_time_hrs_BeforeShow @25-54C34B28
Function events_rec_time_hrs_end_BeforeShow(Sender) 'events_rec_time_hrs_end_BeforeShow @27-3F30621E
'Custom Code @101-73254650
' -------------------------
Dim I
If calendar_config("time_format") = "2" OR (calendar_config("time_format") = "1" AND UBound(CCSLocales.Locale.ShortTime) = 2) Then
For I = 1 To 24
events_rec.time_hrs_end.ItemsList(I) = CCAddZero(CStr(I-1),2)
Next
End if
' -------------------------
'End Custom Code
End Function 'Close events_rec_time_hrs_end_BeforeShow @27-54C34B28
Function events_rec_Button_Delete_BeforeShow(Sender) 'events_rec_Button_Delete_BeforeShow @8-DDC24094
'Custom Code @34-73254650
' -------------------------
If Not DeleteAllowed(CCGetFromGet("event_id","")) Then
events_rec.Button_Delete.Visible = False
End If
' -------------------------
'End Custom Code
End Function 'Close events_rec_Button_Delete_BeforeShow @8-54C34B28
Function events_rec_Button_Cancel_OnClick(Sender) 'events_rec_Button_Cancel_OnClick @81-E465F1A4
'Custom Code @82-73254650
' -------------------------
Redirect = CCGetFromGet("ret_link", Redirect)
' -------------------------
'End Custom Code
End Function 'Close events_rec_Button_Cancel_OnClick @81-54C34B28
Function events_rec_BeforeShow(Sender) 'events_rec_BeforeShow @5-4927EACD
'Custom Code @19-73254650
' -------------------------
Dim str
Dim EventID : EventID = CCGetFromGet("event_id", "")
if Not events_rec.FormSubmitted Then
str = events_rec.event_time.Value
If Len(str) > 0 Then
events_rec.allday.Value = "0"
events_rec.event_time_hrs.Value = Hour(str)
events_rec.event_time_mns.Value = Minute(str)
Else
events_rec.allday.Value = "1"
End If
str = events_rec.event_time_end.Value
If Len(str) Then
events_rec.time_hrs_end.Value = Hour(str)
events_rec.time_mns_end.Value = Minute(str)
End If
If Len(events_rec.event_URL.Value) = 0 Then
events_rec.event_URL.Value = "http://"
End If
If Len(EventID) = 0 Then
events_rec.category_id.Value = Session("category")
End If
if Not events_rec.EditMode AND NOT IsEmpty(CCGetFromGet("event_date", Empty)) Then
events_rec.event_date.Value = CCParseDate(CCGetFromGet("event_date", ""), array("mm","/","dd","/","yyyy"))
End if
End If
processCustomFields("events_rec")
If Len(EventID) Then
events_rec.RepeatEvent.Visible = False
If Len(events_rec.event_parent_id.Value) = 0 Then
EventID = CCDLookUp("count(event_id)", "events", "event_parent_id = " & EventID, DBcalendar)
If EventID = 0 Then _
events_rec.PanelRecurrentSubmit.Visible = False
End If
Else
events_rec.PanelRecurrentSubmit.Visible = False
End If
' -------------------------
'End Custom Code
End Function 'Close events_rec_BeforeShow @5-54C34B28
Function events_rec_BeforeInsert(Sender) 'events_rec_BeforeInsert @5-48F5EAEE
'Custom Code @20-73254650
' -------------------------
If events_rec.allday.Value = "1" Then
events_rec.event_time.Value = ""
events_rec.event_time_end.Value = ""
Else
events_rec.event_time.Value = TimeSerial(events_rec.event_time_hrs.Value, events_rec.event_time_mns.Value, 0)
events_rec.event_time_end.Value = TimeSerial(events_rec.time_hrs_end.Value, events_rec.time_mns_end.Value, 0)
End If
If CCGetUserID() > 0 Then
events_rec.user_id.Value = CCGetUserID()
else
events_rec.user_id.Value = 0
End If
If Trim(events_rec.event_URL.Value) = "http://" Then
events_rec.event_URL.Value = ""
End If
' -------------------------
'End Custom Code
End Function 'Close events_rec_BeforeInsert @5-54C34B28
Function events_rec_BeforeUpdate(Sender) 'events_rec_BeforeUpdate @5-34AFBC41
'Custom Code @32-73254650
' -------------------------
If events_rec.allday.Value = "1" Then
events_rec.event_time.Value = ""
events_rec.event_time_end.Value = ""
Else
events_rec.event_time.Value = TimeSerial(events_rec.event_time_hrs.Value, events_rec.event_time_mns.Value, 0)
events_rec.event_time_end.Value = TimeSerial(events_rec.time_hrs_end.Value, events_rec.time_mns_end.Value, 0)
End If
events_rec.user_id.Value = CCDLookUp("user_id","events","event_id="&DBcalendar.ToSQL(CCGetFromGet("event_id", "0"), ccsInteger),DBcalendar)
If Trim(events_rec.event_URL.Value) = "http://" Then
events_rec.event_URL.Value = ""
End If
' -------------------------
'End Custom Code
End Function 'Close events_rec_BeforeUpdate @5-54C34B28
Function events_rec_OnValidate(Sender) 'events_rec_OnValidate @5-627A4D5B
'Custom Code @93-73254650
' -------------------------
If events_rec.RepeatEvent.Value = 1 Then
If Len(events_rec.RepeatNum.Value) = 0 Then _
events_rec.Errors.addError(CCSLocales.GetText("CCS_RequiredField", events_rec.RepeatNum.Caption))
If Len(events_rec.event_todate.Text) = 0 Then _
events_rec.Errors.addError(CCSLocales.GetText("CCS_RequiredField", events_rec.event_todate.Caption))
End If
' -------------------------
'End Custom Code
End Function 'Close events_rec_OnValidate @5-54C34B28
Function events_rec_DataSource_AfterExecuteInsert(Sender) 'events_rec_DataSource_AfterExecuteInsert @5-13BEF9F2
'Custom Code @92-73254650
' -------------------------
Dim EventId
Dim SQL
Dim SQL_end
Dim FieldsArr
Dim FieldsType
Dim RecordSet
Dim Interval
Dim DateStart
Dim DateFinish
Dim RepeatNum
Dim RepeatType
Dim i
If events_rec.RepeatEvent.Value = 1 Then
EventID = CCDLookUp("MAX(event_id)", "events", "", DBcalendar)
SQL = "SELECT * FROM events WHERE event_id = " & DBcalendar.ToSQL(EventID, ccsInteger)
Set RecordSet = DBcalendar.Execute(SQL)
SQL = "INSERT INTO events (event_parent_id, event_date "
SQL_end = ") VALUES (" & DBcalendar.ToSQL(EventID, ccsInteger) & ", {date}"
FieldsArr = array("user_id", "category_id", "event_title", "event_desc", "event_time", "event_time_end", "event_date_add", _
"event_user_add", "event_is_public", "event_location", "event_cost", "event_url", "custom_TextBox1", _
"custom_TextBox2", "custom_TextBox3", "custom_TextArea1", "custom_TextArea2", "custom_TextArea3", _
"custom_CheckBox1", "custom_CheckBox2", "custom_CheckBox3")
FieldsType = array(ccsInteger, ccsInteger, ccsText, ccsText, ccsDate, ccsDate, ccsDate, _
ccsDate, ccsInteger, ccsText, ccsText, ccsText, ccsText, _
ccsText, ccsText, ccsText, ccsText, ccsText, _
ccsInteger, ccsInteger, ccsInteger)
For i=0 To 20
If Len(RecordSet(FieldsArr(i))) > 0 Then
SQL = SQL & ", " & FieldsArr(i)
SQL_end = SQL_end & ", " & DBcalendar.ToSQL(RecordSet(FieldsArr(i)), FieldsType(i))
End If
Next
RecordSet.Close
Set RecordSet = Nothing
SQL = SQL & SQL_end & ")"
RepeatNum = events_rec.RepeatNum.Value
DateStart = events_rec.event_date.Value
RepeatType = events_rec.RepeatType.Value
Select Case RepeatType
Case 0 Interval = "d"
Case 8 Interval = "ww"
Case 30 Interval = "m"
Case 1, 2, 3, 4, 5, 6, 7 Interval = "ww"
If RepeatType - Weekday(DateStart) <= 0 Then
DateStart = DateAdd("d", RepeatType - Weekday(DateStart) - RepeatNum*7 + 7 , DateStart)
Else
DateStart = DateAdd("d", RepeatType - Weekday(DateStart) - RepeatNum*7 , DateStart)
End If
End Select
DateStart = DateAdd(Interval, RepeatNum, DateStart)
DateFinish = events_rec.event_todate.Value
While DateStart <= DateFinish
DBcalendar.Execute(Replace(SQL, "{date}", DBcalendar.ToSQL(DateStart, ccsDate)))
DateStart = DateAdd(Interval, RepeatNum, DateStart)
WEnd
End If
Dim ret_link
Session("category") = ""
ret_link = CCGetFromGet("ret_link", "")
If Len(ret_link) > 0 Then
ret_link = Left(ret_link, (Instr(ret_link, "?") - 1))
Select Case ret_link
Case "index.asp" Redirect = "index.asp?cal_monthDate=" & CCFormatDate(events_rec.event_date.Value, array("yyyy","-","mm"))
Case "day.asp", "week.asp" Redirect = ret_link & "?day=" & CCFormatDate(events_rec.event_date.Value, array("yyyy","-","mm","-","dd"))
End Select
End If
' -------------------------
'End Custom Code
End Function 'Close events_rec_DataSource_AfterExecuteInsert @5-54C34B28
Function events_rec_DataSource_AfterExecuteUpdate(Sender) 'events_rec_DataSource_AfterExecuteUpdate @5-6FE4AF5D
'Custom Code @99-73254650
' -------------------------
Dim EventID
Dim SQL
Dim RecordSet
Dim FieldsArr
Dim FieldsType
Dim i
If events_rec.RecurrentApply.Value Then
EventID = CCGetFromGet("event_id", "")
SQL = "SELECT * FROM events WHERE event_id = " & EventID
Set RecordSet = DBcalendar.Execute(SQL)
If Len(events_rec.event_parent_id.Value) > 0 Then _
EventId = events_rec.event_parent_id.Value
SQL = "UPDATE events SET "
FieldsArr = array("user_id", "category_id", "event_title", "event_desc", "event_time", "event_time_end", "event_date_add", _
"event_user_add", "event_is_public", "event_location", "event_cost", "event_url", "custom_TextBox1", _
"custom_TextBox2", "custom_TextBox3", "custom_TextArea1", "custom_TextArea2", "custom_TextArea3", _
"custom_CheckBox1", "custom_CheckBox2", "custom_CheckBox3")
FieldsType = array(ccsInteger, ccsInteger, ccsText, ccsText, ccsDate, ccsDate, ccsDate, _
ccsDate, ccsInteger, ccsText, ccsText, ccsText, ccsText, _
ccsText, ccsText, ccsText, ccsText, ccsText, _
ccsInteger, ccsInteger, ccsInteger)
For i=0 To 20
If Len(RecordSet(FieldsArr(i))) > 0 Then
SQL = SQL & FieldsArr(i) & " = " & DBcalendar.ToSQL(RecordSet(FieldsArr(i)), FieldsType(i)) & ", "
Else
SQL = SQL & FieldsArr(i) & " = " & DBcalendar.ToSQL("", FieldsType(i)) & ", "
End If
Next
SQL = Left(SQL, Len(SQL) - 2) & " WHERE event_id = " & DBcalendar.ToSQL(EventID,ccsInteger) & " OR event_parent_id = " & DBcalendar.ToSQL(EventID,ccsInteger)
RecordSet.Close
Set RecordSet = Nothing
DBcalendar.Execute(SQL)
End If
Session("category") = ""
Dim ret_link
Dim file_name
ret_link = CCGetFromGet("ret_link", "")
If Len(ret_link) > 0 Then
file_name = Left(ret_link, (Instr(ret_link, "?") - 1))
Select Case file_name
Case "index.asp" Redirect = "index.asp?cal_monthDate=" & CCFormatDate(events_rec.event_date.Value, array("yyyy","-","mm"))
Case "day.asp", "week.asp" Redirect = file_name & "?day=" & CCFormatDate(events_rec.event_date.Value, array("yyyy","-","mm","-","dd"))
Case Else Redirect = ret_link
End Select
End If
' -------------------------
'End Custom Code
End Function 'Close events_rec_DataSource_AfterExecuteUpdate @5-54C34B28
Function events_rec_DataSource_AfterExecuteDelete(Sender) 'events_rec_DataSource_AfterExecuteDelete @5-8BA462F2
'Custom Code @100-73254650
' -------------------------
Dim SQL
Dim EventID
If events_rec.RecurrentApply.Value Then
If Len(events_rec.event_parent_id.Value) > 0 Then
EventId = events_rec.event_parent_id.Value
Else
EventID = CCGetFromGet("event_id", "")
End If
SQL = "DELETE FROM events WHERE event_id = " & EventID & " OR event_parent_id = " & EventID
DBcalendar.Execute(SQL)
End If
' -------------------------
'End Custom Code
End Function 'Close events_rec_DataSource_AfterExecuteDelete @5-54C34B28
Function Page_AfterInitialize(Sender) 'Page_AfterInitialize @1-5C791CCC
'Custom Code @21-73254650
' -------------------------
Dim event_id
event_id = CCGetFromGet("event_id","")
If Len(event_id) > 0 Then
'Edit mode
If Not EditAllowed(event_id) Then
Redirect = CCGetFromGet("ret_link","index.asp")
End If
Else
'Add mode
If Not AddAllowed() Then
Redirect = CCGetFromGet("ret_link","index.asp")
End If
End If
' -------------------------
'End Custom Code
End Function 'Close Page_AfterInitialize @1-54C34B28
'This code assume that youve already got the event details, and loaded them into the descriptive variables in the code below'
sub generateCalendarFile() 'Not sure what variable I should use here, if any'
'Define new local variables below and set current event details to these'
dim strDate, strTmStart, strTmEnd, strTitle, strDesc, strLocation, strURL, strCal, strLinktoURL
'strAddress, strCity, and strProvince were replaced with strLocation to better match vCalendar input'
Dim EventID : EventID = CCGetFromGet("event_id", "")
'Initialize local variables with globals'
strDate = events_rec.event_date.Value
strTmStart = events_rec.event_time.Value
strTmEnd = events_rec.event_time_end.Value
strTitle = events_rec.event_title.Value
strDesc = events_rec.event_desc.Value
strLocation = events_rec.event_location.Value
strURL = events_rec.event_URL.Value
strDesc = strDesc & "=0D=0A=0D=0A" & strLocation
'Append Location to description'
strDesc = cleanString(strDesc)
'function to remove URLs and convert HTML-friendly chars to UNICODE further down'
if isEmpty( strURL) or trim( strURL ) = "" then
strLinktoURL = "default URL"
else
strLinktoURL = strURL
end if
strDesc = strDesc & "=0D=0A=0D=0AClick the link to visit the Wiki Page for this event!=0D=0A" & replace( strLinkToURL, "=", "=3D" )
strCal = "BEGIN:VCALENDAR" & vbCrLf & _
"BEGIN:VEVENT" & vbCrLf & _
"SUMMARY;CHARSET=ISO-8859-1;ENCODING=quoted-printable:" & strTitle & vbCrLf & _
"DESCRIPTION;CHARSET=ISO-8859-1;ENCODING=quoted-printable:" & strDesc & vbCrLf & _
"DTSTART:" & vCalDate( strDate, strTmStart ) & vbCrLf & _
"DTEND:" & vCalDate( strDate, strTmEnd ) & vbCrLf & _
"END:VEVENT" & vbCrLf & _
"END:VCALENDAR"
dim vCalPath, vCalFile, strFTPcmd, objFSP, objWrite
vCalPath = Request.ServerVariables("APPL_PHYSICAL_PATH") & "db"
'full path is ...wiki\wikidata\vcalendar\db'
set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if Not objFSO.FolderExists(vCalPath) then call errorMessage( vCalPath & " is an invalid path!" )
vCalFile = "Event" & "_" & eventID & ".vcs"
set objWrite = objFSO.OpenTextFile( vCalPath & "\" & vCalFile, 2, true )
objWrite.Write(strCal)
objWrite.Close()
set objWrite = nothing
set objFSO = nothing
end sub
function vCalDate(strDt, strTime)
dim arDate
arDate = split( strDt, "-" )
strDt = ""
for j = 0 to 2
if len( arDate( j ) ) = 1 then arDate( j ) = "0" & arDate( j )
strDt = strDt & arDate( j )
next
strTime = replace( strTime, ":", "" )
strTime = cLng( strTime ) + 40000
if strTime > 240000 then
strDt = cStr( cLng( strDt ) + 1 )
strTime = strTime - 240000
end if
strTime = cStr( strTime )
if len( strTime ) < 6 then
do until len( strTime ) = 6
strTime = "0" & strTime
loop
end if
vCalDate = strDt & "T" & strTime & "Z"
end function
function cleanString( strToConvert )
'=== remove URLS'
'=== takes out HTML friendly chars, and converts to UNICODE equivalent'
dim objRegExp, matches, strChar
set objRegExp = New RegExp
objRegExp.Pattern = "<a.*?</a>"
objRegExp.Global = true
strToConvert = objRegExp.Replace( strToConvert, "" )
set objRegExp = nothing
set objRegExp = New RegExp
objRegExp.Pattern = "&#.*?;"
objRegExp.Global = true
set matches = objRegExp.Execute( strToConvert )
for each j in matches
strChar = j.value
strChar = cInt( replace( replace( strChar, "&#", "" ), ";", "" ) )
strChar = chr( strChar )
strToConvert = replace( strToConvert, j.value, strChar )
next
set objRegExp = nothing
set matches = nothing
cleanString = strToConvert
end function
%>
When I went to run this code though, it started giving me errors in all of the stuff that I didn't even write or change in any way.
Bookmarks