<%
'解释<br>时加换行
function htmlencode(str)
dim htmlresult
dim l
if isNULL(str) then
htmlencode=""
exit function
end if
l=len(str)
htmlresult=""
dim i
for i = 1 to l
select case mid(str,i,1)
case "<"
htmlresult=htmlresult+"<"
case ">"
htmlresult=htmlresult+">"
case chr(13)
htmlresult=htmlresult+"<br>"
case chr(34)
htmlresult=htmlresult+"""
case "&"
htmlresult=htmlresult+"&"
case chr(32)
'htmlresult=htmlresult+" "
if i+1<=l and i-1>0 then
if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then
htmlresult=htmlresult+" "
else
htmlresult=htmlresult+" "
end if
else
htmlresult=htmlresult+" "
end if
case chr(9)
htmlresult=htmlresult+" "
case else
htmlresult=htmlresult+mid(str,i,1)
end select
next
htmlencode=htmlresult
end function
function sustainhtml(str)
dim htmlresult
dim l
if isNULL(str) then
sustainhtml=""
exit function
end if
l=len(str)
htmlresult=""
dim i
for i = 1 to l
select case mid(str,i,1)
case chr(13)
htmlresult=htmlresult+"<br>"
case chr(34)
htmlresult=htmlresult+"""
case chr(32)
'htmlresult=htmlresult+" "
if i+1<=l and i-1>0 then
if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then
htmlresult=htmlresult+" "
else
htmlresult=htmlresult+" "
end if
else
htmlresult=htmlresult+" "
end if
case "&"
htmlresult=htmlresult+"&"
case chr(9)
htmlresult=htmlresult+" "
case else
htmlresult=htmlresult+mid(str,i,1)
end select
next
sustainhtml=htmlresult
end function
' 检查sql字符串中是否有单引号,有则进行转化
function CheckStr(str)
dim tstr,l,i,ch
l=len(str)
for i=1 to l
ch=mid(str,i,1)
if ch="'" then
tstr=tstr+"'"
end if
tstr=tstr+ch
next
CheckStr=tstr
end function
'email有效性检查
function IsValidEmail(email)
dim names, name, i, c
'Check for valid syntax in an email address.
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
IsValidEmail = false
exit function
end if
for each name in names
if Len(name) <= 0 then
IsValidEmail = false
exit function
end if
for i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
IsValidEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
IsValidEmail = false
exit function
end if
next
if InStr(names(1), ".") <= 0 then
IsValidEmail = false
exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
IsValidEmail = false
exit function
end if
if InStr(email, "..") > 0 then
IsValidEmail = false
end if
end function
'将一文字中的HTML的标识去掉
Function FilterHTML(strToFilter)
Dim strTemp
strTemp = strToFilter
While Instr(1,strTemp,"<") AND Instr(1, strTemp, ">")
strTemp = Left(strTemp, Instr(1, strTemp, "<")-1) & Right(strTemp, Len(strTemp)-Instr(1,strTemp, ">"))
WEnd
FilterHTML = strTemp
End Function
'以下代码来自www本人还没有彻底修改完善
function ubb(strContent)
strContent = htmlencode(strContent)
dim re,ii,po
dim reContent
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(javascript)"
strContent=re.Replace(strContent,"<I>javascript</I>")
re.Pattern="(jscript"
strContent=re.Replace(strContent,"<I>jscript:</I>")
re.Pattern="(js"
strContent=re.Replace(strContent,"<I>js:</I>")
re.Pattern="(value)"
strContent=re.Replace(strContent,"<I>value</I>")
re.Pattern="(about"
strContent=re.Replace(strContent,"<I>about:</I>")
re.Pattern="(file:)"
strContent=re.Replace(strContent,"<I>file:</I>")
re.Pattern="(document.cookie)"
strContent=re.Replace(strContent,"<I>documents.cookie</I>")
re.Pattern="(vbscript:)"
strContent=re.Replace(strContent,"<I>vbscript:</I>")
re.Pattern="(vbs:)"
strContent=re.Replace(strContent,"<I>vbs:</I>")
re.Pattern="(on(mouse|exit|error|click|key))"
strContent=re.Replace(strContent,"<I>on$2</I>")
re.Pattern="\[IMG\](.[^\[]*)\[\/IMG\]"
strContent=re.Replace(strContent,"<IMG SRC=""$1"" border=0>")
re.Pattern="\[IMG=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/IMG\]"
strContent=re.Replace(strContent,"<IMG SRC=""$3"" border=0 height=""$1"" width=""$2"">")
re.Pattern="(\[FLASH\])(.[^\[]*)(\[\/FLASH\])"
strContent= re.Replace(strContent,"<a href=""$2"" TARGET=_blank>[全屏欣赏]</a><br><OBJECT codeBase=./download/swflash.cab#version=6,0,29,0 classid=clsid27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><ARAM NAME=movie VALUE=""$2""><ARAM NAME=quality VALUE=high><embed src=""$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$2</embed></OBJECT>")
re.Pattern="(\[FLASH=*([0-9]*),*([0-9]*)\])(.[^\[]*)(\[\/FLASH\])"
strContent= re.Replace(strContent,"<a href=""$4"" TARGET=_blank>[全屏欣赏]</a><br><OBJECT codeBase=./download/swflash.cab#version=6,0,29,0 classid=clsid27CDB6E-AE6D-11cf-96B8-444553540000 width=$2 height=$3><ARAM NAME=movie VALUE=""$4""><PARAM NAME=quality VALUE=high><embed src=""$4"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=$2 height=$3>$4</embed></OBJECT>")
re.Pattern="(\[URL\])(.[^\[]*)(\[\/URL\])"
strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$2</A>")
re.Pattern="(\[URL=(.[^\[]*)\])(.[^\[]*)(\[\/URL\])"
strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$3</A>")
re.Pattern="(\[EMAIL\])(\S+\@.[^\[]*)(\[\/EMAIL\])"
strContent= re.Replace(strContent,"<A HREF=""mailto2"">$2</A>")
re.Pattern="(\[EMAIL=(\S+\@.[^\[]*)\])(.[^\[]*)(\[\/EMAIL\])"
strContent= re.Replace(strContent,"<A HREF=""mailto2"" TARGET=_blank>$3</A>")
re.Pattern="\[color=(.[^\[]*)\](.[^\[]*)\[\/color\]"
strContent=re.Replace(strContent,"<font color=$1>$2</font>")
re.Pattern="\[font=(.[^\[]*)\](.[^\[]*)\[\/face\]"
strContent=re.Replace(strContent,"<font face=$1>$2</font>")
re.Pattern="\[align=(center|left|right)\](.*)\[\/align\]"
strContent=re.Replace(strContent,"<div align=$1>$2</div>")
re.Pattern="\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/SHADOW]"
strContent=re.Replace(strContent,"<table width=$1 ><tr><td style=""filter:shadow(color=$2, strength=$3)"">$4</td></tr></table>")
re.Pattern="\[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/GLOW]"
strContent=re.Replace(strContent,"<table width=$1 ><tr><td style=""filter:glow(color=$2, strength=$3)"">$4</td></tr></table>")
re.Pattern="\[i\](.[^\[]*)\[\/i\]"
strContent=re.Replace(strContent,"<i>$1</i>")
re.Pattern="\[u\](.[^\[]*)(\[\/u\])"
strContent=re.Replace(strContent,"<u>$1</u>")
re.Pattern="\[b\](.[^\[]*)(\[\/b\])"
strContent=re.Replace(strContent,"<b>$1</b>")
re.Pattern="\[size=([1-4])\](.[^\[]*)\[\/size\]"
strContent=re.Replace(strContent,"<font size=$1>$2</font>")
strContent=replace(strContent,"<I></I>","")
set re=Nothing
ubb=strContent
end function
%> |