inc_func_common.asp

代码名称： Snitz Forums 2000 代码语言： 英文 代码类型： 国外代码 运行环境： ASP 授权方式： 免费代码 代码大小： 530kb 代码等级： 3 整

<%
'#################################################################################
'## Snitz Forums 2000 v3.4.05
'#################################################################################
'## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen,
'##                       Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## [e-mail]
'##
'#################################################################################
%>
<%

'##############################################
'##            Post Formatting               ##
'##############################################


function chkQuoteOk(fString)
	chkQuoteOk = not(InStr(1, fString, "'", 0) > 0)
end function


function ChkURLs(ByVal strToFormat, ByVal sPrefix, ByVal iType)
	Dim strArray
	Dim Counter

	ChkURLs = strToFormat

	if InStr(1, strToFormat, sPrefix) > 0 Then
		strArray = Split(strToFormat, sPrefix, -1)
		ChkURLs = strArray(0)

		for Counter = 1 To UBound(strArray)
			if ((strArray(Counter-1) = "" Or Len(strArray(Counter-1)) < 5) And strArray(Counter)<> "") then
				ChkURLs = ChkURLs & edit_hrefs(sPrefix & strArray(Counter), iType)
			elseif ((UCase(Right(strArray(Counter-1), 6)) <> "HREF=""") and _
				(UCase(Right(strArray(Counter-1), 5)) <> "[IMG]") and _
				(UCase(Right(strArray(Counter-1), 5)) <> "[URL]") and _
				(UCase(Right(strArray(Counter-1), 6)) <> "[URL=""") and _
				(UCase(Right(strArray(Counter-1), 6)) <> "FTP://") and _
				(UCase(Right(strArray(Counter-1), 8)) <> "FILE:///") and _
				(UCase(Right(strArray(Counter-1), 7)) <> "HTTP://") and _
				(UCase(Right(strArray(Counter-1), 8)) <> "HTTPS://") and _
				(UCase(Right(strArray(Counter-1), 5)) <> "SRC=""") and _
				(UCase(Right(strArray(Counter-1), 1)) <> "-") and _
				(UCase(Right(strArray(Counter-1), 1)) <> "=") and _
				(strArray(Counter) <> "")) then

				ChkURLs = ChkURLs & edit_hrefs(sPrefix & strArray(Counter), iType)
			else
				ChkURLs = ChkURLs & sPrefix & strArray(Counter)
			end if
		next
	end if
end function


function ChkMail(ByVal strToFormat)
	Dim strArray
	Dim Counter
	
	if InStr(1, strToFormat, " ") > 0 Then
	
		strArray = Split(Replace(strToFormat, "<br />", " <br />", 1, -1, vbTextCompare), " ", -1)
		'ChkMail = strArray(0)

		for Counter = 0 to UBound(strArray)
			If (InStr(strArray(Counter), "@") > 0) and _
			not(InStr(UCase(strArray(Counter)), "MAILTO:") > 0) and _
			not(InStr(UCase(strArray(Counter)), "FTP:") > 0) and _
			not(InStr(UCase(strArray(Counter)), "[URL") > 0) then
				ChkMail = ChkMail & " " & edit_hrefs(strArray(counter), 4)
			else
				ChkMail = ChkMail & " " & strArray(counter)
			end if
		next
		ChkMail = Replace(ChkMail, " <br />", "<br />", 1, -1, vbTextCompare)
	else
		if (InStr(strToFormat, "@") > 0) and _
		not(InStr(UCase(strToFormat), "MAILTO:") > 0) and _
		not(InStr(UCase(strToFormat), "FTP:") > 0) and _
		not(InStr(UCase(strToFormat), "[URL") > 0) then
			ChkMail = ChkMail & " " & edit_hrefs(strToFormat, 4)
		else
			ChkMail = strToFormat
		end if
	end if
end function


function FormatStr(fString)
	on Error resume next
	fString = Replace(fString, CHR(13), "")
	'fString = Replace(fString, CHR(10) & CHR(10), "<br /><br />")
	fString = Replace(fString, CHR(10), "<br />")
	if strBadWordFilter = 1 or strBadWordFilter = "1" then
		fString = ChkBadWords(fString)
	end if

	if strAllowForumCode = "1" then
		fString = ReplaceURLs(fString)
		fString = ReplaceCodeTags(fString)
		if strIMGInPosts = "1" then
			fString = ReplaceImageTags(fString)
		end if
	end if

	fString = ChkURLs(fString, "http://", 1)
	fString = ChkURLs(fString, "https://", 2)
	fString = ChkURLs(fString, "www.", 3)
	fString = ChkMail(fString)
	fString = ChkURLs(fString, "ftp://", 5)
	fString = ChkURLs(fString, "file:///", 6)

	if strIcons = "1" then
		fString = smile(fString)
	end if
	if strAllowForumCode = "1" then
		fString = extratags(fString)
	end if
	FormatStr = fString
	on Error goto 0
end function


function doCode(fString, fOTag, fCTag, fROTag, fRCTag)
	fOTagPos = Instr(1, fString, fOTag, 1)
	fCTagPos = Instr(1, fString, fCTag, 1)
	while (fCTagPos > 0 and fOTagPos > 0)
		fString = replace(fString, fOTag, fROTag, 1, 1, 1)
		fString = replace(fString, fCTag, fRCTag, 1, 1, 1)
		fOTagPos = Instr(1, fString, fOTag, 1)
		fCTagPos = Instr(1, fString, fCTag, 1)
	wend
	doCode = fString
end function


function Smile(fString)
	fString = replace(fString, "[:(!]", getCurrentIcon(strIconSmileAngry,"","align=""middle"""))
	fString = replace(fString, "[B)]", getCurrentIcon(strIconSmileBlackeye,"","align=""middle"""))
	fString = replace(fString, "[xx(]", getCurrentIcon(strIconSmileDead,"","align=""middle"""))
	fString = replace(fString, "[XX(]", getCurrentIcon(strIconSmileDead,"","align=""middle"""))
	fString = replace(fString, "[:I]", getCurrentIcon(strIconSmileBlush,"","align=""middle"""))
	fString = replace(fString, "[:(]", getCurrentIcon(strIconSmileSad,"","align=""middle"""))
	fString = replace(fString, "[:o]", getCurrentIcon(strIconSmileShock,"","align=""middle"""))
	fString = replace(fString, "[:O]", getCurrentIcon(strIconSmileShock,"","align=""middle"""))
	fString = replace(fString, "[:0]", getCurrentIcon(strIconSmileShock,"","align=""middle"""))
	fString = replace(fString, "[|)]", getCurrentIcon(strIconSmileSleepy,"","align=""middle"""))
	fString = replace(fString, "[:)]", getCurrentIcon(strIconSmile,"","align=""middle"""))
	fString = replace(fString, "[:D]", getCurrentIcon(strIconSmileBig,"","align=""middle"""))
	fString = replace(fString, "[}:)]", getCurrentIcon(strIconSmileEvil,"","align=""middle"""))
	fString = replace(fString, "[:o)]", getCurrentIcon(strIconSmileClown,"","align=""middle"""))
	fString = replace(fString, "[:O)]", getCurrentIcon(strIconSmileClown,"","align=""middle"""))
	fString = replace(fString, "[:0)]", getCurrentIcon(strIconSmileClown,"","align=""middle"""))
	fString = replace(fString, "[8)]", getCurrentIcon(strIconSmileShy,"","align=""middle"""))
	fString = replace(fString, "[8D]", getCurrentIcon(strIconSmileCool,"","align=""middle"""))
	fString = replace(fString, "[:P]", getCurrentIcon(strIconSmileTongue,"","align=""middle"""))
	fString = replace(fString, "[:p]", getCurrentIcon(strIconSmileTongue,"","align=""middle"""))
	fString = replace(fString, "[;)]", getCurrentIcon(strIconSmileWink,"","align=""middle"""))
	fString = replace(fString, "[8]", getCurrentIcon(strIconSmile8ball,"","align=""middle"""))
	fString = replace(fString, "[?]", getCurrentIcon(strIconSmileQuestion,"","align=""middle"""))
	fString = replace(fString, "[^]", getCurrentIcon(strIconSmileApprove,"","align=""middle"""))
	fString = replace(fString, "[V]", getCurrentIcon(strIconSmileDisapprove,"","align=""middle"""))
	fString = replace(fString, "[v]", getCurrentIcon(strIconSmileDisapprove,"","align=""middle"""))
	fString = replace(fString, "[:X]", getCurrentIcon(strIconSmileKisses,"","align=""middle"""))
	fString = replace(fString, "[:x]", getCurrentIcon(strIconSmileKisses,"","align=""middle"""))
	Smile = fString
end function


function extratags(fString)
	fString = doCode(fString, "[spoiler]", "[/spoiler]", "<font color=""" & CColor & """>", "</font id=""" & CColor & """>")
	extratags = fString
end function


function chkBadWords(fString)
	if trim(Application(strCookieURL & "STRBADWORDWORDS")) = "" or trim(Application(strCookieURL & "STRBADWORDREPLACE")) = "" then
		txtBadWordWords = ""
		txtBadWordReplace = ""
		'## Forum_SQL - Get Badwords from DB
		strSqlb = "SELECT B_BADWORD, B_REPLACE " 
		strSqlb = strSqlb & " FROM " & strFilterTablePrefix & "BADWORDS "

		set rsBadWord = Server.CreateObject("ADODB.Recordset")
		rsBadWord.open strSqlb, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText

		if rsBadWord.EOF then
			recBadWordCount = ""
		else
			allBadWordData = rsBadWord.GetRows(adGetRowsRest)
			recBadWordCount = UBound(allBadWordData,2)
		end if

		rsBadWord.close
		set rsBadWord = nothing

		if recBadWordCount <> "" then
			bBADWORD = 0
			bREPLACE = 1

			for iBadword = 0 to recBadWordCount
				BadWordWord = allBadWordData(bBADWORD,iBadWord)
				BadWordReplace = allBadWordData(bREPLACE,iBadWord)
				if txtBadWordWords = "" then
					txtBadWordWords = BadWordWord
					txtBadWordReplace = BadWordReplace
				else
					txtBadWordWords = txtBadWordWords & "," & BadWordWord
					txtBadWordReplace = txtBadWordReplace & "," & BadWordReplace
				end if
			next
		end if
		Application.Lock
		Application(strCookieURL & "STRBADWORDWORDS") = txtBadWordWords
		Application(strCookieURL & "STRBADWORDREPLACE") = txtBadWordReplace
		Application.UnLock
	end if
	txtBadWordWords = Application(strCookieURL & "STRBADWORDWORDS")
	txtBadWordReplace = Application(strCookieURL & "STRBADWORDREPLACE")
	if fString = "" or IsNull(fString) then fString = " "
	bwords = split(txtBadWordWords, ",")
	breplace = split(txtBadWordReplace, ",")
	for i = 0 to ubound(bwords)
		fString = Replace(fString, bwords(i), breplace(i), 1, -1, 1) 
	next
	chkBadWords = fString
end function


function HTMLEncode(pString)
	fString = trim(pString)
	if fString = "" or IsNull(fString) then
		fString = " "
	else
		fString = replace(fString, ">", "&gt;")
		fString = replace(fString, "<", "&lt;")
	end if
	HTMLEncode = fString
end function


function HTMLDecode(pString)
	fString = trim(pString)
	if fString = "" then
		fString = " "
	else
		fString = replace(fString, "&gt;", ">")
		fString = replace(fString, "&lt;", "<")
	end if
	HTMLDecode = fString
end function


function chkString(pString,fField_Type) '## Types - name, password, title, message, url, urlpath, email, number, list
	fString = trim(pString)
	if fString = "" or isNull(fString) then
		fString = " "
	else
'		chkBadWords(fString)
	end if
	Select Case lcase(fField_Type)
		Case "refer"
			fString = Replace(fString, "&#", "#")
			fString = Replace(fString, """", "&quot;")
			fString = HTMLEncode(fString)
			ChkString = fString
			exit function
		Case "archive"
			fString = Replace(fString, "'", "''")
			if strDBType = "mysql" then
				fString = Replace(fString, "\", "\\")
			end if
			chkString = fString
			exit function
		Case "displayimage"
			fString = Replace(fString, " ", "")
			fString = Replace(fString, """", "")
			fString = Replace(fString, "<", "")
			fString = Replace(fString, ">", "")
			chkString = fString
			exit function
		Case "pagetitle"
			if strBadWordFilter = "1" then
   				fString = chkBadWords(fString)
	        	end if
			fString = Replace(fString,"\","\\")
			fString = Replace(fString,"'","\'")
			fString = HTMLDecode(fString)
			chkString = fString
			exit function
		Case "title"
			if strAllowHTML <> "1" then
				fString = HTMLEncode(fString)
			end if
			if strBadWordFilter = "1" then
   				fString = chkBadWords(fString)
	        	end if
			chkString = fString
			exit function
		Case "password"
			fString = trim(fString)
			chkString = fString
		Case "decode"
			fString = HTMLDecode(fString)
			chkString = fString
			exit function
		Case "urlpath"
			fString = Server.URLEncode(fString)
			chkString = fString
			exit function
		Case "sqlstring"
			fString = Replace(fString, "'", "''")
			if strDBType = "mysql" then
				fString = Replace(fString, "\", "\\")
			end if
			fString = HTMLEncode(fString)
			chkString = fString
			exit function
		Case "jsurlpath"
			fString = Replace(fString, "'", "\'")
			fString = Server.URLEncode(fString)
			chkString = fString
			exit function
		Case "edit"
			if strAllowHTML <> "1" then
				fString = HTMLEncode(fString)
			end if
			fString = Replace(fString, """", "&quot;")
			ChkString = fString
			exit function
		Case "admindisplay"
			if strAllowHTML <> "1" then
				fString = HTMLEncode(fString)
			end if
			chkString = fString
			exit function
		Case "display"
			if strAllowHTML <> "1" then
				fString = HTMLEncode(fString)
			end if
	                if strBadWordFilter = "1" then
        	                fString = ChkBadWords(fString)
                	end if
			fString = replace(fString,"+","&#043;")
			fString = replace(fString, """", "&quot;")
			chkString = fString
			exit function
		Case "search"
			if strAllowHTML <> "1" then
				fString = HTMLEncode(fString)
			end if
	                if strBadWordFilter = "1" then
        	                fString = ChkBadWords(fString)
                	end if
			fString = Replace(fString, """", "&quot;")
			chkString = fString
			exit function
		Case "message"
	                if strBadWordFilter = "1" then
        	                fString = ChkBadWords(fString)
                	end if
			fString = Replace(fString,"&#","#")
			if strDBType = "mysql" then