<%@ Language=VBScript %> <% Response.Buffer = True %> <% Server.ScriptTimeout = 1000 %> <% '_________________________________________________________________________________ '--------------------------------------------------------------------------------- ' Script Name : aspWebCalendar FREE - Entire Script ' File Name : calendar.asp ' Version : 1.1 ' Creation Date : 4/10/2006 ' Last Update : 3/25/2007 ' Copyright : 2002 - 2007 Full Revolution, Inc. '_________________________________________________________________________________ '--------------------------------------------------------------------------------- '********************************************************************************* '******** Page Opening Code ****************************************************** '********************************************************************************* %> <% ' --------------------------------------------------- ' The full complete constantfile ' for ' ActiveX Data Object Version 2.1 ' ---------------------------------------------------' ' ADODB.CursorOptionEnum Const adAddNew = 16778240 Const adApproxPosition = 16384 Const adBookmark = 8192 Const adDelete = 16779264 Const adFind = 524288 Const adHoldRecords = 256 Const adIndex = 8388608 Const adMovePrevious = 512 Const adNotify = 262144 Const adResync = 131072 Const adSeek = 4194304 Const adUpdate = 16809984 Const adUpdateBatch = 65536 ' ADODB.CursorLocationEnum Const adUseClient = 3 Const adUseServer = 2 ' ADODB.CursorTypeEnum Const adOpenDynamic = 2 Const adOpenForwardOnly = 0 Const adOpenKeyset = 1 Const adOpenStatic = 3 ' ADODB.AffectEnum Const adAffectAllChapters = 4 Const adAffectCurrent = 1 Const adAffectGroup = 2 ' ADODB.ConnectOptionEnum Const adAsyncConnect = 16 ' ADODB.ConnectModeEnum Const adModeRead = 1 Const adModeReadWrite = 3 Const adModeShareDenyNone = 16 Const adModeShareDenyRead = 4 Const adModeShareDenyWrite = 8 Const adModeShareExclusive = 12 Const adModeUnknown = 0 Const adModeWrite = 2 ' ADODB.ConnectPromptEnum Const adPromptAlways = 1 Const adPromptComplete = 2 Const adPromptCompleteRequired = 3 Const adPromptNever = 4 ' ADODB.ExecuteOptionEnum Const adAsyncExecute = 16 Const adAsyncFetch = 32 Const adAsyncFetchNonBlocking = 64 Const adExecuteNoRecords = 128 ' ADODB.DataTypeEnum Const adBigInt = 20 Const adBinary = 128 Const adBoolean = 11 Const adBSTR = 8 Const adChapter = 136 Const adChar = 129 Const adCurrency = 6 Const adDate = 7 Const adDBDate = 133 Const adDBFileTime = 137 Const adDBTime = 134 Const adDBTimeStamp = 135 Const adDecimal = 14 Const adDouble = 5 Const adEmpty = 0 Const adError = 10 Const adFileTime = 64 Const adGUID = 72 Const adIDispatch = 9 Const adInteger = 3 Const adIUnknown = 13 Const adLongVarBinary = 205 Const adLongVarChar = 201 Const adLongVarWChar = 203 Const adNumeric = 131 Const adPropVariant = 138 Const adSingle = 4 Const adSmallInt = 2 Const adTinyInt = 16 Const adUnsignedBigInt = 21 Const adUnsignedInt = 19 Const adUnsignedSmallInt = 18 Const adUnsignedTinyInt = 17 Const adUserDefined = 132 Const adVarBinary = 204 Const adVarChar = 200 Const adVariant = 12 Const adVarNumeric = 139 Const adVarWChar = 202 Const adWChar = 130 ' ADODB.BookmarkEnum Const adBookmarkCurrent = 0 Const adBookmarkFirst = 1 Const adBookmarkLast = 2 ' ADODB.StringFormatEnum Const adClipString = 2 ' ADODB.CommandTypeEnum Const adCmdFile = 256 Const adCmdStoredProc = 4 Const adCmdTable = 2 Const adCmdTableDirect = 512 Const adCmdText = 1 Const adCmdUnknown = 8 ' ADODB.CompareEnum Const adCompareEqual = 1 Const adCompareGreaterThan = 2 Const adCompareLessThan = 0 Const adCompareNotComparable = 4 Const adCompareNotEqual = 3 ' ADODB.ADCPROP_UPDATECRITERIA_ENUM Const adCriteriaAllCols = 1 Const adCriteriaKey = 0 Const adCriteriaTimeStamp = 3 Const adCriteriaUpdCols = 2 ' ADODB.ADCPROP_ASYNCTHREADPRIORITY_ENUM Const adPriorityAboveNormal = 4 Const adPriorityBelowNormal = 2 Const adPriorityHighest = 5 Const adPriorityLowest = 1 Const adPriorityNormal = 3 ' ADODB.EditModeEnum Const adEditAdd = 2 Const adEditDelete = 4 Const adEditInProgress = 1 Const adEditNone = 0 ' ADODB.ErrorValueEnum Const adErrBoundToCommand = 3707 Const adErrDataConversion = 3421 Const adErrFeatureNotAvailable = 3251 Const adErrIllegalOperation = 3219 Const adErrInTransaction = 3246 Const adErrInvalidArgument = 3001 Const adErrInvalidConnection = 3709 Const adErrInvalidParamInfo = 3708 Const adErrItemNotFound = 3265 Const adErrNoCurrentRecord = 3021 Const adErrNotReentrant = 3710 Const adErrObjectClosed = 3704 Const adErrObjectInCollection = 3367 Const adErrObjectNotSet = 3420 Const adErrObjectOpen = 3705 Const adErrOperationCancelled = 3712 Const adErrProviderNotFound = 3706 Const adErrStillConnecting = 3713 Const adErrStillExecuting = 3711 Const adErrUnsafeOperation = 3716 ' ADODB.FilterGroupEnum Const adFilterAffectedRecords = 2 Const adFilterConflictingRecords = 5 Const adFilterFetchedRecords = 3 Const adFilterNone = 0 Const adFilterPendingRecords = 1 ' ADODB.FieldAttributeEnum Const adFldCacheDeferred = 4096 Const adFldFixed = 16 Const adFldIsNullable = 32 Const adFldKeyColumn = 32768 Const adFldLong = 128 Const adFldMayBeNull = 64 Const adFldMayDefer = 2 Const adFldNegativeScale = 16384 Const adFldRowID = 256 Const adFldRowVersion = 512 Const adFldUnknownUpdatable = 8 Const adFldUpdatable = 4 ' ADODB.GetRowsOptionEnum Const adGetRowsRest = -1 ' ADODB.LockTypeEnum Const adLockBatchOptimistic = 4 Const adLockOptimistic = 3 Const adLockPessimistic = 2 Const adLockReadOnly = 1 ' ADODB.MarschalOptionsEnum Const adMarshalAll = 0 Const adMarshalModifiedOnly = 1 ' ADODB.ParameterDirectionEnum Const adParamInput = 1 Const adParamInputOutput = 3 Const adParamOutput = 2 Const adParamReturnValue = 4 Const adParamUnknown = 0 ' ADODB.ParameterAttributesEnum Const adParamLong = 128 Const adParamNullable = 64 Const adParamSigned = 16 ' ADODB.PersistFormatEnum Const adPersistADTG = 0 Const adPersistXML = 1 ' ADODB.PositionEnum Const adPosBOF = -2 Const adPosEOF = -3 Const adPosUnknown = -1 ' ADODB.PropertyAttributesEnum Const adPropNotSupported = 0 Const adPropOptional = 2 Const adPropRead = 512 Const adPropRequired = 1 Const adPropWrite = 1024 ' ADODB.ADCPROP_AUTORECALC_ENUM Const adRecalcAlways = 1 Const adRecalcUpFront = 0 ' ADODB.RecordStatusEnum Const adRecCanceled = 256 Const adRecCantRelease = 1024 Const adRecConcurrencyViolation = 2048 Const adRecDBDeleted = 262144 Const adRecDeleted = 4 Const adRecIntegrityViolation = 4096 Const adRecInvalid = 16 Const adRecMaxChangesExceeded = 8192 Const adRecModified = 2 Const adRecMultipleChanges = 64 Const adRecNew = 1 Const adRecObjectOpen = 16384 Const adRecOK = 0 Const adRecOutOfMemory = 32768 Const adRecPendingChanges = 128 Const adRecPermissionDenied = 65536 Const adRecSchemaViolation = 131072 Const adRecUnmodified = 8 ' ADODB.CEResyncEnum Const adResyncAll = 15 Const adResyncAutoIncrement = 1 Const adResyncConflicts = 2 Const adResyncInserts = 8 Const adResyncNone = 0 Const adResyncUpdates = 4 ' ADODB.ResyncEnum Const adResyncAllValues = 2 Const adResyncUnderlyingValues = 1 ' ADODB.EventReasonEnum Const adRsnAddNew = 1 Const adRsnClose = 9 Const adRsnDelete = 2 Const adRsnFirstChange = 11 Const adRsnMove = 10 Const adRsnMoveFirst = 12 Const adRsnMoveLast = 15 Const adRsnMoveNext = 13 Const adRsnMovePrevious = 14 Const adRsnRequery = 7 Const adRsnResynch = 8 Const adRsnUndoAddNew = 5 Const adRsnUndoDelete = 6 Const adRsnUndoUpdate = 4 Const adRsnUpdate = 3 ' ADODB.SchemaEnum Const adSchemaAsserts = 0 Const adSchemaCatalogs = 1 Const adSchemaCharacterSets = 2 Const adSchemaCheckConstraints = 5 Const adSchemaCollations = 3 Const adSchemaColumnPrivileges = 13 Const adSchemaColumns = 4 Const adSchemaColumnsDomainUsage = 11 Const adSchemaConstraintColumnUsage = 6 Const adSchemaConstraintTableUsage = 7 Const adSchemaCubes = 32 Const adSchemaDBInfoKeywords = 30 Const adSchemaDBInfoLiterals = 31 Const adSchemaDimensions = 33 Const adSchemaForeignKeys = 27 Const adSchemaHierarchies = 34 Const adSchemaIndexes = 12 Const adSchemaKeyColumnUsage = 8 Const adSchemaLevels = 35 Const adSchemaMeasures = 36 Const adSchemaMembers = 38 Const adSchemaPrimaryKeys = 28 Const adSchemaProcedureColumns = 29 Const adSchemaProcedureParameters = 26 Const adSchemaProcedures = 16 Const adSchemaProperties = 37 Const adSchemaProviderSpecific = -1 Const adSchemaProviderTypes = 22 Const adSchemaReferentialConstraints = 9 Const adSchemaSchemata = 17 Const adSchemaSQLLanguages = 18 Const adSchemaStatistics = 19 Const adSchemaTableConstraints = 10 Const adSchemaTablePrivileges = 14 Const adSchemaTables = 20 Const adSchemaTranslations = 21 Const adSchemaTrustees = 39 Const adSchemaUsagePrivileges = 15 Const adSchemaViewColumnUsage = 24 Const adSchemaViews = 23 Const adSchemaViewTableUsage = 25 ' ADODB.SearchDirectionEnum Const adSearchBackward = -1 Const adSearchForward = 1 ' ADODB.SeekEnum Const adSeekAfter = 8 Const adSeekAfterEQ = 4 Const adSeekBefore = 32 Const adSeekBeforeEQ = 16 Const adSeekFirstEQ = 1 Const adSeekLastEQ = 2 ' ADODB.ObjectStateEnum Const adStateClosed = 0 Const adStateConnecting = 2 Const adStateExecuting = 4 Const adStateFetching = 8 Const adStateOpen = 1 ' ADODB.EventStatusEnum Const adStatusCancel = 4 Const adStatusCantDeny = 3 Const adStatusErrorsOccurred = 2 Const adStatusOK = 1 Const adStatusUnwantedEvent = 5 ' ADODB.XactAttributeEnum Const adXactAbortRetaining = 262144 Const adXactCommitRetaining = 131072 ' ADODB.IsolationLevelEnum Const adXactBrowse = 256 Const adXactChaos = 16 Const adXactCursorStability = 4096 Const adXactIsolated = 1048576 Const adXactReadCommitted = 4096 Const adXactReadUncommitted = 256 Const adXactRepeatableRead = 65536 Const adXactSerializable = 1048576 Const adXactUnspecified = -1 %> <% '********************************************************************************* ' Script Name : aspWebCalendar FREE - Database Connection Support File ' File Name : db.asp ' Version : 1.0 ' Release Date : 4/10/2006 ' ' Copyright (c) 2002 - 2005 by Full Revolution, Inc., All Rights Reserved '********************************************************************************* '********************************************************************************* '******** Open the database ***************************************************** '********************************************************************************* '------- Access Driver Connection String ---------------------------------------------- 'strConn = "Driver={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath("kb/kb.mdb") '------- Access OLE DB Driver Connection String --------------------------------------- strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("calendar/calendar.mdb") Set dbc = Server.CreateObject("ADODB.Connection") dbc.open strConn '------- Access Connection USING DSN -------------------------------------------------- 'Set dbc = Server.CreateObject("ADODB.Connection") 'dbc.open "DSN=aspWebCalendarFREE" %> <% '********************************************************************************* '******** Javascripts ************************************************************ '********************************************************************************* %> <% '********************************************************************************* '******** Determine the Browser Type ********************************************* '********************************************************************************* ClientBrowser = GetBrowserType(request.ServerVariables("HTTP_USER_AGENT")) '********************************************************************************* '******** Required Variables ***************************************************** '********************************************************************************* If Session("ConfigLoaded") = "" or Session("ConfigLoaded") = "NO" then SQL = "SELECT * FROM Cal_Config WHERE Cal_ConfigID = 1" Set RS=dbc.execute(SQL) Session("ScriptTitle") = RS("Cal_ConfigScriptTitle") Session("DefaultColorScheme") = RS("Cal_ConfigDefaultColorScheme") Session("ImageFolder") = RS("Cal_ConfigImageFolder") Session("DateFormat") = RS("Cal_ConfigDateFormat") Session("HTMLTemplate") = RS("Cal_ConfigHTMLTemplate") Session("MainFontFace") = RS("Cal_ConfigMainFontFace") Session("TimeFormatToUse") = RS("Cal_ConfigTimeFormatToUse") Session("MonthBlockHeight") = RS("Cal_ConfigMonthBlockHeight") Session("MiniCalendarWidth") = RS("Cal_ConfigMiniCalendarWidth") Session("DefaultView") = RS("Cal_ConfigDefaultView") Session("LCID") = RS("Cal_ConfigLCID") Session("ConfigLoaded") = "YES" SQLc = "SELECT * FROM Cal_ColorSchemes WHERE ColorSchemeID = " & RS("Cal_ConfigDefaultColorScheme") Set RSc=dbc.execute(SQLc) Session("LightColor") = RSc("LightColor") Session("MidLightColor") = RSc("MidLightColor") Session("LightMainColor") = RSc("LightMainColor") Session("DarkMainColor") = RSc("DarkMainColor") Session("LightLineColor") = RSc("LightLineColor") Session("PrimaryHighlightColor") = RSc("PrimaryHighlightColor") Session("SecondaryHighlightColor") = RSc("SecondaryHighlightColor") RSc.Close Set RSc=Nothing RS.Close Set RS=Nothing End If ScriptTitle = Session("ScriptTitle") DefaultColorScheme = Session("DefaultColorScheme") ImageFolder = Session("ImageFolder") DateFormat = Session("DateFormat") HTMLTemplate = Session("HTMLTemplate") MainFontFace = Session("MainFontFace") TimeFormatToUse = Session("TimeFormatToUse") MonthBlockHeight = Session("MonthBlockHeight") MiniCalendarWidth = Session("MiniCalendarWidth") DefaultView = Session("DefaultView") LCID = Session("LCID") LightColor = Session("LightColor") MidLightColor = Session("MidLightColor") LightMainColor = Session("LightMainColor") DarkMainColor = Session("DarkMainColor") LightLineColor = Session("LightLineColor") PrimaryHighlightColor = Session("PrimaryHighlightColor") SecondaryHighlightColor = Session("SecondaryHighlightColor") MiniCalendarHeight = 1 Session.LCID = LCID MonthSundayName = WeekDayName(1) MonthMondayName = WeekDayName(2) MonthTuesdayName = WeekDayName(3) MonthWednesdayName = WeekDayName(4) MonthThursdayName = WeekDayName(5) MonthFridayName = WeekDayName(6) MonthSaturdayName = WeekDayName(7) MiniSundayName = "S" MiniMondayName = "M" MiniTuesdayName = "T" MiniWednesdayName = "W" MiniThursdayName = "T" MiniFridayName = "F" MiniSaturdayName = "S" '********************************************************************************* '******** Find Out What We Should Be Doing *************************************** '********************************************************************************* '----- UNCOMMENT THE IF STATEMENT WHEN DONE! ------------------------------------- 'If Session("TemplateLoaded") <> "YES" then Call LoadTemplate 'End If If request.form("txtCalSelector") <> "" then Session("CalendarFilter") = request.form("txtCalSelector") End If If Session("CalendarFilter") = "" then Session("CalendarFilter") = 0 End If If request.querystring("calendar") <> "" then Session("CalendarFilter") = request.querystring("calendar") End If Session("CalendarFilter") = cint(Session("CalendarFilter")) If request.querystring("date") <> "" then WorkingDate = UniversalDate(request.querystring("date")) Else WorkingDate = UniversalDate(Date()) End If ScriptAction = request.querystring("action") If ScriptAction = "" then ScriptAction = DefaultView End If SELECT CASE ScriptAction CASE "month" response.write Session("PageHeader") CalType = "month" Call DrawHeaderBar Call DrawMonthView response.write Session("PageFooter") CASE "day" response.write Session("PageHeader") CalType = "day" Call DrawHeaderBar Call DrawDayView response.write Session("PageFooter") CASE "week" response.write Session("PageHeader") CalType = "week" Call DrawHeaderBar Call DrawWeekView response.write Session("PageFooter") CASE "year" response.write Session("PageHeader") CalType = "year" Call DrawHeaderBar Call DrawYearView response.write Session("PageFooter") CASE "viewevent" response.write Session("PageHeader") CalType = "day" Call DrawHeaderBar Call DrawViewEvent response.write Session("PageFooter") CASE "login" Call DrawLogin CASE "processlogin" Call ProcessLogin CASE "logoff" Call LogOff CASE "modifyconfig" Call EditConfig CASE "addevent" Call DrawAddEvent CASE "editevent" Call DrawEditEvent CASE "deleteevent" Call DeleteEvent CASE "managecalendars" Call ManageCalendars CASE "editcalendar" Call ManageCalendars CASE "deletecalendar" Call DeleteCalendar CASE "managecolorschemes" Call ManageColorSchemes CASE "editcolorscheme" Call ManageColorSchemes CASE "deletecolorscheme" Call DeleteColorScheme CASE "securitycheck" Call SecurityCheck CASE "summary" Call DrawSummary CASE "summary2" Call DrawSummary2 CASE "dbaddrecord" Call DBAddRecord CASE "dbupdaterecord" Call DBUpdateRecord CASE ELSE END SELECT dbc.close Set dbc=Nothing '********************************************************************************* '********************************************************************************* '***** Draw Login Screen ********************************************************* '********************************************************************************* Sub DrawLogin Session.Abandon Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Login" response.write "" response.write "" response.write "" '------------------------------------------------------------------------- response.write "" End Sub Sub DrawOtherMonthDay(DayNumber) '--------------------------------------- Draw Other Day response.write "" End Sub '********************************************************************************* '******** Write Event ************************************************************ '********************************************************************************* Sub WriteEvent(DateToUse, CalViewType) If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate = #" & DateToUse & "# ORDER BY Cal_EventStartTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate = #" & DateToUse & "# ORDER BY Cal_EventStartTime" End If Set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic Do While NOT RS.EOF SQLc = "SELECT * FROM Cal_Calendars WHERE Cal_CalendarID = " & RS("Cal_EventCalendarID") Set RSc=dbc.execute(SQLc) EventColor = RSc("Cal_CalendarColor") RSc.Close Set RSc=Nothing If RS("Cal_EventAllDay") <> "YES" then 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 "



" response.write "
" response.write "
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Password:
 
" response.write "
" If request.querystring("error") = "wrongpassword" then response.write "Sorry the password you have entered is not correct." End If response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Draw Add Event Screen ***************************************************** '********************************************************************************* Sub DrawAddEvent If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Add An Event" response.write "" %> <% response.write "" response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","Add An Event","11pt") 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 "" response.write "" response.write "" response.write "" response.write "" 'response.write "" 'response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Event Title:
Event Description:" response.write "" response.write "
" response.write "
Event Date: " If Session("DateFormat") = "US" then response.write "" Else response.write "" End If response.write "
  All Day Event
Event Start Time:" response.write "" response.write "
Event End Time:" response.write "" response.write "
Event Calendar:" response.write "" response.write "
Event Link:
Image:" response.write "
" Set FSO = CreateObject("Scripting.FileSystemObject") Set MainFolder = FSO.GetFolder(Server.MapPath("calendar/images/48")) Set ImageFiles = MainFolder.Files IconsAcross = 4 Counter = 0 response.write "" response.write "" For Each X In ImageFiles If right(UCASE(X.Name),3) = "JPG" OR right(UCASE(X.Name),3) = "GIF" OR right(UCASE(X.Name),3) = "PNG" then If Counter = IconsAcross then response.write "" response.write "" Counter = 0 End If response.write "" Counter = Counter + 1 End If Next response.write "
" response.write "
" response.write "
 
" response.write "
" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Draw Edit Event Screen **************************************************** '********************************************************************************* Sub DrawEditEvent If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & SafeSQL(request.querystring("eventID")) Set RS=dbc.execute(SQL) Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Edit An Event" response.write "" %> <% response.write "" response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","Add An Event","11pt") 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 "" 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 "
Event Title:
Event Description:" response.write "" response.write "
" & RS("Cal_EventBody") & "
" response.write "
Event Date: " response.write "" response.write "
  All Day Event
Event Start Time:" response.write "" response.write "
Event End Time:" response.write "" response.write "
Event Calendar:" response.write "" response.write "
Event Link:
Image:" response.write "
" Set FSO = CreateObject("Scripting.FileSystemObject") Set MainFolder = FSO.GetFolder(Server.MapPath("calendar/images/48")) Set ImageFiles = MainFolder.Files IconsAcross = 4 Counter = 0 response.write "" response.write "" For Each X In ImageFiles If right(UCASE(X.Name),3) = "JPG" OR right(UCASE(X.Name),3) = "GIF" OR right(UCASE(X.Name),3) = "PNG" then If Counter = IconsAcross then response.write "" response.write "" Counter = 0 End If response.write "" Counter = Counter + 1 End If Next response.write "
" response.write "
" response.write "
 
" response.write "
" response.write "
" response.write "
" response.write "" '----- Fill in some items ----------------------------------------------- If RS("Cal_EventStartTime") <> "" then %> '"> '"> <% End If If RS("Cal_EventAllDay") = "YES" then %> <% End If RS.Close Set RS=Nothing End Sub '********************************************************************************* '***** Delete Event ************************************************************** '********************************************************************************* Sub DeleteEvent If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "DELETE * FROM Cal_Events WHERE Cal_EventID = " & request.querystring("eventID") Set RS=dbc.execute(SQL) response.redirect "calendar.asp?date=" & request.querystring("date") End Sub '********************************************************************************* '***** Process Login ************************************************************* '********************************************************************************* Sub ProcessLogin SQL = "SELECT * FROM Cal_Config" Set RS=dbc.execute(SQL) If NOT RS.EOF then If RS("Cal_ConfigAdminPassword") = request.form("txtPassword") then Session("Cal_UserID") = 1 response.redirect "calendar.asp?action=summary&from=login" Else response.redirect "calendar.asp?action=login&error=wrongpassword" End If End If End Sub '********************************************************************************* '******** Process Logoff ********************************************************* '********************************************************************************* Sub Logoff Session.Abandon response.redirect "calendar.asp" End Sub '********************************************************************************* '******** Draw Header Bar ******************************************************** '********************************************************************************* Sub DrawHeaderBar theDate = WorkingDate HeaderText = CalType SELECT CASE HeaderText CASE "month" HeaderInfo = MonthName(Month(theDate)) & " " & Year(theDate) If Month(theDate) > 1 then PrevMonth = Month(theDate) - 1 PrevYear = Year(theDate) Else PrevMonth = 12 PrevYear = Year(theDate) - 1 End If If Month(theDate) < 12 then NextMonth = Month(theDate) + 1 NextYear = Year(theDate) Else NextMonth = 1 NextYear = Year(theDate) + 1 End If PrevDate = PrevYear & "-" & PrevMonth & "-1" NextDate = NextYear & "-" & NextMonth & "-1" CASE "day" HeaderInfo = FormatDateTime(theDate,1) PrevDate = cDate(theDate) - 1 NextDate = cDate(theDate) + 1 CASE "week" WeekDayTitleName = Weekday(theDate, 1) WeekDayTitleName = "Week of " & DateAdd("w", 1-WeekDayTitleName, theDate) HeaderInfo = WeekDayTitleName PrevDate = DateAdd("ww", -1, theDate) NextDate = DateAdd("ww", 1, theDate) CASE "year" PrevDate = DateAdd("yyyy", -1, theDate) NextDate = DateAdd("yyyy", 1, theDate) HeaderInfo = "Year View of " & Year(theDate) CASE "listing" PrevDate = DateAdd("m", -1, theDate) NextDate = DateAdd("m", 1, theDate) HeaderInfo = MonthName(Month(theDate)) & " " & Year(theDate) & " - " & MonthName(Month(DateAdd("m", 2, theDate))) & " " & Year(DateAdd("m", 2, theDate)) END SELECT %> <% '---------- New Button Bar -------------------------------------------------------- response.write "
" response.write "" If ClientBrowser <> "OTHER" then Call DrawButton("button_back.gif","Back a Month","","window.location.reload('calendar.asp?date=" & PrevDate & "&action=" & CalType & "');",30) Call DrawButton("","",HeaderInfo,"",150) Call DrawButton("button_forward.gif","Forward a Month","","window.location.reload('calendar.asp?date=" & NextDate & "&action=" & CalType & "');",30) Call DrawButtonSep Call DrawButton("button_day.gif","Day View","","window.location.reload('calendar.asp?action=day&date=" & theDate & "');",30) Call DrawButton("button_week.gif","Week View","","window.location.reload('calendar.asp?action=week&date=" & theDate & "');",30) Call DrawButton("button_month.gif","Month View","","window.location.reload('calendar.asp?action=month&date=" & theDate & "');",30) Call DrawButton("button_year.gif","Year View","","window.location.reload('calendar.asp?action=year&date=" & theDate & "');",30) Call DrawButton("button_gototoday.gif","Goto Today","","window.location.reload('calendar.asp?action=day&date=" & Date() & "');",30) Call DrawButtonSep Call DrawCalendarSelector Call DrawButtonSep If Session("Cal_UserID") = 1 then Call DrawButton("button_addevent.gif","Add Event","","NewWindow('calendar.asp?action=addevent&date=" & theDate & "','aspWebCalendarADDEVENT','500','540','no');",30) End If If Session("Cal_UserID") = "" then Call DrawButton("button_logon.gif","Login","","NewWindow('calendar.asp?action=login','aspWebCalendarLOGIN','580','430','no');",30) End If If Session("Cal_UserID") = 1 Then Call DrawButtonSep Call DrawButton("button_config.gif","Modify Config","","NewWindow('calendar.asp?action=modifyconfig','aspWebCalendarCONFIG','500','430','no');",30) Call DrawButton("button_calendars.gif","Manage Calendars","","NewWindow('calendar.asp?action=managecalendars','aspWebCalendarCALENDARS','500','400','no');",30) Call DrawButtonSep Call DrawButton("button_logoff.gif","Logoff","","window.location.reload('calendar.asp?action=logoff');",30) End If Else Call DrawBadBrowserButton("button_back.gif","Back a Month","","calendar.asp?date=" & PrevDate & "&action=" & CalType,30) Call DrawBadBrowserButton("","",HeaderInfo,"",150) Call DrawBadBrowserButton("button_forward.gif","Forward a Month","","calendar.asp?date=" & NextDate & "&action=" & CalType,30) Call DrawButtonSep Call DrawBadBrowserButton("button_day.gif","Day View","","calendar.asp?action=day&date=" & theDate & "",30) Call DrawBadBrowserButton("button_week.gif","Week View","","calendar.asp?action=week&date=" & theDate,30) Call DrawBadBrowserButton("button_month.gif","Month View","","calendar.asp?action=month&date=" & theDate,30) Call DrawBadBrowserButton("button_year.gif","Year View","","calendar.asp?action=year&date=" & theDate,30) Call DrawBadBrowserButton("button_gototoday.gif","Goto Today","","calendar.asp?action=day&date=" & Date() & "",30) Call DrawButtonSep Call DrawCalendarSelector Call DrawButtonSep If Session("Cal_UserID") = 1 then Call DrawButton("button_addevent.gif","Add Event","","NewWindow('calendar.asp?action=addevent&date=" & theDate & "','aspWebCalendarADDEVENT','500','540','no');",30) End If If Session("Cal_UserID") = "" then Call DrawButton("button_logon.gif","Login","","NewWindow('calendar.asp?action=login','aspWebCalendarLOGIN','580','430','no');",30) End If If Session("Cal_UserID") = 1 Then Call DrawButtonSep Call DrawBadBrowserButton("button_config.gif","Modify Config","","NewWindow('calendar.asp?action=modifyconfig','aspWebCalendarCONFIG','500','600','yes');",30) Call DrawBadBrowserButton("button_calendars.gif","Manage Calendars","","NewWindow('calendar.asp?action=managecalendars','aspWebCalendarCALENDARS','500','400','no');",30) Call DrawButtonSep Call DrawBadBrowserButton("button_logoff.gif","Logoff","","calendar.asp?action=logoff",30) End If End If response.write "
" response.write "
" '----------------------------------------------------------------------------------- End Sub '********************************************************************************* '******** Draw Month View ******************************************************** '********************************************************************************* Sub DrawMonthView '------- Setup some information about the month ----------------- ThisMonthsFirstDay = Year(WorkingDate) & "-" & Month(WorkingDate) & "-1" NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) '------- Draw the beginning of the calendar ---------------------- response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" & MonthSundayName & "" & MonthMondayName & "" & MonthTuesdayName & "" & MonthWednesdayName & "" & MonthThursdayName & "" & MonthFridayName & "" & MonthSaturdayName & "
" '-------- Main Calendar Table ------------------------------------- response.write "" response.write "" '-------- If the first day is not sunday -------------------------- If weekday(ThisMonthsFirstDay) > 1 then For Counter = day(StartDate) to day(LastMonthsLastDay) Call DrawOtherMonthDay(Counter) Next End If '-------- Draw normal days after Saturday, start a new row -------- For Counter = 1 to day(ThisMonthsLastDay) DateToUse = Year(WorkingDate) & "-" & Month(WorkingDate) & "-" & Counter Call DrawMonthNormalDay(Counter) If weekday(DateToUse) = 7 then response.write "" If Counter <> day(ThisMonthsLastDay) then response.write "" End If End if Next '-------- If last day is not saturday ----------------------------- If weekday(ThisMonthsLastDay) < 7 then For Counter = 1 to 7 - weekday(ThisMonthsLastDay) Call DrawOtherMonthDay(Counter) Next End If '-------- Draw the last row of the calendar ----------------------- response.write "" response.write "
" End Sub Sub DrawMonthNormalDay(DayNumber) '----------------------------------- Draw a Normal Day DateToUse = Year(WorkingDate) & "-" & Month(WorkingDate) & "-" & DayNumber If Date() = cDate(DateToUse) then MonthCalDayClass = "TableMonthDayCellToday" Else MonthCalDayClass = "TableMonthDayCell" End If response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write DayNumber response.write "  " response.write "
" 'response.write "
" Call WriteEvent(DateToUse, "MONTH") 'response.write "
" response.write "
" response.write "
" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" End If response.write "" response.write "" response.write "
  " response.write FormatTime(RS("Cal_EventStartTime")) response.write "" response.write "" response.write "" response.write "" response.write RS("Cal_EventTitle") & "" response.write "
" response.write "
" Else response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" End If response.write "" response.write "" response.write "
"" then response.write " colspan=2" End If response.write ">" response.write "" response.write "
" response.write "" response.write "" response.write "" response.write RS("Cal_EventTitle") & "" response.write "
" response.write "
" End If RS.MoveNext Loop RS.Close Set RS=Nothing End Sub '********************************************************************************* '******** Draw Mini Calendar ***************************************************** '********************************************************************************* Sub DrawMiniCalendar(theDate) '------- Setup some information about the month ----------------- ThisMonthsFirstDay = Year(theDate) & "-" & Month(theDate) & "-1" NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) StartDate = dateadd("d",1-weekday(ThisMonthsFirstDay),ThisMonthsFirstDay) '------- Containter for whole mini calendar ---------------------- response.write "" response.write "
" '------- Draw the month heading ---------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write MonthName(Month(theDate)) & " " & Year(theDate) response.write "" response.write "
" '------- Draw the beginning of the calendar ---------------------- response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" 'response.write "
 " & MiniSundayName & "" & MiniMondayName & "" & MiniTuesdayName & "" & MiniWednesdayName & "" & MiniThursdayName & "" & MiniFridayName & "" & MiniSaturdayName & "
" '-------- Main Calendar Table ------------------------------------- 'response.write "" response.write "" '----- Draw the Week button --------------------------------------- response.write "" '-------- If the first day is not sunday -------------------------- If weekday(ThisMonthsFirstDay) > 1 then For Counter = day(StartDate) to day(LastMonthsLastDay) Call DrawOtherMiniDay(Counter) Next End If '-------- Draw normal days after Saturday, start a new row -------- For Counter = 1 to day(ThisMonthsLastDay) DateToUse = Year(theDate) & "-" & Month(theDate) & "-" & Counter Call DrawMiniNormalDay(Counter, DateToUse) If weekday(DateToUse) = 7 then response.write "" If Counter <> day(ThisMonthsLastDay) then response.write "" '----- Draw the Week button --------------------------------------- response.write "" End If End If Next '-------- If last day is not saturday ----------------------------- If weekday(ThisMonthsLastDay) < 7 then For Counter = 1 to 7 - weekday(ThisMonthsLastDay) Call DrawOtherMiniDay(Counter) Next End If '-------- Draw the last row of the calendar ----------------------- response.write "" response.write "
W
W
" '-------- End of Container ---------------------------------------- response.write "

" End Sub Sub DrawMiniNormalDay(DayNumber, theDate) '----------------------------------- Draw a Normal Day DateToUse = Year(theDate) & "-" & Month(theDate) & "-" & DayNumber If Date() = cDate(DateToUse) then MonthCalDayClass = "TableMiniDayCellToday" Else MonthCalDayClass = "TableMiniDayCell" End If IsThereAnEvent = CheckForEvent(DateToUse) If IsThereAnEvent = "YES" then MonthCalDayClass = "TableMiniDayCellWithEvent" End If response.write "" response.write "" response.write "" response.write DayNumber response.write "" response.write "" End Sub Sub DrawOtherMiniDay(DayNumber) '--------------------------------------- Draw Other Day response.write "" response.write " " response.write "" End Sub '********************************************************************************* '******** Draw Day View ********************************************************** '********************************************************************************* Sub DrawDayView %> <% response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" TitleToWrite = "Events for: " & FormatDateTime(WorkingDate,1) & "" Call DrawTitle("100%","24",TitleToWrite,"11pt") Call DrawHLine(2) '----- Draw out the events ----------------------------------------------------- If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate = #" & WorkingDate & "# ORDER BY Cal_EventStartTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate = #" & WorkingDate & "# ORDER BY Cal_EventStartTime" End If Set RS=dbc.execute(SQL) If RS.EOF then '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "There are no events on this date." response.write "" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- End If Do While NOT RS.EOF '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "
" response.write RS("Cal_EventTitle") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventAllDay") = "YES" then response.write "" Else response.write "" End If If Session("Cal_UserID") = 1 then response.write "" End If 'If RS("Cal_EventLink") <> "" then ' response.write "" 'Else ' response.write "" 'End If response.write "
Date:" & FormatDateTime(RS("Cal_EventDate"),1) & "
Title:" & RS("Cal_EventTitle") & "
Description:" & RS("Cal_EventBody") & "
Times:ALL DAY EVENT
Times:" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & "
ADMIN:" response.write "EDIT | " response.write "DELETE" response.write "
Link:" & RS("Cal_EventLink") & "
Link:NONE
" response.write "

" RS.MoveNext '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- Loop RS.Close Set RS=Nothing response.write "
" PreviousMonth = DateAdd("m",-1,WorkingDate) NextMonth = DateAdd("m",1,WorkingDate) Call DrawMiniCalendar(PreviousMonth) Call DrawMiniCalendar(WorkingDate) Call DrawMiniCalendar(NextMonth) response.write "
" End Sub '********************************************************************************* '******** Draw Week View ********************************************************* '********************************************************************************* Sub DrawWeekView %> <% '----- Change the working date to the first day of the current week ----------- WeekDayTitleName = Weekday(WorkingDate, 1) WorkingDate = DateAdd("w", 1-WeekDayTitleName, WorkingDate) response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" TitleToWrite = "Events between: " & FormatDateTime(WorkingDate,1) & " and " & FormatDateTime(DateAdd("d",6,WorkingDate),1) & "" Call DrawTitle("100%","24",TitleToWrite,"11pt") Call DrawHLine(2) For I = 1 to 7 If I > 1 then WorkingDate = DateAdd("d",1,WorkingDate) End If TitleToWrite = "Events for: " & FormatDateTime(WorkingDate,1) & "" Call DrawSmallTitle("100%","18",TitleToWrite,"9pt") '----- Draw out the events ----------------------------------------------------- If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate = #" & WorkingDate & "# ORDER BY Cal_EventStartTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate = #" & WorkingDate & "# ORDER BY Cal_EventStartTime" End If Set RS=dbc.execute(SQL) If RS.EOF then '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "There are no events on this date." response.write "" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- End If Do While NOT RS.EOF '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "
" response.write RS("Cal_EventTitle") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventAllDay") = "YES" then response.write "" Else response.write "" End If If Session("Cal_UserID") = 1 then response.write "" End If 'If RS("Cal_EventLink") <> "" then ' response.write "" 'Else ' response.write "" 'End If response.write "
Date:" & FormatDateTime(RS("Cal_EventDate"),1) & "
Title:" & RS("Cal_EventTitle") & "
Description:" & RS("Cal_EventBody") & "
Times:ALL DAY EVENT
Times:" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & "
ADMIN:" response.write "EDIT | " response.write "DELETE" response.write "
Link:" & RS("Cal_EventLink") & "
Link:NONE
" response.write "

" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- RS.MoveNext Loop RS.Close Set RS=Nothing Next response.write "
" PreviousMonth = DateAdd("m",-1,WorkingDate) NextMonth = DateAdd("m",1,WorkingDate) Call DrawMiniCalendar(PreviousMonth) Call DrawMiniCalendar(WorkingDate) Call DrawMiniCalendar(NextMonth) response.write "
" End Sub '********************************************************************************* '******** Draw Year View ********************************************************* '********************************************************************************* Sub DrawYearView %> <% response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" TitleToWrite = "Events between: " & FormatDateTime(WorkingDate,1) & " and " & FormatDateTime(DateAdd("y",1,WorkingDate),1) & "" Call DrawTitle("100%","24",TitleToWrite,"11pt") Call DrawHLine(2) For I = 1 to 12 If I > 1 then WorkingDate = DateAdd("m",1,WorkingDate) End If '------- Setup some information about the month ----------------- ThisMonthsFirstDay = Year(WorkingDate) & "-" & Month(WorkingDate) & "-1" NextMonthsFirstDay = dateAdd("m",1,ThisMonthsFirstDay) ThisMonthsLastDay = dateadd("d",-1,NextMonthsFirstDay) LastMonthsLastDay = dateadd("d",-1,ThisMonthsFirstDay) TitleToWrite = "Events for: " & MonthName(Month(WorkingDate)) & " " & Year(WorkingDate) & "" Call DrawSmallTitle("100%","18",TitleToWrite,"9pt") '----- Draw out the events ----------------------------------------------------- If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate >= #" & ThisMonthsFirstDay & "# AND Cal_EventDate <= #" & ThisMonthsLastDay & "# ORDER BY Cal_EventDate, Cal_EventStartTime, Cal_EventEndTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate >= #" & ThisMonthsFirstDay & "# AND Cal_EventDate <= #" & ThisMonthsLastDay & "# ORDER BY Cal_EventDate, Cal_EventStartTime, Cal_EventEndTime" End If Set RS=dbc.execute(SQL) If RS.EOF then '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "There are no events on this date." response.write "" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- End If Do While NOT RS.EOF '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "
" response.write RS("Cal_EventTitle") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventAllDay") = "YES" then response.write "" Else response.write "" End If If Session("Cal_UserID") = 1 then response.write "" End If 'If RS("Cal_EventLink") <> "" then ' response.write "" 'Else ' response.write "" 'End If response.write "
Date:" & FormatDateTime(RS("Cal_EventDate"),1) & "
Title:" & RS("Cal_EventTitle") & "
Description:" & RS("Cal_EventBody") & "
Times:ALL DAY EVENT
Times:" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & "
ADMIN:" response.write "EDIT | " response.write "DELETE" response.write "
Link:" & RS("Cal_EventLink") & "
Link:NONE
" response.write "

" RS.MoveNext '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- Loop RS.Close Set RS=Nothing Next response.write "
" PreviousMonth = DateAdd("m",-1,WorkingDate) NextMonth = DateAdd("m",1,WorkingDate) Call DrawMiniCalendar(PreviousMonth) Call DrawMiniCalendar(WorkingDate) Call DrawMiniCalendar(NextMonth) response.write "
" End Sub '********************************************************************************* '******** Draw View Event ******************************************************** '********************************************************************************* Sub DrawViewEvent %> <% response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" TitleToWrite = "Event View: " Call DrawTitle("100%","24",TitleToWrite,"11pt") Call DrawHLine(2) SQL = "SELECT * FROM Cal_Events WHERE Cal_EventID = " & SafeSQL(request.querystring("eventid")) Set RS=dbc.execute(SQL) If NOT RS.EOF then '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventImage") <> "" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "
" response.write RS("Cal_EventTitle") response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" If RS("Cal_EventAllDay") = "YES" then response.write "" Else response.write "" End If If Session("Cal_UserID") = 1 then response.write "" End If 'If RS("Cal_EventLink") <> "" then ' response.write "" 'Else ' response.write "" 'End If response.write "
Date:" & FormatDateTime(RS("Cal_EventDate"),1) & "
Title:" & RS("Cal_EventTitle") & "
Description:" & RS("Cal_EventBody") & "
Times:ALL DAY EVENT
Times:" & FormatTime(RS("Cal_EventStartTime")) & " - " & FormatTime(RS("Cal_EventEndTime")) & "
ADMIN:" response.write "EDIT | " response.write "DELETE" response.write "
Link:" & RS("Cal_EventLink") & "
Link:NONE
" response.write "

" '---- Indent the events ---------------------------------------------------------------------------- response.write "
" '--------------------------------------------------------------------------------------------------- End If RS.Close Set RS=Nothing response.write "
" PreviousMonth = DateAdd("m",-1,WorkingDate) NextMonth = DateAdd("m",1,WorkingDate) Call DrawMiniCalendar(PreviousMonth) Call DrawMiniCalendar(WorkingDate) Call DrawMiniCalendar(NextMonth) response.write "
" End Sub '********************************************************************************* '***** Draw Manage Calendars Screen ********************************************** '********************************************************************************* Sub ManageCalendars If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If %> <% Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Manage Calendars" response.write "" %> <% response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","Manage Calendars","11pt") response.write "" response.write "" response.write "" If request.querystring("action") = "managecalendars" then response.write "" response.write "" Else SQLc = "SELECT * FROM Cal_Calendars WHERE Cal_CalendarID = " & SafeSQL(request.querystring("calendarID")) Set RSc=dbc.execute(SQLc) response.write "" response.write "" RSc.Close Set RSc=Nothing End If response.write "
" response.write "
" ColorCounter = 0 response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" SQL = "SELECT * FROM Cal_Calendars ORDER BY Cal_CalendarName" Set RS=dbc.execute(SQL) Do While NOT RS.EOF If ColorCounter = 0 then BackColor = "white" ColorCounter = 1 Else BackColor = "#EEEEEE" ColorCounter = 0 End If response.write "" response.write "" response.write "" response.write "" response.write "" RS.MoveNext Loop response.write "
Calendar NameColorActions
" & RS("Cal_CalendarName") & "" response.write "" response.write "█ " response.write RS("Cal_CalendarColor") & "EDIT | DELETE
" response.write "
" response.write "
" response.write "
Add A Calendar" '------------------------------------------------------------------------------- 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 "
Calendar Name:
Calendar Color: " response.write "" response.write "
 
" response.write "
" response.write "
" '------------------------------------------------------------------------------- response.write "
" response.write "
" response.write "
Edit Calendar" '------------------------------------------------------------------------------- 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 "" response.write "
Calendar Name:
Calendar Color: " response.write "" response.write "
 
" response.write "
" response.write "
" '------------------------------------------------------------------------------- response.write "
" response.write "
" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Delete Calendar *********************************************************** '********************************************************************************* Sub DeleteCalendar If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "DELETE * FROM Cal_Events WHERE Cal_EventCalendarID = " & SafeSQL(request.querystring("calendarID")) Set RS=dbc.execute(SQL) SQL = "DELETE * FROM Cal_Calendars WHERE Cal_CalendarID = " & SafeSQL(request.querystring("calendarID")) Set RS=dbc.execute(SQL) response.redirect "calendar.asp?action=managecalendars" End Sub '********************************************************************************* '***** Draw Edit Config Screen *************************************************** '********************************************************************************* Sub EditConfig If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "SELECT * FROM Cal_Config WHERE Cal_ConfigID = 1" Set RS=dbc.execute(SQL) Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Edit Configuration" 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 "
" Call DrawTitle2("100%","24","Edit Configuration","11pt") 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 "" 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 "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Script Title:
Admin Password:
Default Color Scheme:" response.write "
Image Folder:
Date Format:" response.write " US (mm/dd/yyyy) " response.write " EURO (dd/mm/yyyy) " response.write "
LCID:" response.write "" response.write "
TimeFormatToUse:" response.write " 12 Hour (AM/PM) " response.write " 24 Hour (Military Time) " response.write "
HTML Template:
Main Font Face:
Month Block Height:
MiniCalendarWidth:
DefaultView:" response.write " Day " response.write " Week " response.write " Month " response.write " Year " 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 "" RS.Close Set RS=Nothing End Sub '********************************************************************************* '***** Security Check ************************************************************ '********************************************************************************* Sub SecurityCheck Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - SECURITY CHECK" response.write "" %> <% response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","SECURITY CHECK","11pt") response.write "" response.write "" response.write "" response.write "
" response.write "SORRY! YOU DON'T HAVE ACCESS TO THIS FUNCTION!" response.write "
" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Draw Manage Color Schemes Screen ****************************************** '********************************************************************************* Sub ManageColorSchemes If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If %> <% Call BuildStyles response.write "" response.write "" response.write "" & ScriptTitle & " - Manage ColorSchemes" response.write "" %> <% response.write "" response.write "" '------------------------------------------------------------------------- response.write "
" response.write "" response.write "" response.write "
" Call DrawTitle2("100%","24","Manage Color Schemes","11pt") response.write "" response.write "" response.write "" If request.querystring("action") = "managecolorschemes" then response.write "" response.write "" Else SQLc = "SELECT * FROM Cal_ColorSchemes WHERE ColorSchemeID = " & SafeSQL(request.querystring("colorschemeID")) Set RSc=dbc.execute(SQLc) response.write "" response.write "" RSc.Close Set RSc=Nothing End If response.write "
" response.write "
" ColorCounter = 0 response.write "" response.write "" response.write "" response.write "" response.write "" SQL = "SELECT * FROM Cal_ColorSchemes ORDER BY ColorSchemeName" Set RS=dbc.execute(SQL) Do While NOT RS.EOF If ColorCounter = 0 then BackColor = "white" ColorCounter = 1 Else BackColor = "#EEEEEE" ColorCounter = 0 End If response.write "" response.write "" response.write "" Else response.write "CURRENT" End If response.write "" RS.MoveNext Loop response.write "
Color Scheme NameActions
" & RS("ColorSchemeName") & "EDIT | " If RS("ColorSchemeID") <> cint(Session("DefaultColorScheme")) then response.write "DELETE
" response.write "
" response.write "
" response.write "
Add A Color Scheme" '------------------------------------------------------------------------------- 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 "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Color Scheme Name:
Light Color: " response.write "" response.write "
Mid Light Color: " response.write "" response.write "
Light Main Color: " response.write "" response.write "
Dark Main Color: " response.write "" response.write "
Light Line Color: " response.write "" response.write "
Primary Highlight Color: " response.write "" response.write "
Secondary Highlight Color: " response.write "" response.write "
 
" response.write "
" response.write "
" '------------------------------------------------------------------------------- response.write "
" response.write "
" response.write "
Add A Color Scheme" '------------------------------------------------------------------------------- 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 "" 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 "
Color Scheme Name:
Light Color: " response.write "" response.write "
Mid Light Color: " response.write "" response.write "
Light Main Color: " response.write "" response.write "
Dark Main Color: " response.write "" response.write "
Light Line Color: " response.write "" response.write "
Primary Highlight Color: " response.write "" response.write "
Secondary Highlight Color: " response.write "" response.write "
 
" response.write "
" response.write "
" '------------------------------------------------------------------------------- response.write "
" response.write "
" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '***** Delete ColorScheme ******************************************************** '********************************************************************************* Sub DeleteColorScheme If Session("Cal_UserID") = "" then response.redirect "calendar.asp?action=securitycheck" End If SQL = "DELETE * FROM Cal_ColorSchemes WHERE ColorSchemeID = " & SafeSQL(request.querystring("colorschemeID")) Set RS=dbc.execute(SQL) response.redirect "calendar.asp?action=managecolorschemes" End Sub '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '******** FUNCTIONS ONLY BELOW HERE ************************************************* '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '************************************************************************************ '********************************************************************************* '******** Build Style Tags ******************************************************* '********************************************************************************* Sub BuildStyles StyleCode = "" StyleCode = StyleCode & ".TableMonthHeader{font-family:" & MainFontFace & ";font-size:9pt;font-weight:bold;color:black}" & vbcrlf StyleCode = StyleCode & ".MonthHeadings{width:14%;text-align:center;font-size:9pt;font-family:" & MainFontFace & ";background-color:" & DarkMainColor & ";border-top:1px solid " & LightLineColor & ";border-bottom:1px solid " & LightLineColor & ";color:white;font-weight:bold;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightMainColor & "', EndColorStr='" & DarkMainColor & "')}" & vbcrlf StyleCode = StyleCode & ".TableMonthCalendar{font-family:" & MainFontFace & ";height:95%;padding:0;background-color:white;border-collapse:collapse;border-style:none;border-color:black" & LightLineColor & ";}" & vbcrlf StyleCode = StyleCode & ".TableMonthDayCellToday{font-family:" & MainFontFace & ";border-style:solid;border-width:1;border-color:" & LightLineColor & ";text-align:left;vertical-align:top;background-color:#CCCCCC;}" & vbcrlf StyleCode = StyleCode & ".TableMonthDayCell{font-family:" & MainFontFace & ";border-style:solid;border-width:1;border-color:" & LightLineColor & ";text-align:left;vertical-align:top;background-color:#FFFFFF;border-collapse:collapse;}" & vbcrlf StyleCode = StyleCode & ".MonthSubHeadings{font-family:" & MainFontFace & ";font-size:8pt;background-color:" & MidLightColor & ";color:black;font-weight:normal;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".TableMonthOtherDayCell{font-family:" & MainFontFace & ";border-style:solid;border-width:1;border-color:" & LightLineColor & ";text-align:center;vertical-align:top;background-color:" & MidLightColor & ";border-collapse:collapse;}" & vbcrlf StyleCode = StyleCode & ".EventTable{font-family:" & MainFontFace & ";border-style:solid;border-width:1;border-color:black;border-collapse:collapse;border-width:1;text-align:left;background-color:white;padding:1;width:100%;}" & vbcrlf StyleCode = StyleCode & ".EventTitleFont{font-family:" & MainFontFace & ";font-size:7pt;}" & vbcrlf StyleCode = StyleCode & ".EventTimeCell{font-family:" & MainFontFace & ";font-size:7pt;width:10%;text-align:left;background-color:#DDDDDD;}" & vbcrlf StyleCode = StyleCode & ".EventTimeFont{font-family:" & MainFontFace & ";font-size:7pt;}" & vbcrlf StyleCode = StyleCode & ".EventTitleCell{font-family:" & MainFontFace & ";font-size:7pt;width:90%;text-align:left;background-color:white;}" & vbcrlf StyleCode = StyleCode & ".EventTitleFont{font-family:" & MainFontFace & ";font-size:7pt;}" & vbcrlf StyleCode = StyleCode & ".EventTitleCellAllDay{font-family:" & MainFontFace & ";font-size:7pt;text-align:center}" & vbcrlf StyleCode = StyleCode & ".MonthDayDiv{width:100%;height:85%;overflow:visible;}" & vbcrlf StyleCode = StyleCode & ".MiniHeadingBar{background-color:" & LightMainColor & ";height:19px;text-align:center;border-top:1px solid " & LightLineColor & ";border-bottom:1px solid " & LightLineColor & ";font-family:" & MainFontFace & ";font-size:8pt;color:black;font-weight:bold;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".TableMiniHeader{height:1;padding:0;background-color:white;border-style:solid;border-color:" & LightLineColor & ";border-width:0;border-collapse:collapse;}" & vbcrlf StyleCode = StyleCode & ".MiniCalHeading{width:14%;font-family:" & MainFontFace & ";font-size:8pt;color:black;font-weight:normal;background-color:" & LightColor & ";text-align:center;}" & vbcrlf StyleCode = StyleCode & ".TableMiniCalendar{padding:0;background-color:white;border-collapse:collapse;border-width:0;border-style:none;}" & vbcrlf StyleCode = StyleCode & ".TableMiniDayCellToday{border-style:solid;border-width:1;border-color:white;text-align:center;vertical-align:top;background-color:silver;padding:0;}" & vbcrlf StyleCode = StyleCode & ".TableMiniDayCell{border-style:solid;border-width:1;border-color:white;text-align:center;vertical-align:center;background-color:white;padding:0;border-collapse:collapse;cursor:hand;}" & vbcrlf StyleCode = StyleCode & ".TableMiniDayCellWithEvent{border-style:solid;border-width:1;border-color:white;text-align:center;vertical-align:center;background-color:" & PrimaryHighlightColor & ";padding:0;border-collapse:collapse;cursor:hand}" & vbcrlf StyleCode = StyleCode & ".FontCalendarDay{font-family:" & MainFontFace & ";font-size:7pt;}" & vbcrlf StyleCode = StyleCode & ".TableMiniOtherDayCell{border-style:solid;border-width:1;border-color:white;text-align:center;vertical-align:center;background-color:" & MidLightColor & ";padding:0;border-collapse:collapse;}" & vbcrlf StyleCode = StyleCode & ".EventLeftTD{width:20%;font-family:" & MainFontFace & ";font-size:8pt;font-weight:bold;background-color:" & LightColor & ";}" & vbcrlf StyleCode = StyleCode & ".EventRightTD{width:80%;font-family:" & MainFontFace & ";font-size:8pt;}" & vbcrlf StyleCode = StyleCode & ".EventTitleBar{background-color:" & MidLightColor & ";height:19px;text-align:left;border-top:1px solid " & LightLineColor & ";border-bottom:1px solid " & LightLineColor & ";font-family:" & MainFontFace & ";font-size:10pt;color:black;font-weight:bold;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightMainColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".ButtonBar{background-color:" & LightColor & ";padding-top:1px;width:100%;height:30px;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".Button{background-color:" & LightColor & ";cursor:hand;padding:1px 1px 1px 1px;height:27px;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & LightColor & "', EndColorStr='" & MidLightColor & "')}" & vbcrlf StyleCode = StyleCode & ".ButtonOver{background-color:" & MidLightColor & ";cursor:hand;border: 1px solid " & LightLineColor & ";height:27px;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='" & PrimaryHighlightColor & "', EndColorStr='" & SecondaryHighlightColor & "')}" & vbcrlf StyleCode = StyleCode & ".ButtonFont{font-family:" & MainFontFace & ";font-size:9pt;font-weight:bold;}" & vbcrlf StyleCode = StyleCode & ".PageBody{background-color:" & DarkMainColor & ";filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='" & LightMainColor & "', EndColorStr='" & DarkMainColor & "')}" & vbcrlf StyleCode = StyleCode & ".SideBar{background-color:" & DarkMainColor & ";filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='" & LightMainColor & "', EndColorStr='" & DarkMainColor & "')}" & vbcrlf StyleCode = StyleCode & ".StandardFont{font-family:" & MainFontFace & ";font-size:8pt;color:black;font-weight:bold;}" & vbcrlf StyleCode = StyleCode & ".StandardTextBox{font-family:" & MainFontFace & ";font-size:8pt;color:black;font-weight:normal;width:100%;}" & vbcrlf StyleCode = StyleCode & ".DescriptionHeadingFont{font-family:" & MainFontFace & ";font-size:13pt;color:yellow;font-weight:bold;}" & vbcrlf StyleCode = StyleCode & ".DescriptionFont{font-family:" & MainFontFace & ";font-size:8pt;color:white;font-weight:normal;}" & vbcrlf StyleCode = StyleCode & ".EditPaneTable{width:99%; border:0px;}" & vbcrlf StyleCode = StyleCode & ".EditPaneLeft{width:25%;font-family:Arial;font-size:8pt;}" & vbcrlf StyleCode = StyleCode & ".EditPaneRight{width:75%;font-family:Arial;font-size:8pt;}" & vbcrlf StyleCode = StyleCode & ".ErrorFont{font-family:" & MainFontFace & ";font-size:8pt;color:red;font-weight:bold;}" & vbcrlf Session("StyleCode") = StyleCode End Sub '********************************************************************************* '******** Load the Template File We are Using ************************************ '********************************************************************************* Sub LoadTemplate Call BuildStyles TemplateFile = Server.MapPath(HTMLTemplate) Set fs = CreateObject("Scripting.FileSystemObject") Set thisfile = fs.OpenTextFile(TemplateFile, 1, False) tempSTR=thisfile.readall TemplateContent = tempSTR thisfile.Close set thisfile=nothing set fs=nothing TemplateContent = replace(TemplateContent,"%%STYLES%%",Session("StyleCode")) TemplateArray = split(TemplateContent,"%%CONTENT%%") Session("PageHeader") = TemplateArray(0) Session("PageFooter") = TemplateArray(1) Session("TemplateLoaded") = "YES" End Sub '********************************************************************************* '******** Draw Summary Window **************************************************** '********************************************************************************* Sub DrawSummary %> Indianfields <% End Sub '********************************************************************************* '******** Draw Summary Window **************************************************** '********************************************************************************* Sub DrawSummary2 %> <% End Sub '************************************************************************************ '***** Universal Date Format Function *********************************************** '************************************************************************************ Function UniversalDate(dteDate) If IsDate(dteDate) = True Then dteDay = Day(dteDate) dteMonth = Month(dteDate) dteYear = Year(dteDate) UniversalDate = dteYear & "-" & Right(Cstr(dteMonth + 100),2) & "-" & Right(Cstr(dteDay + 100),2) Else UniversalDate = Null End If End Function '************************************************************************************ '***** Display Date Format Function ************************************************* '************************************************************************************ Function FormatDisplayDate(aDate) aDate = cdate(aDate) aDay = Day(aDate) aMonth = Month(aDate) aYear = Year(aDate) SELECT CASE DateDisplayFormat CASE "US" FormatDisplayDate = Right(Cstr(aMonth + 100),2) & "/" & Right(Cstr(aDay + 100),2) & "/" & aYear CASE "EURO" CASE "UNIVERSAL" CASE ELSE FormatDisplayDate = Right(Cstr(aMonth + 100),2) & "-" & Right(Cstr(aDay + 100),2) & "-" & aYear END SELECT End Function '********************************************************************************* '******** Determine Browser Type ************************************************* '********************************************************************************* Function GetBrowserType(BrowserAgent) If InStr(BrowserAgent, UCASE("MSIE")) then Browser = "Microsoft Internet Explorer" Else Browser = "OTHER" End If GetBrowserType = Browser End Function '*************************************************************************************** '****** Generic DB Record Add ********************************************************** '*************************************************************************************** Sub DBAddRecord TableName = Request("TableName") RedirURL = Request("RedirURL") Set RS = Server.CreateObject("ADODB.Recordset") RS.MaxRecords = 1 RS.Open "SELECT * FROM " & TableName , dbc, adOpenDynamic, adLockPessimistic, adCMDText RS.AddNew For Each strColumnName in Request.Form If UCase(Left(strColumnName,3)) = "COL" then If Len(Request(strColumnName)) > 0 Then RS(Mid(strColumnName,4,Len(strColumnName))) = Request(strColumnName) 'response.write (Mid(strColumnName,4,Len(strColumnName))) & " = " & Request(strColumnName) & "
" End If End If Next RS.Update RS.Close Set RS = Nothing response.redirect RedirURL End Sub '*************************************************************************************** '****** Generic DB Record Update ******************************************************* '*************************************************************************************** Sub DBUpdateRecord TableKey = Request("TableKey") RecordID = Request("RecordID") TableName = Request("TableName") RedirURL = Request("RedirURL") SQL="UPDATE " & TableName & " SET " For Each strColumnName in Request.Form If UCase(Left(strColumnName,3)) = "COL" then 'If Len(Request(strColumnName)) > 0 Then SQL = SQL & Mid(strColumnName,4,Len(strColumnName)) & " = '" & FixString(Request(strColumnName)) & "'," 'End If End If Next SQL = Left(SQL, len(SQL)-1) SQL = SQL & " WHERE [" & TableKey & "] = " & RecordID dbc.execute(SQL) 'response.write SQL If request.form("from") = "editconfig" then Session("ConfigLoaded") = "NO" End If response.redirect RedirURL End Sub '********************************************************************************* '***** Format Time Function ****************************************************** '********************************************************************************* Function FormatTime(TimeValue) If TimeFormatToUse = "12" then TimeValue = replace(TimeValue," ","") TimeValue = replace(TimeValue,":","") TimeValue = replace(TimeValue,".","") TimeValue = replace(TimeValue,"-","") TimeValue = replace(TimeValue,"e","") TimeValue = replace(TimeValue,"E","") TimeValue = replace(TimeValue,"M","") TimeValue = replace(TimeValue,"m","") If NOT ((ucase(right(TimeValue,1))="A") or (ucase(right(TimeValue,1))="P")) then TimeFormat = "24" Else TempAMPM = ucase(right(TimeValue,1) & "M") End If TimeLength = len(TimeValue)-1 StripTime = left(TimeValue,TimeLength) If len(StripTime) > 4 then StripTime = left(StripTime,len(StripTime)-2) End If If len(StripTime) = 3 then TimePartA = abs(left(StripTime,1)) Else TimePartA = abs(left(StripTime,2)) TimePartB = abs(left(StripTime,2)) End If If left(TimePartA, 1) = 0 then TimePartA = right(TimePartA, len(TimePartA)-1) End If TimePartB = right(StripTime,2) TempTime = TimePartA & ":" & TimePartB & TempAMPM FormatTime = TempTime Else TempTimeValue = left(TimeValue, 5) FormatTime = TempTimeValue End If End Function '********************************************************************************* '***** Format Time Function ****************************************************** '********************************************************************************* Function FormatTime2(TimeValue) If TimeFormatToUse = "12" then TimeValue = replace(TimeValue," ","") TimeValue = replace(TimeValue,":","") TimeValue = replace(TimeValue,".","") TimeValue = replace(TimeValue,"-","") TimeValue = replace(TimeValue,"e","") TimeValue = replace(TimeValue,"E","") TimeValue = replace(TimeValue,"M","") TimeValue = replace(TimeValue,"m","") If NOT ((ucase(right(TimeValue,1))="A") or (ucase(right(TimeValue,1))="P")) then TimeFormat = "24" Else TempAMPM = ucase(right(TimeValue,1) & "M") End If TimeLength = len(TimeValue)-1 StripTime = left(TimeValue,TimeLength) If len(StripTime) > 4 then StripTime = left(StripTime,len(StripTime)-2) End If If len(StripTime) = 3 then TimePartA = abs(left(StripTime,1)) Else TimePartA = abs(left(StripTime,2)) TimePartB = abs(left(StripTime,2)) End If If left(TimePartA, 1) = 0 then TimePartA = right(TimePartA, len(TimePartA)-1) End If TimePartB = right(StripTime,2) TempTime = TimePartA & ":" & TimePartB & " " & TempAMPM FormatTime2 = TempTime Else Dim hour,minute hour = left(TimeValue, 2) minute = left(TimeValue, 5) minute = right(minute, 2) If right(hour, 1) = ":" then hour = left(hour, 1) End If If left(hour, 1) = "0" then hour = right(hour, 1) End If If right(minute,1) = ":" then minute = left(minute,1) & "0" End If If hour < 12 then clocktime = hour & ":" & minute & " AM" Else If hour <> 12 then hour = hour - 12 End If clocktime = hour & ":" & minute & " PM" End If StandardTime = clocktime TempTimeValue = StandardTime FormatTime2 = TempTimeValue End If End Function '********************************************************************************* '******* Check Day For Event ***************************************************** '********************************************************************************* Function CheckForEvent(DateToUse) If Session("CalendarFilter") > 0 then SQL = "SELECT * FROM Cal_Events WHERE Cal_EventCalendarID = "& Session("CalendarFilter") &" AND Cal_EventDate = #" & DateToUse & "# ORDER BY Cal_EventStartTime" Else SQL = "SELECT * FROM Cal_Events WHERE Cal_EventDate = #" & DateToUse & "# ORDER BY Cal_EventStartTime" End If Set RS=dbc.execute(SQL) Return = "NO" Do While NOT RS.EOF Return = "YES" Exit Do RS.MoveNext Loop RS.Close Set RS=Nothing CheckForEvent = Return End Function '********************************************************************************* '******** Draw Horizontal Line *************************************************** '********************************************************************************* Sub DrawHLine(LineWidth) response.write "
" response.write "
" End Sub '********************************************************************************* '******** Draw Title ************************************************************* '********************************************************************************* Sub DrawTitle(TitleWidth,TitleHeight,TitleToWrite,FontPoint) response.write "
" response.write "" & TitleToWrite & "" response.write "
" End Sub '********************************************************************************* '******** Draw Title 2 *********************************************************** '********************************************************************************* Sub DrawTitle2(TitleWidth,TitleHeight,TitleToWrite,FontPoint) response.write "
" response.write "" & TitleToWrite & "" response.write "
" End Sub '********************************************************************************* '******** Draw Title ************************************************************* '********************************************************************************* Sub DrawSmallTitle(TitleWidth,TitleHeight,TitleToWrite,FontPoint) response.write "
" response.write "" & TitleToWrite & "" response.write "
" End Sub '********************************************************************************* '******** Draw Button ************************************************************ '********************************************************************************* Sub DrawButton(ButtonImage, ButtonAlt, ButtonText, ButtonAction, ButtonWidth) response.write "" If ButtonAction <> "" then response.write "
" Else response.write "
" End If response.write "" response.write "" If ButtonImage <> "" then response.write "" End If If ButtonText <> "" then response.write "" End If response.write "" response.write "
" & ButtonAlt & " " & ButtonText & "
" response.write "
" response.write "" End Sub '********************************************************************************* '******** Draw Bad Browser Button ************************************************ '********************************************************************************* Sub DrawBadBrowserButton(ButtonImage, ButtonAlt, ButtonText, ButtonAction, ButtonWidth) response.write "" If ButtonAction <> "" then response.write "
" response.write "" End If response.write "" response.write "" If ButtonImage <> "" then response.write "" End If If ButtonText <> "" then response.write "" End If response.write "" response.write "
" & ButtonAlt & " " & ButtonText & "
" If ButtonAction <> "" then response.write "
" End If response.write "
" response.write "" End Sub '********************************************************************************* '******** Draw Button Seperator ************************************************** '********************************************************************************* Sub DrawButtonSep response.write "" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "
" response.write "" End Sub '********************************************************************************* '******** Draw Calendar Selector ************************************************* '********************************************************************************* Sub DrawCalendarSelector response.write "" response.write "
" response.write "" response.write "
" response.write "" End Sub '********************************************************************************* '******** Draw Time Drop Down **************************************************** '********************************************************************************* 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 '********************************************************************************* '******** SQL Injection Filter *************************************************** '********************************************************************************* Function SafeSQL(sInput) TempString = sInput 'sBadChars=array("select", "drop", ";", "--", "insert", "delete", "xp_", "#", "%", "&", "'", "(", ")", "/", "\", ":", ";", "<", ">", "=", "[", "]", "?", "`", "|") sBadChars=array("select", "drop", ";", "--", "insert", "delete", "xp_", "#", "%", "&", "'", "(", ")", ":", ";", "<", ">", "=", "[", "]", "?", "`", "|") For iCounter = 0 to uBound(sBadChars) TempString = replace(TempString,sBadChars(iCounter),"") Next SafeSQL = TempString End function '********************************************************************************* '******** FixString Function ***************************************************** '********************************************************************************* Function FixString(strSource) strSource = Replace(strSource, "'", "''") strSource = Replace(strSource, "''''", "''") FixString = Replace(strSource, "'''", "''") End Function %>