<% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Forums(TM) '** http://www.webwizforums.com '** '** Copyright (C)2001-2008 Web Wiz(TM). All Rights Reserved. '** '** THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM 'WEB WIZ'. '** '** IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN 'WEB WIZ' IS UNWILLING TO LICENSE '** THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE '** AND DERIVATIVE WORKS IMMEDIATELY. '** '** If you have not received a copy of the license with this work then a copy of the latest '** license contract can be found at:- '** '** http://www.webwizguide.com/license '** '** For more information about this software and for licensing information please contact '** 'Web Wiz' at the address and website below:- '** '** Web Wiz, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England '** http://www.webwizguide.com '** '** Removal or modification of this copyright notice will violate the license contract. '** '**************************************************************************************** '*************************** SOFTWARE AND CODE MODIFICATIONS **************************** '** '** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE '** AGREEMENT AND IS STRICTLY PROHIBITED '** '** If you wish to modify any part of this software a license must be purchased '** '**************************************************************************************** '****************************************************** '*** Filters using 'HTML Secure (TM)' Technology ***** '****************************************************** '********************************************** '*** Check HTML input for malicious code ***** '********************************************** 'Check input for tags and remove any that are not permitted for security reasons Private Function HTMLsafe(ByVal strMessageInput) Dim strTempHTMLMessage 'Temporary message store Dim lngMessagePosition 'Holds the message position Dim intHTMLTagLength 'Holds the length of the HTML tags Dim strHTMLMessage 'Holds the HTML message Dim strTempMessageInput 'Temp store for the message input Dim lngLoopCounter 'Loop counter Dim strHyperlink 'Holds hyperlinks Dim strImageSrc 'Holds image src Dim strImageHeight 'Holds image height Dim strImageWidth 'Holds image Width Dim strImageBorder 'Holds image Border Dim strImageAlign 'Holds image Align Dim strImageAlt Dim strImageHSpace Dim strImageVSpace Dim strImageStyle Dim strImageTitle Dim intLoopCounter 'Holds the loop counter 'Include the array of unsafe HTML tags %><% 'Strip scripting (this is just an extra check as these are stiped later (if in different format), but will give better formating of post if whole tag is striped now) strMessageInput = Replace(strMessageInput, "", "", 1, -1, 1) 'Strip dodgy styles (can be used to inject CSS into a page for XSS hacking exploit) strMessageInput = Replace(strMessageInput, "", "", 1, -1, 1) 'Place the message input into a temp store strTempMessageInput = strMessageInput 'Loop through each character in the post message looking for tags For lngMessagePosition = 1 to CLng(Len(strMessageInput)) 'If this is the end of the message then save some process time and jump out the loop If Mid(strMessageInput, lngMessagePosition, 1) = "" Then Exit For 'If an HTML tag is found then move to the end of it so that we can strip the HTML tag and check it for malicious code If Mid(strMessageInput, lngMessagePosition, 1) = "<" Then 'Get the length of the HTML tag intHTMLTagLength = (InStr(lngMessagePosition, strMessageInput, ">", 1) - lngMessagePosition) 'Place the HTML tag back into the temporary message store strHTMLMessage = Mid(strMessageInput, lngMessagePosition, intHTMLTagLength + 1) 'Place the HTML tag into a temporay variable store to be stripped of malcious code strTempHTMLMessage = strHTMLMessage 'Convert HTML encoding back into ASCII characters strTempHTMLMessage = removeHTMLencoding(strTempHTMLMessage) 'If there is anymore HTML encoding left dump it strTempHTMLMessage = Replace(strTempHTMLMessage, "&#", "&#", 1, -1, 1) 'Remove ASCII non characters entities from 0 to 31 For lngLoopCounter = 0 to 31 strTempHTMLMessage = Replace(strTempHTMLMessage, CHR(lngLoopCounter), " ", 1, -1, 0) Next '***** Filter Hyperlinks ***** 'If this is an hyperlink tag then check it for malicious code If InStr(1, strTempHTMLMessage, "href", 1) <> 0 Then 'Get just the href link strHyperlink = getHTMLProperty(strTempHTMLMessage, "href") 'Call the format link function to strip malicious codes strHyperlink = formatLink(strHyperlink) 'Rebuild the link strTempHTMLMessage = "" End If '***** Filter Image Tags ***** 'If this is an image then strip it of malicous code If InStr(1, strTempHTMLMessage, "img ", 1) <> 0 Then 'Get the src image properties strImageSrc = getHTMLProperty(strTempHTMLMessage, "src") 'If no image source then dump the img tag If strImageSrc = "" Then strTempHTMLMessage = "" 'Filter the image and get the rest of it's properties Else 'Call the check images function to strip malicious codes strImageSrc = checkImages(strImageSrc) 'Get the rest of the image properties strImageHeight = getHTMLProperty(strTempHTMLMessage, "height") strImageWidth = getHTMLProperty(strTempHTMLMessage, "width") strImageBorder = getHTMLProperty(strTempHTMLMessage, "border") strImageAlign = LCase(getHTMLProperty(strTempHTMLMessage, "align")) strImageAlt = getHTMLProperty(strTempHTMLMessage, "alt") strImageTitle = getHTMLProperty(strTempHTMLMessage, "title") strImageHSpace = getHTMLProperty(strTempHTMLMessage, "hspace") strImageVSpace = getHTMLProperty(strTempHTMLMessage, "vspace") 'strImageStyle = getHTMLProperty(strTempHTMLMessage, "style") 'Styles can be used for XSS Hacking, it's best to leave these so they are removed 'Filter alt, title and style input as no other checks can be done on these strImageAlt = removeAllTags(strImageAlt) strImageAlt = formatInput(strImageAlt) strImageTitle = removeAllTags(strImageTitle) strImageTitle = formatInput(strImageTitle) strImageStyle = removeAllTags(strImageStyle) strImageStyle = formatInput(strImageStyle) 'Rebuild the image tag strTempHTMLMessage = " "" Then strTempHTMLMessage = strTempHTMLMessage & " style=""" & strImageStyle & """" If strImageAlt <> "" Then strTempHTMLMessage = strTempHTMLMessage & " alt=""" & strImageAlt & """" If strImageTitle = "" Then strTempHTMLMessage = strTempHTMLMessage & " title=""" & strImageAlt & """" End If If strImageTitle <> "" Then strTempHTMLMessage = strTempHTMLMessage & " title=""" & strImageTitle & """" If strImageAlt = "" Then strTempHTMLMessage = strTempHTMLMessage & " alt=""" & strImageTitle & """" End If strTempHTMLMessage = strTempHTMLMessage & " />" End If End If '***** Filter Unwanted HTML Tags ***** 'If this is not an image or a link then cut all unwanted HTML out of the HTML tag If InStr(1, strTempHTMLMessage, "href", 1) = 0 AND InStr(1, strTempHTMLMessage, "img", 1) = 0 Then 'Loop through the array of disallowed HTML tags For lngLoopCounter = LBound(saryUnSafeHTMLtags) To UBound(saryUnSafeHTMLtags) 'If the disallowed HTML is found remove it and start over If Instr(1, strTempHTMLMessage, saryUnSafeHTMLtags(lngLoopCounter), 1) Then 'Remove the disallowed HTML strTempHTMLMessage = Replace(strTempHTMLMessage, saryUnSafeHTMLtags(lngLoopCounter), "", 1, -1, 1) 'Start again as the hacker maybe placing maliciouse code around another disabllowed word to try and bypass the filter lngLoopCounter = 0 End If Next End If '***** Format Unwanted HTML Tags ***** 'Extra check, Strip out malicious code from the HTML that may have not been stripped but trying to sneek through in a hyperlink or image src strTempHTMLMessage = formatInput(strTempHTMLMessage) 'Remove any empty tags left after filtering strTempHTMLMessage = Replace(strTempHTMLMessage, "<>", "") strTempHTMLMessage = Replace(strTempHTMLMessage, "", "") 'Place the new fromatted HTML tag back into the message post strTempMessageInput = Replace(strTempMessageInput, strHTMLMessage, strTempHTMLMessage, 1, -1, 1) End If Next 'Return the function HTMLsafe = strTempMessageInput End Function '****************************************** '*** Get HTML tag single property ***** '****************************************** 'This function grabs a particular part of an HTML tag eg (href="get this part here") Private Function getHTMLProperty(ByVal strHTMLtag, ByVal strHTMLproperty) Dim intPropertyStart Dim intPropertyEnd Dim strQuoteMarkChar1 Dim strQuoteMarkChar2 strHTMLtag = Replace(strHTMLtag, ">", " >") 'First check to see if the part of the HTML tag we want to get actualy lives in the HTML tag If InStr(1, strHTMLtag, strHTMLproperty, 1) <> 0 Then 'Find out what type of quote mark we are dealing with for this property eg. ' or " If InStr(InStr(1, strHTMLtag, strHTMLproperty, 1), strHTMLtag, strHTMLproperty & "=""", 1) <> 0 Then strQuoteMarkChar1 = """" strQuoteMarkChar2 = """" ElseIf InStr(InStr(1, strHTMLtag, strHTMLproperty, 1), strHTMLtag, strHTMLproperty & "='", 1) <> 0 Then strQuoteMarkChar1 = "'" strQuoteMarkChar2 = "'" ElseIf InStr(1, strHTMLtag, strHTMLproperty & "=", 1) <> 0 Then strQuoteMarkChar1 = "" strQuoteMarkChar2 = " " End If 'Get where the part of the tag we want to look at starts intPropertyStart = InStr(InStr(1, strHTMLtag, strHTMLproperty, 1), strHTMLtag, strHTMLproperty & "=" & strQuoteMarkChar1, 1) + Len(strHTMLproperty & "=" & strQuoteMarkChar1) intPropertyEnd = InStr(intPropertyStart, strHTMLtag, strQuoteMarkChar2, 1) 'If the start and end postions of the URL are correct then filter it If intPropertyEnd > intPropertyStart Then 'Chop out everyting except the content of the property in question getHTMLProperty = Mid(strHTMLtag, intPropertyStart, intPropertyEnd-intPropertyStart) 'Strip anymore quote marks and %0 (null) as they are not wanted in the return getHTMLProperty = Replace(getHTMLProperty, """", "", 1, -1, 1) getHTMLProperty = Replace(getHTMLProperty, "'", "", 1, -1, 1) getHTMLProperty = Replace(getHTMLProperty, "%22", "", 1, -1, 1) getHTMLProperty = Replace(getHTMLProperty, "%27", "", 1, -1, 1) getHTMLProperty = Replace(getHTMLProperty, "%0", "", 1, -1, 1) 'This tag is not formatted correctly so return nothing Else getHTMLProperty = "" End If 'Else the property is not in the tag so return nothing Else getHTMLProperty = "" End If End Function '****************************************** '*** Check Images for malicious code ***** '****************************************** 'Check images function Private Function checkImages(ByVal strInputEntry) Dim strImageFileExtension 'Holds the file extension of the image Dim saryImageTypes 'Array holding allowed image types in the forum Dim intExtensionLoopCounter 'Holds the loop counter for the array Dim blnImageExtOK 'Set to true if the image extension is OK 'If there is no . in the link then there is no extenison and so can't be an image If inStr(1, strInputEntry, ".", 1) = 0 Then strInputEntry = "" 'Else remove malicious code and check the extension is an image extension Else 'Initiliase variables blnImageExtOK = false 'Get the file extension strImageFileExtension = LCase(Mid(strInputEntry, InStrRev(strInputEntry, "."), 4)) 'Get the image types allowed in the forum strImageTypes = strImageTypes & ";jpe;gif;jpg;bmp;png" 'Place the image types into an array saryImageTypes = Split(Trim(strImageTypes), ";") 'Loop through all the allowed extensions and see if the image has one For intExtensionLoopCounter = 0 To UBound(saryImageTypes) 'Reformat extension to check saryImageTypes(intExtensionLoopCounter) = "." & Trim(Mid(saryImageTypes(intExtensionLoopCounter), 1, 3)) 'Check to see if the image extension is allowed If saryImageTypes(intExtensionLoopCounter) = strImageFileExtension Then blnImageExtOK = true Next 'If the image extension is not OK then strip it from the image link If blnImageExtOK = false Then strInputEntry = Replace(strInputEntry, strImageFileExtension, "", 1, -1, 1) 'Chop out any anything that is not normally found in an image URL strInputEntry = Replace(strInputEntry, "?", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, ";", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "%3b", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "{", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "}", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "%7b", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "%7d", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "%0", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "^", "", 1, -1, 1) 'URL Encode to prevent malicious code strInputEntry = Replace(strInputEntry, "(", "%28", 1, -1, 1) strInputEntry = Replace(strInputEntry, ")", "%29", 1, -1, 1) strInputEntry = Replace(strInputEntry, "[", "%5b", 1, -1, 1) strInputEntry = Replace(strInputEntry, "]", "%5d", 1, -1, 1) strInputEntry = Replace(strInputEntry, " ", "%20", 1, -1, 1) strInputEntry = Replace(strInputEntry, "\", "%5C", 1, -1, 1) strInputEntry = Replace(strInputEntry, Chr(9), "%09", 1, -1, 1) 'Tabs 'Remove if the user is trying to use an FTP link strInputEntry = Replace(strInputEntry, "ftp://", "", 1, -1, 1) End If 'Return checkImages = strInputEntry End Function '******************************************** '*** Format Links ***** '******************************************** 'Format links funtion Private Function formatLink(ByVal strInputEntry) 'URL Encode malisous characters from links and images strInputEntry = Replace(strInputEntry, """", "%22", 1, -1, 1) strInputEntry = Replace(strInputEntry, "'", "%27", 1, -1, 1) strInputEntry = Replace(strInputEntry, "(", "%28", 1, -1, 1) strInputEntry = Replace(strInputEntry, ")", "%29", 1, -1, 1) strInputEntry = Replace(strInputEntry, "<", "%3c", 1, -1, 1) strInputEntry = Replace(strInputEntry, ">", "%3e", 1, -1, 1) strInputEntry = Replace(strInputEntry, "[", "%5b", 1, -1, 1) strInputEntry = Replace(strInputEntry, "]", "%5d", 1, -1, 1) strInputEntry = Replace(strInputEntry, "{", "%7b", 1, -1, 1) strInputEntry = Replace(strInputEntry, "}", "%7d", 1, -1, 1) strInputEntry = Replace(strInputEntry, "\", "%5C", 1, -1, 1) strInputEntry = Replace(strInputEntry, " ", "%20", 1, -1, 1) strInputEntry = Replace(strInputEntry, Chr(9), "%09", 1, -1, 1) 'Tabs strInputEntry = Replace(strInputEntry, Chr(173), "%3c", 1, -1, 1) 'Vietmanise < tag 'Remove a few bits strInputEntry = Replace(strInputEntry, "%0", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "^", "", 1, -1, 1) 'Return formatLink = strInputEntry End Function '****************************************** '*** Format user input ***** '****************************************** 'Format user input function Private Function formatInput(ByVal strInputEntry) 'Get rid of malicous code in the message strInputEntry = Replace(strInputEntry, Chr(9), "", 1, -1, 1) 'Remove Tabs strInputEntry = Replace(strInputEntry, "", "", 1, -1, 1) strInputEntry = Replace(strInputEntry, "