%
'## 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
%>