<%
Sub AddViolation(objDict, strWord)
'Adds a violation (a substring that is not allowed)
objDict.Add strWord, False
End Sub
Function CheckStringForViolations(strString, objDict)
'Determines if the string strString has any violations
Dim bolViolations
bolViolations = False
Dim strKey
For Each strKey in objDict
If InStr(1, strString, strKey, vbTextCompare) > 0 then
bolViolations = True
objDict(strKey) = True
End If
Next
CheckStringForViolations = bolViolations
End Function
Function ListViolations(objDict)
'Returns a string of the violations found
Dim strKey, strViolations
For Each strKey in objDict
If objDict(strKey) then
strViolations = strViolations & strKey & ","
End If
Next
ListViolations = Left(strViolations, Len(strViolations) - 1)
End Function
Dim objDictViolations
Set objDictViolations = Server.CreateObject("Scripting.Dictionary")
AddViolation objDictViolations, "<html>"
AddViolation objDictViolations, "</html>"
AddViolation objDictViolations, "<body>"
AddViolation objDictViolations, "</body>"
AddViolation objDictViolations, "<script"
AddViolation objDictViolations, "<table"
Dim strCheck, strKey
strCheck = Request("string")
If Len(strCheck) > 0 then
If CheckStringForViolations(strCheck, objDictViolations) then
Response.Write "<b>The following unallowed substrings were found in your input " & _
"text:</b><br>"
Dim strResults
strResults = ListViolations(objDictViolations)
strResults = Replace(strResults, "<", "<")
strResults = Replace(strResults, ">", ">")
Response.Write strResults & "<p>"
Else
Response.Write "<b>No violations were found in your input text!</b><p>"
End If
End If
%>
|