% '------------------------------------------------------------------------ ' 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 "
"))
strTitleEncoded = CStr(replace(strTitleEncoded, vbCrLf, "
"))
strTitleEncoded = CStr(replace(strTitleEncoded, "
", "
" & vbCrLf & "")) end if If IsMessage Then Response.Write "
" & 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%><% Dim imgTag imgTag = "" Response.Write imgTag %> |
<% Response.Write recordSet("CAPTION")%> |
"))
strTitleEncoded = CStr(replace(strTitleEncoded, vbCrLf, "
"))
strTitleEncoded = CStr(replace(strTitleEncoded, "
", "
" & vbCrLf & "")) end if 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 &"
" Response.Write imgTag %> |
<% Response.Write recordSet("CAPTION")%> |
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 = "[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 %>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 %>