<% '------------------------------------------------------------------------ ' Title: text.asp ' Description: Retrieves a story from the database with the pid equal to the Request parameter ' Original: Monarch Media ' Review: Andre Daniels 2008-05-07 '------------------------------------------------------------------------ ' Changes ' 2008-05-07 Andre Daniels andre777@ucsc.edu ' clean up and added Check for error to loop over recordset ' 2009-04-30 Rob Knight raknight@ucsc.edu ' This file lives in /news_events/budget_update ' ----------------------------------------------------------------------- server.ScriptTimeout= GLOBAL_SCRIPT_TIMEOUT %> <% '-------------------------------------------------------------------- ' Microsoft ADO ' ' (c) 1996-1998 Microsoft Corporation. All Rights Reserved. ' ' ' ' ADO constants include file for VBScript ' '-------------------------------------------------------------------- '---- CursorTypeEnum Values ---- Const adOpenForwardOnly = 0 Const adOpenKeyset = 1 Const adOpenDynamic = 2 Const adOpenStatic = 3 '---- CursorOptionEnum Values ---- Const adHoldRecords = &H00000100 Const adMovePrevious = &H00000200 Const adAddNew = &H01000400 Const adDelete = &H01000800 Const adUpdate = &H01008000 Const adBookmark = &H00002000 Const adApproxPosition = &H00004000 Const adUpdateBatch = &H00010000 Const adResync = &H00020000 Const adNotify = &H00040000 Const adFind = &H00080000 Const adSeek = &H00400000 Const adIndex = &H00800000 '---- LockTypeEnum Values ---- Const adLockReadOnly = 1 Const adLockPessimistic = 2 Const adLockOptimistic = 3 Const adLockBatchOptimistic = 4 '---- ExecuteOptionEnum Values ---- Const adRunAsync = &H00000010 Const adAsyncExecute = &H00000010 Const adAsyncFetch = &H00000020 Const adAsyncFetchNonBlocking = &H00000040 Const adExecuteNoRecords = &H00000080 '---- ConnectOptionEnum Values ---- Const adAsyncConnect = &H00000010 '---- ObjectStateEnum Values ---- Const adStateClosed = &H00000000 Const adStateOpen = &H00000001 Const adStateConnecting = &H00000002 Const adStateExecuting = &H00000004 Const adStateFetching = &H00000008 '---- CursorLocationEnum Values ---- Const adUseServer = 2 Const adUseClient = 3 '---- DataTypeEnum Values ---- Const adEmpty = 0 Const adTinyInt = 16 Const adSmallInt = 2 Const adInteger = 3 Const adBigInt = 20 Const adUnsignedTinyInt = 17 Const adUnsignedSmallInt = 18 Const adUnsignedInt = 19 Const adUnsignedBigInt = 21 Const adSingle = 4 Const adDouble = 5 Const adCurrency = 6 Const adDecimal = 14 Const adNumeric = 131 Const adBoolean = 11 Const adError = 10 Const adUserDefined = 132 Const adVariant = 12 Const adIDispatch = 9 Const adIUnknown = 13 Const adGUID = 72 Const adDate = 7 Const adDBDate = 133 Const adDBTime = 134 Const adDBTimeStamp = 135 Const adBSTR = 8 Const adChar = 129 Const adVarChar = 200 Const adLongVarChar = 201 Const adWChar = 130 Const adVarWChar = 202 Const adLongVarWChar = 203 Const adBinary = 128 Const adVarBinary = 204 Const adLongVarBinary = 205 Const adChapter = 136 Const adFileTime = 64 Const adDBFileTime = 137 Const adPropVariant = 138 Const adVarNumeric = 139 '---- FieldAttributeEnum Values ---- Const adFldMayDefer = &H00000002 Const adFldUpdatable = &H00000004 Const adFldUnknownUpdatable = &H00000008 Const adFldFixed = &H00000010 Const adFldIsNullable = &H00000020 Const adFldMayBeNull = &H00000040 Const adFldLong = &H00000080 Const adFldRowID = &H00000100 Const adFldRowVersion = &H00000200 Const adFldCacheDeferred = &H00001000 Const adFldKeyColumn = &H00008000 '---- EditModeEnum Values ---- Const adEditNone = &H0000 Const adEditInProgress = &H0001 Const adEditAdd = &H0002 Const adEditDelete = &H0004 '---- RecordStatusEnum Values ---- Const adRecOK = &H0000000 Const adRecNew = &H0000001 Const adRecModified = &H0000002 Const adRecDeleted = &H0000004 Const adRecUnmodified = &H0000008 Const adRecInvalid = &H0000010 Const adRecMultipleChanges = &H0000040 Const adRecPendingChanges = &H0000080 Const adRecCanceled = &H0000100 Const adRecCantRelease = &H0000400 Const adRecConcurrencyViolation = &H0000800 Const adRecIntegrityViolation = &H0001000 Const adRecMaxChangesExceeded = &H0002000 Const adRecObjectOpen = &H0004000 Const adRecOutOfMemory = &H0008000 Const adRecPermissionDenied = &H0010000 Const adRecSchemaViolation = &H0020000 Const adRecDBDeleted = &H0040000 '---- GetRowsOptionEnum Values ---- Const adGetRowsRest = -1 '---- PositionEnum Values ---- Const adPosUnknown = -1 Const adPosBOF = -2 Const adPosEOF = -3 '---- enum Values ---- Const adBookmarkCurrent = 0 Const adBookmarkFirst = 1 Const adBookmarkLast = 2 '---- MarshalOptionsEnum Values ---- Const adMarshalAll = 0 Const adMarshalModifiedOnly = 1 '---- AffectEnum Values ---- Const adAffectCurrent = 1 Const adAffectGroup = 2 Const adAffectAll = 3 Const adAffectAllChapters = 4 '---- ResyncEnum Values ---- Const adResyncUnderlyingValues = 1 Const adResyncAllValues = 2 '---- CompareEnum Values ---- Const adCompareLessThan = 0 Const adCompareEqual = 1 Const adCompareGreaterThan = 2 Const adCompareNotEqual = 3 Const adCompareNotComparable = 4 '---- FilterGroupEnum Values ---- Const adFilterNone = 0 Const adFilterPendingRecords = 1 Const adFilterAffectedRecords = 2 Const adFilterFetchedRecords = 3 Const adFilterPredicate = 4 Const adFilterConflictingRecords = 5 '---- SearchDirectionEnum Values ---- Const adSearchForward = 1 Const adSearchBackward = -1 '---- PersistFormatEnum Values ---- Const adPersistADTG = 0 Const adPersistXML = 1 '---- StringFormatEnum Values ---- Const adStringXML = 0 Const adStringHTML = 1 Const adClipString = 2 '---- ConnectPromptEnum Values ---- Const adPromptAlways = 1 Const adPromptComplete = 2 Const adPromptCompleteRequired = 3 Const adPromptNever = 4 '---- ConnectModeEnum Values ---- Const adModeUnknown = 0 Const adModeRead = 1 Const adModeWrite = 2 Const adModeReadWrite = 3 Const adModeShareDenyRead = 4 Const adModeShareDenyWrite = 8 Const adModeShareExclusive = &Hc Const adModeShareDenyNone = &H10 '---- IsolationLevelEnum Values ---- Const adXactUnspecified = &Hffffffff Const adXactChaos = &H00000010 Const adXactReadUncommitted = &H00000100 Const adXactBrowse = &H00000100 Const adXactCursorStability = &H00001000 Const adXactReadCommitted = &H00001000 Const adXactRepeatableRead = &H00010000 Const adXactSerializable = &H00100000 Const adXactIsolated = &H00100000 '---- XactAttributeEnum Values ---- Const adXactCommitRetaining = &H00020000 Const adXactAbortRetaining = &H00040000 '---- PropertyAttributesEnum Values ---- Const adPropNotSupported = &H0000 Const adPropRequired = &H0001 Const adPropOptional = &H0002 Const adPropRead = &H0200 Const adPropWrite = &H0400 '---- ErrorValueEnum Values ---- Const adErrInvalidArgument = &Hbb9 Const adErrNoCurrentRecord = &Hbcd Const adErrIllegalOperation = &Hc93 Const adErrInTransaction = &Hcae Const adErrFeatureNotAvailable = &Hcb3 Const adErrItemNotFound = &Hcc1 Const adErrObjectInCollection = &Hd27 Const adErrObjectNotSet = &Hd5c Const adErrDataConversion = &Hd5d Const adErrObjectClosed = &He78 Const adErrObjectOpen = &He79 Const adErrProviderNotFound = &He7a Const adErrBoundToCommand = &He7b Const adErrInvalidParamInfo = &He7c Const adErrInvalidConnection = &He7d Const adErrNotReentrant = &He7e Const adErrStillExecuting = &He7f Const adErrOperationCancelled = &He80 Const adErrStillConnecting = &He81 Const adErrNotExecuting = &He83 Const adErrUnsafeOperation = &He84 '---- ParameterAttributesEnum Values ---- Const adParamSigned = &H0010 Const adParamNullable = &H0040 Const adParamLong = &H0080 '---- ParameterDirectionEnum Values ---- Const adParamUnknown = &H0000 Const adParamInput = &H0001 Const adParamOutput = &H0002 Const adParamInputOutput = &H0003 Const adParamReturnValue = &H0004 '---- CommandTypeEnum Values ---- Const adCmdUnknown = &H0008 Const adCmdText = &H0001 Const adCmdTable = &H0002 Const adCmdStoredProc = &H0004 Const adCmdFile = &H0100 Const adCmdTableDirect = &H0200 '---- EventStatusEnum Values ---- Const adStatusOK = &H0000001 Const adStatusErrorsOccurred = &H0000002 Const adStatusCantDeny = &H0000003 Const adStatusCancel = &H0000004 Const adStatusUnwantedEvent = &H0000005 '---- EventReasonEnum Values ---- Const adRsnAddNew = 1 Const adRsnDelete = 2 Const adRsnUpdate = 3 Const adRsnUndoUpdate = 4 Const adRsnUndoAddNew = 5 Const adRsnUndoDelete = 6 Const adRsnRequery = 7 Const adRsnResynch = 8 Const adRsnClose = 9 Const adRsnMove = 10 Const adRsnFirstChange = 11 Const adRsnMoveFirst = 12 Const adRsnMoveNext = 13 Const adRsnMovePrevious = 14 Const adRsnMoveLast = 15 '---- SchemaEnum Values ---- Const adSchemaProviderSpecific = -1 Const adSchemaAsserts = 0 Const adSchemaCatalogs = 1 Const adSchemaCharacterSets = 2 Const adSchemaCollations = 3 Const adSchemaColumns = 4 Const adSchemaCheckConstraints = 5 Const adSchemaConstraintColumnUsage = 6 Const adSchemaConstraintTableUsage = 7 Const adSchemaKeyColumnUsage = 8 Const adSchemaReferentialConstraints = 9 Const adSchemaTableConstraints = 10 Const adSchemaColumnsDomainUsage = 11 Const adSchemaIndexes = 12 Const adSchemaColumnPrivileges = 13 Const adSchemaTablePrivileges = 14 Const adSchemaUsagePrivileges = 15 Const adSchemaProcedures = 16 Const adSchemaSchemata = 17 Const adSchemaSQLLanguages = 18 Const adSchemaStatistics = 19 Const adSchemaTables = 20 Const adSchemaTranslations = 21 Const adSchemaProviderTypes = 22 Const adSchemaViews = 23 Const adSchemaViewColumnUsage = 24 Const adSchemaViewTableUsage = 25 Const adSchemaProcedureParameters = 26 Const adSchemaForeignKeys = 27 Const adSchemaPrimaryKeys = 28 Const adSchemaProcedureColumns = 29 Const adSchemaDBInfoKeywords = 30 Const adSchemaDBInfoLiterals = 31 Const adSchemaCubes = 32 Const adSchemaDimensions = 33 Const adSchemaHierarchies = 34 Const adSchemaLevels = 35 Const adSchemaMeasures = 36 Const adSchemaProperties = 37 Const adSchemaMembers = 38 '---- SeekEnum Values ---- Const adSeekFirstEQ = &H1 Const adSeekLastEQ = &H2 Const adSeekAfterEQ = &H4 Const adSeekAfter = &H8 Const adSeekBeforeEQ = &H10 Const adSeekBefore = &H20 '---- ADCPROP_UPDATECRITERIA_ENUM Values ---- Const adCriteriaKey = 0 Const adCriteriaAllCols = 1 Const adCriteriaUpdCols = 2 Const adCriteriaTimeStamp = 3 '---- ADCPROP_ASYNCTHREADPRIORITY_ENUM Values ---- Const adPriorityLowest = 1 Const adPriorityBelowNormal = 2 Const adPriorityNormal = 3 Const adPriorityAboveNormal = 4 Const adPriorityHighest = 5 '---- CEResyncEnum Values ---- Const adResyncNone = 0 Const adResyncAutoIncrement = 1 Const adResyncConflicts = 2 Const adResyncUpdates = 4 Const adResyncInserts = 8 Const adResyncAll = 15 '---- ADCPROP_AUTORECALC_ENUM Values ---- Const adRecalcUpFront = 0 Const adRecalcAlways = 1 %> <% Const PUBLIC_CONNECTION ="provider=sqloledb;server=DB_SERVER;uid=WebPublic;pwd=$2008.07.23.webP*;database=PIO_DB;Network Library=DBMSSOCN" 'this is a comment. Server.ScriptTimeout = 5 Function GetPublicConnection() On Error Resume Next Err.Clear Dim dbConnection Set dbConnection = Server.CreateObject("ADODB.Connection") dbConnection.ConnectionTimeout = 30 'dbConnection.CommandTimeout = 5 dbConnection.ConnectionString = PUBLIC_CONNECTION dbConnection.Open if dbConnection.State <> 1 Or dbConnection.Errors.Count > 0 Then Dim errorString errorString="Unable to create public connection on " & Request.ServerVariables("SERVER_NAME") & " - " & Request.ServerVariables("HTTP_HOST") & vbcrlf subject = "SQL Server Connection Error at " & CStr(Now()) errorString = errorString & DisplayConnectionInfo(dbConnection) for each x in Request.ServerVariables errorString = errorString & x & " = " & Request.ServerVariables(x) & vbcrlf next 'SendPublicConnectionErrorEmail ERROR_EMAIL_RECIPIENT, subject , errorString AddToADOLog errorString & vbcrlf & DisplayConnectionInfo(dbConnection),"ERROR" Response.Write "
" & connectionInfo & "
" Set GetPublicConnection = Nothing Else Set GetPublicConnection = dbConnection End If On Error GoTo 0 End Function Function GetCustomConnection(CustomConnection) On Error Resume Next Err.Clear Dim dbConnection Set dbConnection = Server.CreateObject("ADODB.Connection") dbConnection.ConnectionTimeout = 3 dbConnection.ConnectionString = CustomConnection dbConnection.Open if dbConnection.State <> 1 Or dbConnection.Errors.Count > 0 Then Dim errorString errorString="Unable to create public connection" subject = "SQL Server Connection Error at " & CStr(Now()) SendEmail ERROR_EMAIL_RECIPIENT, subject , errorString AddToADOLog errorString & vbcrlf & DisplayConnectionInfo(dbConnection),"ERROR" 'Response.Write "
" & connectionInfo & "
" Set GetPublicConnection = Nothing Else Set GetPublicConnection = dbConnection End If On Error GoTo 0 End Function Sub CloseConnection(objConn) On Error Resume Next Dim errorString errorString=DisplayConnectionInfo() If errorString <> "" Then AddToADOLog errorString End If if objConn.State <> 0 Then objConn.Close() On Error Goto 0 End Sub Function DisplayConnectionInfo(objConn) On Error Resume Next Dim connectionInfo 'connectionInfo = objConn.ConnectionString 'connectionInfo = connectionInfo & objConn.ConnectionString & vbcrlf connectionInfo = connectionInfo & DisplayConnectionErrorInfo(objConn) & vbcrlf DisplayConnectionInfo = connectionInfo On Error Goto 0 End Function Function DisplayConnectionErrorInfo(objConn) Dim errorString errorString="" for each objErr in objConn.Errors errorString = errorString & "Description: " & objErr.Description & vbcrlf 'errorString = errorString & "Help context: " & objErr.HelpContext & vbcrlf 'errorString = errorString & "Help file: " & objErr.HelpFile & vbcrlf 'errorString = errorString & "Native error: " & objErr.NativeError & vbcrlf errorString = errorString & "Error number: " & objErr.Number & vbcrlf errorString = errorString & "Error source: " & objErr.Source & vbcrlf errorString = errorString & "SQL state: " & objErr.SQLState & vbcrlf next DisplayConnectionErrorInfo=errorString End Function %> <% Const VALIDATION_ERROR = -1 Function ValidateInteger(i) Err.Clear On Error Resume Next If IllegalChars(i) Then DisplayInputError End If i2 = Cint(i) if Err <> 0 then ValidateInteger = VALIDATION_ERROR Else ValidateInteger = cleanseData(i,"integer",25) End If If Err.number <> 0 Then ValidateInteger = VALIDATION_ERROR Err.Clear On Error Goto 0 End Function Function ValidateString(str) Err.Clear On Error Resume Next If IllegalChars(str) Then DisplayInputError End If ValidateString = cleanseData(str,"string",2000) If Err.number <> 0 Then ValidateString = VALIDATION_ERROR Err.Clear On Error Goto 0 End Function Function ValidateKeywords(str) Err.Clear On Error Resume Next badChars = array("select", "drop", ";", "--", "insert", "delete","update", "xp_", _ "#", "%", "&", "'", "(", ")", ":", ";", "<", ">", "=", "[", "]", "?", "`", "|") If LimitChars(badChars,str) Then DisplayInputError End If ValidateString = cleanseData(str,"string",2000) If Err.number <> 0 Then ValidateString = VALIDATION_ERROR Err.Clear On Error Goto 0 End Function Function ValidateText(str) Err.Clear On Error Resume Next If IllegalChars(str) Then DisplayInputError End If ValidateText = cleanseData(str,"text",2000) If Err.number <> 0 Then ValidateText = VALIDATION_ERROR Err.Clear On Error Goto 0 End Function Function ValidateDate(dt) Err.Clear On Error Resume Next If IllegalChars(dt) Then DisplayInputError End If ValidateDate = cleanseData(dt,"date",25) If Err.number <> 0 Then ValidateDate = VALIDATION_ERROR Err.Clear On Error Goto 0 End Function Function IsValidInteger(i) Err.Clear On Error Resume Next If ValidateInteger(pid) = VALIDATION_ERROR OR Err.number <> 0 Then IsValidInteger = False Else IsValidInteger = True End If Err.Clear On Error Goto 0 End Function Function IsValidPID(pid) IsValidPID = IsValidInteger(pid) End Function Function IsValidCategory(category) Err.Clear On Error Resume Next If category ="Group Press Release" Then IsValidCategory = True ElseIf category ="Group Academics" Then IsValidCategory = True ElseIf category ="Activity Type" Then IsValidCategory = True ElseIf category ="Group Upper Level" Then IsValidCategory = True ElseIf category ="Group Currents Online" Then IsValidCategory = True ElseIf category ="Group Review Magazine" Then IsValidCategory = True ElseIf category ="Group Profiles" Then IsValidCategory = True ElseIf category ="Group Messages" Then IsValidCategory = True ElseIf ValidateString(category) = VALIDATION_ERROR OR Err.number <> 0 Then IsValidCategory = False Else IsValidCategory = True End If Err.Clear On Error Goto 0 End Function Function CheckFileName(filename) Err.Clear On Error Resume Next badChars = array("select", "drop", ";", "--", "insert", "delete","update", "xp_", _ "#", "%", "&", "'", "(", ")", ":", ";", "<", ">", "=", "[", "]", "?", "`", "|") If LimitChars(badChars,filename) Then DisplayInputError End If path = Server.MapPath(filename) if FileExists(path) then CheckFileName= True Else WriteError("bad file name passed: " & path) CheckFileName= False End If On Error Goto 0 End Function Function CheckCategory(category) Err.Clear On Error Resume Next CheckCategory = cleanseData(category,"string",25) If Err.number <> 0 Then CheckCategory = False On Error Goto 0 End Function ' This function takes three parameters, the input itself, the datatype that it is supposed to be, ' and the maximum character length the input should be allowed to be. ' Valid data types are "email", "integer", "date", "string" and "text". ' The first three are obvious, the last two are slight differences. ' The "string" I use to validate text-based querystrings, allowing only letters, ' numbers, _, - and . whereas "text" is any free-form text form field type content. Function cleanseData(dataInput,dataType,dataLength) Dim regex, validInput, expressionmatch regex = "" validInput = "1" If dataType = "string" And Len(dataInput) > 0 Then regex = "^[\w-\.]{1,"& dataLength &"}$" ElseIf dataType = "email" And Len(dataInput) > 0 Then regex = "^[\w-\.]+@([\w-]+\.)+[\w-]{2,6}$" ElseIf dataType = "integer" And Len(dataInput) > 0 Then regex = "^\d{1,"& dataLength &"}$" ElseIf dataType = "date" And Len(dataInput) > 0 Then If Not IsDate(dataInput) Then validInput = "0" End If ElseIf dataType = "text" And Len(dataInput) > 0 Then If Len(dataInput) > dataLength Then validInput = "0" End If End If If Len(regex) > 0 And Len(dataInput) > 0 Then Set RegExpObj = New RegExp RegExpObj.Pattern = regex RegExpObj.IgnoreCase = True RegExpObj.Global = True RegExpChk = RegExpObj.Test(dataInput) If Not RegExpChk Then validInput = "0" End If Set RegExpObj = nothing End If If validInput = "1" And Len(dataInput) > 0 Then cleanseData = specialCharacterEncoding(dataInput) ElseIf Len(dataInput) = 0 Then cleanseData = "" Else cleanseData=VALIDATION_ERROR End If End Function Sub DisplayInputError WriteError("Potential Sql Injection Attempt: There was invalid data passed to " & Request.ServerVariables("url") & Request.ServerVariables("QUERY_STRING") & " and processing of the page was halted" & vbcrlf ) SendMail ERROR_EMAIL_RECIPIENT,"Potential Sql Injection Attempt","There was invalid data passed to " & Request.ServerVariables("url") & Request.ServerVariables("QUERY_STRING") & " and processing of the page was halted" & vbcrlf if Not DEBUGGING_ASP Then Response.Redirect "/errors/InputValidationError.asp" Else Response.Write "
" & vbcrlf Response.Write "
" & vbcrlf Response.Write "
" & vbcrlf Response.Write "

ERROR: Invalid data detected!

" & vbcrlf Response.Write "Please contact technical support at support. Thank you." & vbcrlf Response.Write "

Back to UCSC home page" & vbcrlf Response.Write "
" & vbcrlf Response.End End If End Sub Function GetBadChars() GetBadChars = array("select", "drop", ";", "--", "insert", "delete","update", "xp_", _ "#", "%", "&", "'", "(", ")", "/", "\", ":", ";", "<", ">", "=", "[", "]", "?", "`", "|") End Function Function DisplayBadCharsList() Response.Write("") End Function Function IllegalChars(sInput) Dim sBadChars, iCounter IllegalChars=False sBadChars=GetBadChars() 'Loop through array sBadChars using Counter & UBound functions For iCounter = 0 to uBound(sBadChars) If Instr(sInput,sBadChars(iCounter))>0 Then WriteError("Form data for " & Request.ServerVariables("URL") & " included the '" & sBadChars(iCounter) & "' character. ") IllegalChars=True End If Next End function Function LimitChars(sBadChars,sInput) Dim iCounter LimitChars=False 'Loop through array sBadChars using Counter & UBound functions For iCounter = 0 to uBound(sBadChars) If Instr(sInput,sBadChars(iCounter))>0 Then WriteError("Form data for " & Request.ServerVariables("URL") & " included the '" & sBadChars(iCounter) & "' character. ") LimitChars=True End If Next End function 'You may see at the end of the function, another function is called, this function is to encode possibly malicious characters to their HTML based entity to remove any risk of them being used for a SQL injection attack. Function specialCharacterEncoding(encodeData) encodeData = replace(encodeData,"&", "&") encodeData = replace(encodeData,"'", "'") encodeData = replace(encodeData,"""", "") encodeData = replace(encodeData,">", ">") encodeData = replace(encodeData,"<", "<") encodeData = replace(encodeData,")", ")") encodeData = replace(encodeData,"(", "(") encodeData = replace(encodeData,"]", "]") encodeData = replace(encodeData,"[", "[") encodeData = replace(encodeData,"}", "}") encodeData = replace(encodeData,"{", "{") encodeData = replace(encodeData,"--", "--") encodeData = replace(encodeData,"=", "=") specialCharacterEncoding = encodeData End Function %> <% Sub WriteDebug(msg) WriteToLog msg, "DEBUG" End Sub Sub WriteWarning(msg) WriteToLog msg, "WARNING" End Sub Sub WriteError(msg) WriteToLog msg, "ERROR" End Sub Sub LogError(Err) WriteError Err.Description & " " & Err.Source End Sub Sub WriteToLog(message,severity) LogEvent message,severity if Request("PrintDebugMessages") = "True" then Response.Write "
" & Server.HTMLEncode(message) & "
" & vbcrlf Else if Len(message) > 80 then Response.Write "" & vbcrlf else Response.Write "" & vbcrlf End if End If End Sub Sub LogEvent (message,severity) Const ForWriting = 2 Const ForAppending = 8 Dim logFileName Dim sz_TimeStamp sz_TimeStamp = GetTimeStamp() logFileName = "E:\InetLocal\Logs\" & GetServerName & "-" & sz_Timestamp & "-ASP.log" URL = Request.ServerVariables("URL") QUERY_STRING = Request.ServerVariables("QUERY_STRING") If QUERY_STRING <> "" Then URL = URL & "?" & QUERY_STRING REMOTE_ADDR = Request.ServerVariables("REMOTE_ADDR") URL = PadString(URL,100) REMOTE_ADDR = PadString(REMOTE_ADDR,25) severity = PadString(severity,10) Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(logFileName) Then Set logFile = fs.OpenTextFile(logFileName, ForAppending) Else Set logFile = fs.CreateTextFile(logFileName, True) logFile.WriteLine(PadString("DATE",25) & vbtab & PadString("SEVERITY",10) & vbTab & PadString("REMOTE_ADDR",25) & vbTab & PadString("URL",100) & vbTab & PadString("MESSAGE",50)) End If logFile.WriteLine(PadString(CStr(Now()),25) & vbtab & severity & vbTab & REMOTE_ADDR & vbTab & URL & vbTab & message) logFile.Close Set logFile = nothing Set fs = nothing End Sub Sub AddToADOLog (message,severity) On Error Resume Next Const ForWriting = 2 Const ForAppending = 8 Dim logFileName Dim sz_TimeStamp sz_TimeStamp = GetTimeStamp() logFileName = "E:\Inetlocal\Logs\" & GetServerName & "-" & sz_Timestamp & "-ADO.log" URL = Request.ServerVariables("URL") QUERY_STRING = Request.ServerVariables("QUERY_STRING") If QUERY_STRING <> "" Then URL = URL & "?" & QUERY_STRING REMOTE_ADDR = Request.ServerVariables("REMOTE_ADDR") URL = PadString(URL,100) REMOTE_ADDR = PadString(REMOTE_ADDR,25) message = PadString(message,50) severity = PadString(severity,10) Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(logFileName) Then Set logFile = fs.OpenTextFile(logFileName, ForAppending) Else Set logFile = fs.CreateTextFile(logFileName, True) End If logFile.WriteLine("-----------------------------------------------") logFile.WriteLine("TIME: " & PadString(CStr(Now()),25) ) logFile.WriteLine("User IP: " & REMOTE_ADDR) logFile.WriteLine("Message: " & message) logFile.WriteLine("Severity: " & severity) logFile.WriteLine("URL: " & URL) logFile.WriteLine("-----------------------------------------------") logFile.Close Set logFile = nothing Set fs = nothing On Error Goto 0 End Sub %> <% Const ERROR_EMAIL_RECIPIENT = "wwwalert@ucsc.edu" Const ERROR_EMAIL_SENDER = "andre777@ucsc.edu" Const EMAIL_DISABLED = 0 ' Switch to CDO Sub SendEmail(toAddress,subject,message) If not EMAIL_DISABLED = 1 then On Error Resume Next Set myMail=CreateObject("CDO.Message") myMail.Subject=subject myMail.From=ERROR_EMAIL_SENDER myMail.To=toAddress myMail.TextBody=message myMail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusing")=2 'Name or IP of remote SMTP server myMail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserver") _ ="smtp.ucsc.edu" 'Server port myMail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") _ =25 myMail.Configuration.Fields.Update myMail.Send set myMail=nothing On Error Goto 0 'Else ' Response.Write "" & vbcrlf End if End Sub ' Switch to CDO Sub SendPublicConnectionErrorEmail(toAddress,subject,message) If not EMAIL_DISABLED = 1 then On Error Resume Next Set myMail=CreateObject("CDO.Message") myMail.Subject=subject myMail.From=ERROR_EMAIL_SENDER myMail.To=toAddress myMail.TextBody=message myMail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusing")=2 'Name or IP of remote SMTP server myMail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserver") _ ="smtp.ucsc.edu" 'Server port myMail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") _ =25 myMail.Configuration.Fields.Update myMail.Send set myMail=nothing On Error Goto 0 'Else ' Response.Write "" & vbcrlf End if End Sub Sub SendMail (toAddress,subject,message) 'On Error Resume Next 'Set Mailer = Server.CreateObject("SMTPsvg.Mailer") 'if Err = 0 then ' Mailer.RemoteHost = "smtp.ucsc.edu" ' Mailer.FromName = "ASP Error on " & Request.ServerVariables("HOSTNAME") ' Mailer.FromAddress = fromAddress ' Mailer.AddRecipient toAddress ' Mailer.Subject = subject ' Mailer.BodyText = message ' if not Mailer.SendMail then ' WriteToLog "Error in SendMail routine" & Mailer.Response,"ERROR" ' end if 'Else ' Err = 0 ' SendMailCDO toAddress,subject,message ' If Err <> 0 then WriteToLog "Unable to instantiate Mailer","ERROR" ' End if End Sub %> <% Const GLOBAL_SCRIPT_TIMEOUT = 50000 Dim STORY_PATH STORY_PATH = "http://" & GetHostName() & "/news_events/text.asp?" Dim ADMINISTRATIVE_MESSAGES_PATH ADMINISTRATIVE_MESSAGES_PATH = "http://" & GetHostName() & "/news_events/messages/text.asp?" Function GetHostName() GetHostName = "www.ucsc.edu" 'GetHostName = Request.ServerVariables("SERVER_NAME") End Function Function GetPageTitle(PID) On Error Resume Next query = "select pr_title from pr_db where Pr_pid =" & PID set recordSet = server.createObject("ADODB.Recordset") Dim dbConnection set dbConnection = GetPublicConnection() recordSet.open query, dbConnection, 3, 1 if recordSet.RecordCount > 0 Then GetPageTitle = CleanHTMLMarkup(recordSet("pr_title")) Else GetPageTitle = "There was an error retrieving the requested story" PID = 0 End If recordSet.Close CloseConnection(dbConnection) If Err.number <> 0 Then PID = 0 On Error Goto 0 End Function Function DisplayStoryTeaser(recordSet1,storyDate,textPath,maxTextSize) pr_pid=recordSet1("pr_pid") 'write date Response.Write(Date2String(storyDate)) 'write title Response.Write ("
" & recordSet1("PR_Title") & "
") Dim storyText If(recordSet1("pr_Description") <> "") Then storyText = recordSet1("pr_Description") Else storyText = recordSet1( "pr_Text" ) End If If Len(storyText) < maxTextSize then Response.Write storyText & " [More]

" Else storyText = TruncateStoryText(storyText,maxTextSize) Response.Write storyText & "... [More]

" End If End Function Function TruncateStoryText(StoryText,Size) StoryText = GetCleanedText(StoryText) StoryText = Mid (StoryText,1,Size) lastSpaceIndex = InstrRev(StoryText," ") StoryText = Mid (StoryText,1,lastSpaceIndex) & " ..." TruncateStoryText = StoryText End Function Function DisplayStory(recordSet,Category,showContact) DisplayStoryFinal recordSet,Category,showContact,False End Function Function DisplayStoryFinal(recordSet,Category,showContact,IsMessage) While Not recordSet.eof theDate=recordSet("pr_Date") sday=day(theDate) smonth=month(theDate) sname = monthname ( smonth ) syear=year(theDate) Response.Write "" & sname & " " & sday & ", " & syear & "
" if recordSet("Pr_PubStart")<>"" then sdate=recordSet("Pr_PubStart") stday=day(sdate) stmonth=month(sdate) stname=monthname(stmonth) styear=year(sdate) else Response.Write "" end if if recordSet("Pr_PubEnd")<>"" then edate=recordSet("Pr_PubEnd") 'Response.Write recordSet("Pr_PubStart") eday=day(edate) etmonth=month(edate) ename=monthname (etmonth) eyear=year(edate) else Response.Write "" end if if left(Category,3)="co_" or left(Category,3)="rm_" or Category="Group Currents Online" or Category="Group Review Magazine" then if recordSet("pr_IssueDate")<>"" then idate=recordSet("pr_IssueDate") iday=day(idate) imonth=month(idate) iname=monthname (imonth) iyear=year(idate) Response.Write "
IssueDate: " & iname & " " & iday & ", " & iyear & "
" end if end if if showContact And recordSet("pr_Contact") <> "" then Response.Write "
Contact: "& recordSet("pr_Contact") & "
" end if if IsMessage Then If (recordSet("Pr_To") <> "" and recordSet("Pr_From") <> "") then Response.Write "
To: "& recordSet("Pr_To")& "
" Response.Write "
From: "& recordSet("pr_from") & "
" End if End if Dim strTitleEncoded strFieldTitle = recordSet("pr_Title") if(strFieldTitle <> "") then strTitleEncoded = CStr( strFieldTitle) strTitleEncoded = CStr(replace(strTitleEncoded, vbCrLf & vbCrLf, "

")) strTitleEncoded = CStr(replace(strTitleEncoded, vbCrLf, "
")) strTitleEncoded = CStr(replace(strTitleEncoded, "

", "

" & vbCrLf & "

")) end if If IsMessage Then Response.Write "

Re: "& strTitleEncoded & "

" Else Response.Write "

"& strTitleEncoded & "

" End If DisplayImages recordSet("pr_pid") strFieldText = recordSet ("Pr_Text") Dim strTextEncoded if(strFieldText<>"") then strTextEncoded = CStr("

" & strFieldText & "") strTextEncoded = CStr(replace(strTextEncoded, vbCrLf & vbCrLf, "

")) strTextEncoded = CStr(replace(strTextEncoded, vbCrLf, "
")) strTextEncoded = CStr(replace(strTextEncoded, "

", "

" & vbCrLf & "

")) End if Response.Write ""&strTextEncoded &"

" rs.movenext Wend End Function Function DisplayImages(pid) Dim dbConnection Set dbConnection = GetPublicConnection() Dim recordSet set recordSet = server.createObject("ADODB.recordset") Dim query query = "SELECT *," & vbcrlf query = query & " pr_Priority = " & vbcrlf query = query & " CASE " & vbcrlf query = query & " WHEN [Priority] = 'High' THEN 1 " & vbcrlf query = query & " WHEN [Priority] = 'Medium' THEN 2 " & vbcrlf query = query & " WHEN [Priority] = 'Low' THEN 3 " & vbcrlf query = query & " END " & vbcrlf query = query & " from images " & vbcrlf query = query & " where PressReleaseId = "& pid query = query & " Order by pr_Priority ASC " & vbcrlf 'DisplayWithHalt query on error resume next recordSet.open query , dbConnection, 3, 1 'Response.Write "Record count = " & recordset.RecordCount if not recordSet.eof then%>
<% while not recordSet.eof Dim ServerUrl ServerUrl=replace(recordSet("PATH"),"e:\inetpub\wwwroot\toplevel\news_events\","http://" & GetHostName() & "/news_events/") ServerUrl=replace(ServerUrl,"\","/") %>
<% Dim imgTag imgTag = "" & recordSet("alternateText") & "" Response.Write imgTag %>

<% Response.Write recordSet("CAPTION")%>

<% recordSet.movenext Wend %>
<% recordSet.Close() CloseConnection(dbConnection2) end if End Function Function DisplayReviewStory(recordSet,Category,showContact) 'Response.Write Date2String(recordset("pr_date")) & "
" While Not recordSet.eof Dim strTitleEncoded strFieldTitle = recordSet("pr_Title") if(strFieldTitle <> "") then strTitleEncoded = CStr( strFieldTitle) strTitleEncoded = CStr(replace(strTitleEncoded, vbCrLf & vbCrLf, "

")) strTitleEncoded = CStr(replace(strTitleEncoded, vbCrLf, "
")) strTitleEncoded = CStr(replace(strTitleEncoded, "

", "

" & vbCrLf & "

")) end if Response.Write "

"& strTitleEncoded & "

" if recordSet("pr_Description") <> "" Then Response.Write "

"& recordSet("pr_Description") & "

" End If if recordSet("pr_Contact") <> "" Then Response.Write "

By "& recordSet("pr_Contact") & "

" End If DisplayImagesTable recordSet("pr_pid") strFieldText = recordSet ("Pr_Text") Dim strTextEncoded if(strFieldText<>"") then strTextEncoded = CStr("

" & strFieldText & "") strTextEncoded = CStr(replace(strTextEncoded, vbCrLf & vbCrLf, "

")) strTextEncoded = CStr(replace(strTextEncoded, vbCrLf, "
")) strTextEncoded = CStr(replace(strTextEncoded, "

", "

" & vbCrLf & "

")) End if Response.Write ""&strTextEncoded &"


" rs.movenext Wend End Function Function DisplayImagesTable(pid) Dim dbConnection Set dbConnection = GetPublicConnection() Dim recordSet set recordSet = server.createObject("ADODB.recordset") Dim query query = "SELECT *," & vbcrlf query = query & " pr_Priority = " & vbcrlf query = query & " CASE " & vbcrlf query = query & " WHEN [Priority] = 'High' THEN 1 " & vbcrlf query = query & " WHEN [Priority] = 'Medium' THEN 2 " & vbcrlf query = query & " WHEN [Priority] = 'Low' THEN 3 " & vbcrlf query = query & " END " & vbcrlf query = query & " from images " & vbcrlf query = query & " where PressReleaseId = "& pid query = query & " Order by pr_Priority ASC " & vbcrlf 'DisplayWithHalt query recordSet.open query , dbConnection, 3, 1 if not recordSet.eof then%> <% while not recordSet.eof Dim ServerUrl ServerUrl=replace(recordSet("PATH"),"e:\inetpub\wwwroot\toplevel\news_events\","http://" & GetHostName() & "/news_events/") ServerUrl=replace(ServerUrl,"\","/") %> <% Dim imgTag imgTag = " <% recordSet.movenext Wend %>
" & recordSet("alternateText") & "" Response.Write imgTag %>

<% Response.Write recordSet("CAPTION")%>

<% recordSet.Close() CloseConnection(dbConnection2) end if End Function Sub WriteLine(str) Response.Write str & vbcrlf End Sub Sub WriteComment(str) WriteLine "" End Sub Sub DisplayWithHalt(data) Response.Write "Execution Halted:
" & vbcrlf & "
" & data & "" & vbcrlf Response.End End Sub Function FileExists(fileName) WriteDebug "Checking for filename " & fileName On Error Resume Next Dim fs,f Set fs=Server.CreateObject("Scripting.FileSystemObject") Set f=fs.GetFile(fileName) if Err = 0 then FileExists = True Else FileExist = False End If set f=nothing set fs=nothing End Function Function GetServerName Dim SERVER_NAME SERVER_NAME = Request.ServerVariables("SERVER_NAME") SERVER_NAME = Replace(SERVER_NAME,".","") SERVER_NAME = UCASE(SERVER_NAME) SERVER_Name = Replace(SERVER_NAME,"UCSCEDU","") GetServerName = SERVER_NAME End Function Function GetTimeStamp dt = FormatDateTime(Date(),2) dtArr=Split(dt,"/") sz_year = dtArr(2) sz_month=dtArr(1) sz_day=dtArr(0) sz_month = LeftPad(CStr(sz_month),2,"0") sz_day = LeftPad(CStr(sz_day),2,"0") GetTimeStamp=sz_year & sz_month & sz_day End Function Function PadString(str,width) PadString=LeftPad(str,width," ") End Function Sub PrintServerVariables for each x in Request.ServerVariables Response.Write(x & " = " & Request.ServerVariables(x) & "
" & vbcrlf) next End Sub Function LeftPad( strText, intLen, chrPad ) On Error Resume Next 'LeftPad( "1234", 7, "x" ) = "1234xxx" 'LeftPad( "1234", 3, "x" ) = "123" LeftPad = Left( strText & String( intLen, chrPad ), intLen ) End Function Function RightPad( strText, intLen, chrPad ) 'RightPad( "1234", 7, "x" ) = "xxx1234" 'RightPad( "1234", 3, "x" ) = "234" RightPad = Right( String( intLen, chrPad ) & strText, intLen ) End Function Function Date2String(theDate) sday=day(theDate) smonth=month(theDate) sname = monthname ( smonth ) syear=year(theDate) Date2String = sname & " " & sday & ", " & syear End Function ' cleans up the text for display Function GetCleanedText(text) text = CleanHTMLMarkup(text) text = CleanupWhitespace(text) GetCleanedText = text End Function ' Convert
and

to newline - Removed Andre ' Remove any other markup ' Convert many HTML entities Function CleanHTMLMarkup(text) Dim regEx, Match, Matches Set regEx = New RegExp regEx.IgnoreCase = True regEx.Global = True ' Convert
, , and

to newline: 'regEx.Pattern = "<(br|p|i)\b[^>]*>" 'text = regEx.Replace(text, vbCrLf) ' Remove any other embedded markup: regEx.Pattern = "<[^>]+>" text = regEx.Replace(text, "") ' Replace any hexadecimal entities regEx.Pattern = "&#x[0-9a-f]+;" While regEx.Test(text) Set Matches = regEx.Execute(text) text = Left(text, Matches.item(0).FirstIndex) & Chr("&H" + Mid(text, Matches.item(0).FirstIndex + 4, Matches.item(0).Length-4)) & Mid(text, Matches.item(0).FirstIndex + Matches.item(0).Length + 1) Wend ' Replace any decimal entities regEx.Pattern = "&#[0-9]+;" While regEx.Test(text) Set Matches = regEx.Execute(text) text = Left(text, Matches.item(0).FirstIndex) & Chr(Mid(text, Matches.item(0).FirstIndex + 3, Matches.item(0).Length-3)) & Mid(text, Matches.item(0).FirstIndex + Matches.item(0).Length + 1) Wend ' Replace various common named HTML entities ' (the complete list is very long -- you could add more here) text = Replace(text, " ", " ") text = Replace(text, "©", "©") text = Replace(text, "<", "<") text = Replace(text, ">", ">") text = Replace(text, """, """") text = Replace(text, "'", "'") text = Replace(text, "¢", "¢") text = Replace(text, "£", "£") text = Replace(text, "€", "€") text = Replace(text, "¤", "¤") text = Replace(text, "¥", "¥") text = Replace(text, "«", "«") text = Replace(text, "®", "®") text = Replace(text, "°", "°") text = Replace(text, "·", "·") text = Replace(text, "»", "»") text = Replace(text, "–", "-") text = Replace(text, "—", "-") text = Replace(text, "‘", "‘") text = Replace(text, "’", "’") text = Replace(text, "“", "“") text = Replace(text, "”", "”") ' Ampersand conversion comes last! text = Replace(text, "&", "&") CleanHTMLMarkup = text End Function ' Collapse whitespace/newlines Function CleanupWhitespace(text) Dim regEx, Match, Matches Set regEx = New RegExp regEx.IgnoreCase = True regEx.Global = True ' Tabs to spaces text = Replace(text, vbTab, " ") ' Non-splitting spaces to regular spaces text = Replace(text, Chr(160), " ") ' Temporarily convert all newlines make any kind of newline into vbCr text = Replace(text, vbLf, vbCr) ' Replace a mix of spaces and newlines, with a single newline regEx.Pattern = vbCr & "[ " & vbCr & "]+" text = regEx.Replace(text, vbCr) ' Collapse multiple spaces regEx.Pattern = " +" text = regEx.Replace(text, " ") ' Convert newlines back to vbCrLf text = Replace(text, vbCr, vbCrLf) CleanupWhitespace = text End Function 'This should come from the database Function GetCategoryTitle(Category) if(Category = "Group Press Release") then GetCategoryTitle="All News & Events" elseif(Category = "Group Academics") then GetCategoryTitle="All Academics" elseif(Category = "pr_arts") then GetCategoryTitle="Arts" elseif(Category = "pr_art1") then GetCategoryTitle="Art" elseif(Category = "pr_film") then GetCategoryTitle="Film and Digital Media" elseif(Category = "pr_arthistory") then GetCategoryTitle="History of Art and Visual Culture" elseif(Category = "pr_music") then GetCategoryTitle="Music" elseif(Category = "pr_theater") then GetCategoryTitle="Theater Arts" elseif(Category = "pr_engineering") then GetCategoryTitle="Engineering" elseif(Category = "pr_appliedmaths") then GetCategoryTitle="Applied Mathematics and Statistics" elseif(Category = "pr_biomolecular") then GetCategoryTitle="Biomolecular Engineering" elseif(Category = "pr_computerengineering") then GetCategoryTitle="Computer Engineering" elseif(Category = "pr_computerscience") then GetCategoryTitle="Computer Science" elseif(Category = "pr_electricalengineering") then GetCategoryTitle="Electrical Engineering" elseif(Category = "pr_technologyim") then GetCategoryTitle="Technology and Information Management" elseif(Category = "pr_humanities") then GetCategoryTitle="Humanities" elseif(Category = "pr_americanstudies") then GetCategoryTitle="American Studies" elseif(Category = "pr_feministstudies") then GetCategoryTitle="Feminist Studies" elseif(Category = "pr_history") then GetCategoryTitle="History" elseif(Category = "pr_historyconsciousness") then GetCategoryTitle="History of Consciousness" elseif(Category = "pr_languageprogram") then GetCategoryTitle="Language Program" elseif(Category = "pr_linguistics") then GetCategoryTitle="Linguistics" elseif(Category = "pr_literature") then GetCategoryTitle="Literature" elseif(Category = "pr_philosophy") then GetCategoryTitle="Philosophy" elseif(Category = "pr_writingprogram") then GetCategoryTitle="Writing Program" elseif(Category = "pr_physbiosciences") then GetCategoryTitle="Physical & Biological Sciences" elseif(Category = "pr_astronomyastrophysics") then GetCategoryTitle="Astronomy and Astrophysics" elseif(Category = "pr_chemistrybiochemistry") then GetCategoryTitle="Chemistry and Biochemistry" elseif(Category = "pr_earthsciences") then GetCategoryTitle="Earth Sciences" elseif(Category = "pr_ecology") then GetCategoryTitle="Ecology and Evolutionary Biology" elseif(Category = "pr_toxiocology") then GetCategoryTitle="Environmental Toxicology" elseif(Category = "pr_mathematics") then GetCategoryTitle="Mathematics" elseif(Category = "pr_molecularcell") then GetCategoryTitle="Molecular, Cell, and Developmental Biology" elseif(Category = "pr_oceansciences") then GetCategoryTitle="Ocean Sciences" elseif(Category = "pr_physics") then GetCategoryTitle="Physics" elseif(Category = "pr_sciencecommunication") then GetCategoryTitle="Science Communication Program" elseif(Category = "pr_socialsciences") then GetCategoryTitle="Social Sciences" elseif(Category = "pr_anthropology") then GetCategoryTitle="Anthropology" elseif(Category = "pr_communitystudies") then GetCategoryTitle="Community Studies" elseif(Category = "pr_economics") then GetCategoryTitle="Economics" elseif(Category = "pr_education") then GetCategoryTitle="Education" elseif(Category = "pr_environmentalstudies") then GetCategoryTitle="Environmental Studies" elseif(Category = "pr_latinamerican") then GetCategoryTitle="Latin American and Latino Studies" elseif(Category = "pr_politics") then GetCategoryTitle="Politics" elseif(Category = "pr_psychology") then GetCategoryTitle="Psychology" elseif(Category = "pr_sociology") then GetCategoryTitle="Sociology" elseif(Category = "Audience") then GetCategoryTitle="All Audience Areas" elseif(Category = "au_prospectivestudents") then GetCategoryTitle="Prospective Students" elseif(Category = "au_undergraduatestudents") then GetCategoryTitle="Undergraduate Students" elseif(Category = "au_graduatestudents") then GetCategoryTitle="Graduate Students" elseif(Category = "au_parentsstudents") then GetCategoryTitle="Parents of Students" elseif(Category = "au_alumni") then GetCategoryTitle="Alumni" elseif(Category = "au_donors") then GetCategoryTitle="Donors" elseif(Category = "au_faculty") then GetCategoryTitle="Faculty" elseif(Category = "au_staff") then GetCategoryTitle="Staff" elseif(Category = "Activity Type") then GetCategoryTitle="All Activities" elseif(Category = "pr_administration") then GetCategoryTitle="Administration" elseif(Category = "pr_admissions") then GetCategoryTitle="Admissions" elseif(Category = "pr_awardshonors") then GetCategoryTitle="Awards & Honors" elseif(Category = "pr_events") then GetCategoryTitle="Events" elseif(Category = "pr_giftsgrants") then GetCategoryTitle="Gifts & Grants" elseif(Category = "pr_library") then GetCategoryTitle="Library" elseif(Category = "pr_partnerships") then GetCategoryTitle="Partnerships" elseif(Category = "pr_research") then GetCategoryTitle="Research" elseif(Category = "pr_sports") then GetCategoryTitle="Sports" elseif(Category = "pr_alumninews") then GetCategoryTitle="Alumni News" elseif(Category = "at_donornews") then GetCategoryTitle="Donor News" elseif(Category = "pr_studentnews") then GetCategoryTitle="Student News" elseif(Category = "pr_othernews") then GetCategoryTitle="Other Campus News" elseif(Category = "Group Upper Level") then GetCategoryTitle="All Upper-level Pages" elseif(Category = "ul_homeoncampus") then GetCategoryTitle="Home Page (oncampus)" elseif(Category = "ul_homepublic") then GetCategoryTitle="Home Page (public)" elseif(Category = "ul_about") then GetCategoryTitle="About UCSC" elseif(Category = "ul_academicprograms") then GetCategoryTitle="Academic Programs" elseif(Category = "ul_research") then GetCategoryTitle="Research" elseif(Category = "ul_newsevents") then GetCategoryTitle="News/Events" elseif(Category = "ul_administration") then GetCategoryTitle="Administration" elseif(Category = "ul_prospective") then GetCategoryTitle="Prospective Students" elseif(Category = "ul_enrolledstudents") then GetCategoryTitle="Enrolled Students" elseif(Category = "ul_faculty") then GetCategoryTitle="Faculty" elseif(Category = "ul_staff") then GetCategoryTitle="Staff" elseif(Category = "ul_alumnifriends") then GetCategoryTitle="Alumni/Friends" elseif(Category = "pr_home") then GetCategoryTitle="Press Releases Index Page" elseif(Category = "Group Currents Online") then GetCategoryTitle="All Currents Online" elseif(Category = "co_leadstory") then GetCategoryTitle="Primary Story" elseif(Category = "co_secondarystory") then GetCategoryTitle="Secondary Story" elseif(Category = "co_morenews") then GetCategoryTitle="More HeadlinesNews" elseif(Category = "co_newsbriefs") then GetCategoryTitle="News Briefs" elseif(Category = "co_awardshonors") then GetCategoryTitle="Awards & Honors" elseif(Category = "co_appointments") then GetCategoryTitle="Appointments" elseif(Category = "co_inmemoriam") then GetCategoryTitle="In Memoriam" elseif(Category = "co_publications") then GetCategoryTitle="Publications" elseif(Category = "co_classifiedads") then GetCategoryTitle="Classified Ads" elseif(Category = "co_newfaculty") then GetCategoryTitle="New Faculty" elseif(Category = "co_inthenews") then GetCategoryTitle="UCSC in the News" elseif(Category = "co_opinion") then GetCategoryTitle="Opinion" elseif(Category = "co_letters") then GetCategoryTitle="Letters" elseif(Category = "Group Review Magazine") then GetCategoryTitle="All Review Magazine" elseif(Category = "rm_feature1") then GetCategoryTitle="Feature 1" elseif(Category = "rm_feature2") then GetCategoryTitle="Feature 2" elseif(Category = "rm_feature3") then GetCategoryTitle="Feature 3" elseif(Category = "rm_feature4") then GetCategoryTitle="Feature 4" elseif(Category = "rm_feature5") then GetCategoryTitle="Feature 5" elseif(Category = "rm_feature6") then GetCategoryTitle="Feature 6" elseif(Category = "rm_feature7") then GetCategoryTitle="Feature 7" elseif(Category = "rm_feature8") then GetCategoryTitle="Feature 8" elseif(Category = "rm_chancellormessage") then GetCategoryTitle="Chancellor Message" elseif(Category = "rm_campusupdate") then GetCategoryTitle="Campus Update" elseif(Category = "rm_alumninews") then GetCategoryTitle="Alumni News" elseif(Category = "rm_alumninotes") then GetCategoryTitle="Alumni Notes" elseif(Category = "rm_alumninotesprofile") then GetCategoryTitle="Alumni Notes Profile" elseif(Category = "rm_advert1") then GetCategoryTitle="Advertisement 1" elseif(Category = "rm_advert2") then GetCategoryTitle="Advertisement 2" elseif(Category = "rm_advert3") then GetCategoryTitle="Advertisement 3" elseif(Category = "Group Profiles") then GetCategoryTitle="Profiles" elseif(Category = "pf_studentprofile") then GetCategoryTitle="Student Profile" elseif(Category = "pf_facultyprofile") then GetCategoryTitle="Faculty Profile" elseif(Category = "pf_alumniprofile") then GetCategoryTitle="Alumni Profile" elseif(Category = "Group Messages") then GetCategoryTitle="All Messages" elseif(Category = "ms_administrative") then GetCategoryTitle="Administrative Messages" end if End Function Sub DisplayHeadlines(SELECTED_CATEGORY,numberOfHeadlines) ON ERROR GOTO 0 Dim dbConnection set dbConnection = GetPublicConnection() Dim cmd set cmd=CreateObject("ADODB.Command") Dim recordSet Set recordSet = Server.CreateObject("ADODB.Recordset") Dim prmCategory Dim prmHeadlineCount Dim boolError 'boolean is set to TRUE if an error occurs cmd.ActiveConnection = dbConnection cmd.CommandType = 4 cmd.CommandText = "usp_GetHeadlines" cmd.NamedParameters = True set prmCategory=cmd.CreateParameter("@CategoryTypeName",200,1,50,SELECTED_CATEGORY) cmd.Parameters.Append prmCategory Set prmHeadlineCount = cmd.CreateParameter("@numberOfHeadlines", 3, 1) prmHeadlineCount.Value = numberOfHeadlines cmd.Parameters.Append prmHeadlineCount Set recordSet = cmd.Execute Dim totalHeadlines totalHeadlines= 0 while ((Err.number = 0) and (recordSet.EOF <> True) and totalHeadlines<=numberOfHeadlines) Dim PublicationBeginDate Dim PublicationEndDate PublicationBeginDate = recordSet("pr_pubstart") PublicationEndDate = recordSet("pr_pubend") 'Get Fields Dim StoryId StoryId = recordSet("pr_pid") Dim Title Title = recordSet("pr_Title") Dim Description Description = recordSet("pr_Description") Dim Text Text = recordSet("pr_Text") Dim Category Category = recordSet("pr_Category") Dim StoryText Response.Write "

" 'Write the title Response.Write Title & " " Dim path path = STORY_PATH 'Administrative Messages have a different path If InStr(Category,"ms_administrative") Then path =ADMINISTRATIVE_MESSAGES_PATH WriteLine "[More]" WriteLine "

" totalHeadlines = totalHeadlines + 1 recordSet.MoveNext wend recordSet.Close set recordSet = nothing dbConnection.Close 'close connection set dbConnection=nothing 'set connection object = nothing set cmd=nothing 'set command object = nothing if(totalHeadlines <> numberOfHeadlines) Then WriteComment("WARNING: Headlines count was off. Requested=" & numberOfHeadlines & " Output=" & totalHeadlines) End if End Sub %> <% On Error Resume Next Dim PID if Request("PID") <> "" then PID = Trim(Request("pid")) else PID = Trim(Request("PressReleaseId")) End If if IsValidPid(pid) Then Dim PageTile PageTitle = GetPageTitle(PID) Response.Write PageTitle & " - UC Santa Cruz" Else PID = 0 End If On Error Goto 0 %>
<% 'If it is an invalid PID then we print out a message, the end of the page, and just end Processing If PID = 0 Then Response.Write("

We are sorry but we cannot find a story to match the story id " & pid & " that was passed to the application. Please use your back button and try another link.

") Elseif (Err.Number > 0) Then PID = 0 Response.Write("

The press releases database is currently unavailable. Please check back shortly.

") End If %> <% If PID = 0 Then %>
<% Response.End End If query="select * from pr_db where Pr_pid =" & PID On Error Resume Next Dim dbConnection Set dbConnection = GetPublicConnection() Dim recordSet set recordSet = server.createObject("ADODB.Recordset") recordSet.open query,dbConnection ' Get category if it was passed Dim category category = Request("cat") & "" If Not IsValidCategory(category) Then category = "" Else category=Replace(category,"+"," ") End If 'Display the story 'DisplayStoryLocal recordSet,category,True,False DisplayStoryLocal recordSet,category,True,True,False 'Cleanup and quit recordSet.close CloseConnection(dbConnection) %>
<% Function DisplayStoryLocal(recordSet,Category,showDate,showContact,IsMessage) While Not recordSet.eof theDate=recordSet("pr_Date") sday=day(theDate) smonth=month(theDate) sname = monthname ( smonth ) syear=year(theDate) if showDate then Response.Write "

" & sname & " " & sday & ", " & syear & "

" end if if recordSet("Pr_PubStart")<>"" then sdate=recordSet("Pr_PubStart") stday=day(sdate) stmonth=month(sdate) stname=monthname(stmonth) styear=year(sdate) else Response.Write "" end if if recordSet("Pr_PubEnd")<>"" then edate=recordSet("Pr_PubEnd") stdate = recordSet("Pr_PubStart") eday=day(stdate) etmonth=month(stdate) ename=monthname (etmonth) eyear=year(stdate) else Response.Write "" end if if left(Category,3)="co_" or left(Category,3)="rm_" or Category="Group Currents Online" or Category="Group Review Magazine" then if recordSet("pr_IssueDate")<>"" then idate=recordSet("pr_IssueDate") iday=day(idate) imonth=month(idate) iname=monthname (imonth) iyear=year(idate) Response.Write "
IssueDate: " & iname & " " & iday & ", " & iyear & "
" end if end if if IsMessage then Response.Write "
To: "& recordSet("Pr_To")&"
" Response.Write "
From: "& recordSet("pr_from")&"
" end if Dim strTitleEncoded strFieldTitle = recordSet("pr_Title") if(strFieldTitle <> "") then strTitleEncoded = CStr( strFieldTitle) strTitleEncoded = CStr(replace(strTitleEncoded, vbCrLf & vbCrLf, "

")) strTitleEncoded = CStr(replace(strTitleEncoded, vbCrLf, "
")) strTitleEncoded = CStr(replace(strTitleEncoded, "

", "

" & vbCrLf & "

")) end if If IsMessage Then Response.Write "

Re: "& strTitleEncoded & "

" Else Response.Write "

"& strTitleEncoded & "

" End If If sdate Then Response.Write "

" & stname & " " & stday & ", " & styear & "

" End If if showContact And recordSet("pr_Contact") <> "" then Response.Write "By "& recordSet("pr_Contact") & "

" end if DisplayImages recordSet("pr_pid") strFieldText = recordSet ("Pr_Text") Dim strTextEncoded if(strFieldText<>"") then strTextEncoded = CStr("
" & strFieldText & "
") strTextEncoded = CStr(replace(strTextEncoded, vbCrLf & vbCrLf, "

")) strTextEncoded = CStr(replace(strTextEncoded, vbCrLf, "
")) strTextEncoded = CStr(replace(strTextEncoded, "

", "

" & vbCrLf & "

")) End if Response.Write ""&strTextEncoded &"
" Response.Write "

#####

" rs.movenext Wend End Function %>