📄 ubbcode.asp
字号:
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/ALIGN" & chr(2))
re.Pattern="\x01ALIGN=(center|left|right)\x02(.[^\x01]*)\x01\/ALIGN\x02"
strContent=re.Replace(strContent,"<div align=$1>$2</div>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_ALIGN=strContent
end function
function UBB_FLY(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[FLY\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "FLY" & chr(2))
re.Pattern="\[\/FLY\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/FLY" & chr(2))
re.Pattern="\x01FLY\x02(.[^\x01]*)\x01\/FLY\x02"
strContent=re.Replace(strContent,"<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_FLY=strContent
end function
function UBB_MOVE(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[MOVE\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "MOVE" & chr(2))
re.Pattern="\[\/MOVE\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/MOVE" & chr(2))
re.Pattern="\x01MOVE\x02(.[^\x01]*)\x01\/MOVE\x02"
strContent=re.Replace(strContent,"<MARQUEE scrollamount=3>$1</marquee>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_MOVE=strContent
end function
function UBB_CENTER(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[CENTER\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "CENTER" & chr(2))
re.Pattern="\[\/CENTER\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/CENTER" & chr(2))
re.Pattern="\x01CENTER\x02(.[^\x01]*)\x01\/CENTER\x02"
strContent=re.Replace(strContent,"<div align=center>$1</div>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_CENTER=strContent
end function
function UBB_SHADOW(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "SHADOW=$1,$2,$3" & chr(2))
re.Pattern="\[\/SHADOW\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/SHADOW" & chr(2))
re.Pattern="\x01SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\x02(.[^\x01]*)\x01\/SHADOW\x02"
strContent=re.Replace(strContent,"<table width=$1><tr><td style=""filter:shadow(color=$2, strength=$3)"">$4</td></tr></table>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_SHADOW=strContent
end function
function UBB_GLOW(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "GLOW=$1,$2,$3" & chr(2))
re.Pattern="\[\/GLOW\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/GLOW" & chr(2))
re.Pattern="\x01GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\x02(.[^\x01]*)\x01\/GLOW\x02"
strContent=re.Replace(strContent,"<table width=$1><tr><td style=""filter:glow(color=$2, strength=$3)"">$4</td></tr></table>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_GLOW=strContent
end function
function UBB_I(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[I\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "I" & chr(2))
re.Pattern="\[\/I\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/I" & chr(2))
re.Pattern="\x01I\x02(.[^\x01]*)\x01\/I\x02"
strContent=re.Replace(strContent,"<i>$1</i>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_I=strContent
end function
function UBB_U(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[U\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "U" & chr(2))
re.Pattern="\[\/U\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/U" & chr(2))
re.Pattern="\x01U\x02(.[^\x01]*)\x01\/U\x02"
strContent=re.Replace(strContent,"<u>$1</u>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_U=strContent
end function
function UBB_B(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[B\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "B" & chr(2))
re.Pattern="\[\/B\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/B" & chr(2))
re.Pattern="\x01B\x02(.[^\x01]*)\x01\/B\x02"
strContent=re.Replace(strContent,"<b>$1</b>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_B=strContent
end function
function UBB_SIZE(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[SIZE=([1-7])\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "SIZE=$1" & chr(2))
re.Pattern="\[\/SIZE\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/SIZE" & chr(2))
re.Pattern="\x01SIZE=([1-7])\x02(.[^\x01]*)\x01\/SIZE\x02"
strContent=re.Replace(strContent,"<font size=$1>$2</font>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_SIZE=strContent
end function
function UBB_QUOTE(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[QUOTE\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "QUOTE" & chr(2))
re.Pattern="\[\/QUOTE\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/QUOTE" & chr(2))
do
re.Pattern="\x01QUOTE\x02(.[^\x01]*)\x01\/QUOTE\x02"
strContent=re.Replace(strContent,"<table style=""width:100%"" cellpadding=5 cellspacing=1 class=tablegubb><TR><TD width=""100%""><b>引用:</b><br>$1</td></tr><tr><td height=1 bgcolor=#CCCCCC></td></tr></table><br>")
Test=re.Test(strContent)
loop while(Test)
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_QUOTE=strContent
end function
'参数:strContent内容
function UBBCode(strContent)
'HTML Code
strContent = HTMLcode(strContent)
'UbbCode
dim re,ii,po
dim reContent,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
'——脚本字符处理
re.Pattern="(javascript)"
strContent=re.Replace(strContent,"javascript")
re.Pattern="(jscript:)"
strContent=re.Replace(strContent,"jscript:")
re.Pattern="(js:)"
strContent=re.Replace(strContent,"js:")
re.Pattern="(vbscript:)"
strContent=re.Replace(strContent,"vbscript:")
re.Pattern="(vbs:)"
strContent=re.Replace(strContent,"vbs:")
re.Pattern="(on(mouse|exit|error|click|key))"
strContent=re.Replace(strContent,"on$2")
re.Pattern="(value)"
strContent=re.Replace(strContent,"value")
re.Pattern="(about:)"
strContent=re.Replace(strContent,"about:")
re.Pattern="(file:)"
strContent=re.Replace(strContent,"file:")
re.Pattern="(document.cookie)"
strContent=re.Replace(strContent,"documents.cookie")
'IMG Code
strContent=UBB_IMG(strContent)
'FLASH Code
strContent=UBB_FLASH(strContent)
'URL Code
strContent=UBB_URL(strContent)
'EMAIL Code
strContent=UBB_EMAIL(strContent)
'COLOR Code
strContent=UBB_COLOR(strContent)
'FACE Code
strContent=UBB_FACE(strContent)
'ALIGN Code
strContent=UBB_ALIGN(strContent)
'FLY Code
strContent=UBB_FLY(strContent)
'MOVE Code
strContent=UBB_MOVE(strContent)
'CENTER Code
strContent=UBB_CENTER(strContent)
'SHADOW Code
strContent=UBB_SHADOW(strContent)
'GLOW Code
strContent=UBB_GLOW(strContent)
'I Code
strContent=UBB_I(strContent)
'U Code
strContent=UBB_U(strContent)
'B Code
strContent=UBB_B(strContent)
'QUOTE Code
strContent=UBB_QUOTE(strContent)
'SIZE Code
strContent=UBB_SIZE(strContent)
'MP Code
strContent=UBB_MP(strContent)
'自动识别网址
re.Pattern = "^((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)"
strContent = re.Replace(strContent,"<a target=_blank href=$1>$1</a>")
re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)$"
strContent = re.Replace(strContent,"<a target=_blank href=$1>$1</a>")
re.Pattern = "([^>=""])((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)"
strContent = re.Replace(strContent,"$1<a target=_blank href=$2>$2</a>")
'自动识别 www 网址
re.Pattern = "([^(http://|http:\\)])((www|cn)[.](\w)+[.]{1,}(net|com|cn|org|cc)(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)"
strContent = re.Replace(strContent,"<a target=_blank href=http://$2>$2</a>")
'自动识别 Email 地址
're.Pattern = "([^(=)])((\w)+[@]{1}((\w)+[.]){1,3}(\w)+)"
'strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=""mailto:$2"">$2</a>")
set re=Nothing
UBBCode=strContent
end function
function HTMLcode(HtmlStr)
if not isnull(HtmlStr) then
HtmlStr = replace(HtmlStr, ">", ">")
HtmlStr = replace(HtmlStr, "<", "<")
HtmlStr = Replace(HtmlStr, CHR(32), "<I></I> ")
HtmlStr = Replace(HtmlStr, CHR(9), " ")
HtmlStr = Replace(HtmlStr, CHR(34), """)
HtmlStr = Replace(HtmlStr, CHR(39), "'")
HtmlStr = Replace(HtmlStr, CHR(13), "")
HtmlStr = Replace(HtmlStr, CHR(10) & CHR(10), "</P><P> ")
HtmlStr = Replace(HtmlStr, CHR(10), "<BR> ")
HTMLcode = HtmlStr
end if
end function
function address(sip)
dim str1,str2,str3,str4
dim num,sql
dim country,city
dim irs
if isnumeric(left(sip,2)) then
if sip="127.0.0.1" then sip="192.168.0.1"
str1=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str2=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str3=left(sip,instr(sip,".")-1)
str4=mid(sip,instr(sip,".")+1)
if isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 then
else
num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
sql="select Top 1 country,city from address where ip1 <="&num&" and ip2 >="&num&""
set irs=server.createobject("adodb.recordset")
irs.open sql,conn,1,1
if irs.eof and irs.bof then
country="亚洲"
city=""
else
country=irs(0)
city=irs(1)
end if
irs.close
set irs=nothing
end if
address=country&city
else
address="未知"
end if
end function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -