<% '## this script needs to be called along with the zFilter_key.asp file ## Function zFilter_URL(StringToFilter,AutoParseURL) 'str,bln '# autoparses URLs. searches for http:// | www. | ftp:// and replaces text with hyperlink to it If AutoParseURL Then Dim zobjRegExp,Matches,Match,zTmpString1,zPrefix zTmpString1 = StringToFilter Set zobjRegExp = New RegExp zobjRegExp.IgnoreCase = True zobjRegExp.Global = True ' zobjRegExp.Pattern = "(^| )((http://|www\.)|ftp://)([\w\.\?=;,%/-]|&)+\b" zobjRegExp.Pattern = "(^|[^;/])((http://|www\.)|ftp://)([^\s&\[\]]|&)+\b" 'any character but whitespace,[,],<,>," Set Matches = zobjRegExp.Execute(zTmpString1) For Each Match In Matches zTmp1 = Match.Value zTmp2 = LCase(Left(zTmp1,4)) If zTmp2 = "http" Or zTmp2 = "www." Or zTmp2 = "ftp:" Then zTmp2 = "" Else zTmp2 = Left(zTmp1,1) zTmp1 = Right(zTmp1,Len(zTmp1)-1) End If '# the hyperlink needs the & character instead of & - and the xml wont accept & - the & in url must be urlencoded zTmp3 = Replace(zTmp1,"&","%26") If LCase(Left(zTmp1,7)) = "http://" Or LCase(Left(zTmp1,6)) = "ftp://" Then zTmp4 = "" Else 'starts as www. zTmp4 = "http://" End If zTmpString1 = Replace(zTmpString1,Match.Value,(zTmp2&""&zTmp1&"")) Next End If Set zobjRegExp = Nothing Set Matches = Nothing zFilter_URL = zTmpString1 End Function Function zFilter(StringToFilter,AutoParseURL,ParseTags,ParseKeywords,ParseImageTags) 'str,bln,bln,bln,bln '# [url="http.."]..[/url], formatting tags and keywords/smilies Dim zTmpString zTmpString = StringToFilter If AutoParseURL Then 'autoparse url zTmpString = zFilter_URL(zTmpString,AutoParseURL) End If If ParseTags Then '[url="http.."]..[/url] and formatting tags zTmpString = Replace(zTmpString,"[url="","",1,-1,1) zTmpString = Replace(zTmpString,"[/url]","",1,-1,1) zTmpString = Replace(zTmpString,"[b]","",1,-1,1) zTmpString = Replace(zTmpString,"[/b]","",1,-1,1) zTmpString = Replace(zTmpString,"[i]","",1,-1,1) zTmpString = Replace(zTmpString,"[/i]","",1,-1,1) zTmpString = Replace(zTmpString,"[u]","",1,-1,1) zTmpString = Replace(zTmpString,"[/u]","",1,-1,1) End If If ParseKeywords Then 'smilies and keyword parsing For Each key in zFilter_Key 'only swaps the code when its a standalone word zTmpString = Replace(zTmpString,key,(" " & zFilter_Key.item(key))) Next End If If ParseImageTags Then 'image tags zTmpString = Replace(zTmpString,"[img]","",1,-1,1) End If zTmpString = Replace(zTmpString,vbLf,"
") 'new lines zFilter = zTmpString End Function Function zFilter_Language(StringToFilter) '# replaces naughty words with first letter, followed by *'s for the remainder of the length eg: fuck > f*** # Dim z_Swearwords 'takes swearwords from a constant in adminUpdate.asp z_Swearwords = Split(Naughty_Words,",") Dim zTmpString,Item,zStars zTmpString = StringToFilter For Each Item In z_Swearwords zStars = Replace(Space((Len(Item) - 1))," ","*") zTmpString = Replace(zTmpString,Item,Left(Item,1) & zStars,1,-1,1) Next zFilter_Language = zTmpString End Function %>