怎样让网页支持UBB代码？ |
| 作者：佚名 来源：互联网采集 更新：2008-6-10 9:33:03 |
|
需要有一个解析代码
保存在另一个网页中,然后调动
<%
function UBB_IMG(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[IMG\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "IMG" & chr(2))
re.Pattern="\[\/IMG\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/IMG" & chr(2))
re.Pattern="\x01IMG\x02(.[^\x01]*)\x01\/IMG\x02"
strContent=re.Replace(strContent,"<a onfocus=this.blur() href=""$1"" target=_blank><IMG SRC=""$1"" border=0 alt=按此在新窗口浏览图片 onload=""javascript:if(this.width>screen.width-400)this.width=screen.width-400""></a>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_IMG=strContent
end function
function UBB_UPLOAD(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[UPLOAD=(gif|jpg|jpeg|bmp|png)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "UPLOAD=$1" & chr(2))
re.Pattern="\[\/UPLOAD\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/UPLOAD" & chr(2))
re.Pattern="\x01UPLOAD=(gif|jpg|jpeg|bmp|png)\x02(.[^\x01]*)\x01\/UPLOAD\x02"
strContent= re.Replace(strContent,"<br><IMG SRC=""images/files/$1.gif"" border=0>此主题相关图片如下：<br><A HREF=""$2"" TARGET=_blank><IMG SRC=""$2"" border=0 alt=按此在新窗口浏览图片 onload=""javascript:if(this.width>screen.width-400)this.width=screen.width-400""></A>")
re.Pattern="\[UPLOAD=(.[^\[]*)\]"
strContent=re.replace(strContent, chr(1) & "UPLOAD=$1" & chr(2))
re.Pattern="\x01UPLOAD=(.[^\x01]*)\x02(.[^\x01]*)\x01\/UPLOAD\x02"
strContent= re.Replace(strContent,"<br><IMG SRC=""images/files/$1.gif"" border=0> <a href=""$2"">点击浏览该文件</a>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
re.Pattern="\[UPLOAD=(.[^\[]*)\](.[^\[]*)\[\/UPLOAD\]"
strContent= re.Replace(strContent,"<br><IMG SRC=""images/files/$1.gif"" border=0> <a href=""$2"">点击浏览该文件</a>")
set re=Nothing
UBB_UPLOAD=strContent
end function
function UBB_DIR(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[DIR=*([0-9]*),*([0-9]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "DIR=$1,$2" & chr(2))
re.Pattern="\[\/DIR\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/DIR" & chr(2))
re.Pattern="\x01DIR=*([0-9]*),*([0-9]*)\x02(.[^\x01]*)\x01\/DIR\x02"
strContent=re.Replace(strContent,"<object classid=clsid:166B1BCA-3F9C-11CF-8075-444553540000 codebase=http://download.macromedia.com/pub/shockwave/cabs/director/sw.cab#version=7,0,2,0 width=$1 height=$2><param name=src value=$3><embed src=$3 pluginspage=http://www.macromedia.com/shockwave/download/ width=$1 height=$2></embed></object>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_DIR=strContent
end function
function UBB_QT(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[QT=*([0-9]*),*([0-9]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "QT=$1,$2" & chr(2))
re.Pattern="\[\/QT\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/QT" & chr(2))
re.Pattern="\x01QT=*([0-9]*),*([0-9]*)\x02(.[^\x01]*)\x01\/QT\x02"
strContent=re.Replace(strContent,"<embed src=$3 width=$1 height=$2 autoplay=true loop=false controller=true playeveryframe=false cache=false scale=TOFIT bgcolor=#000000 kioskmode=false targetcache=false pluginspage=http://www.apple.com/quicktime/>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_QT=strContent
end function
function UBB_MP(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[MP=*([0-9]*),*([0-9]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "MP=$1,$2" & chr(2))
re.Pattern="\[\/MP\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/MP" & chr(2))
re.Pattern="\x01MP=*([0-9]*),*([0-9]*)\x02(.[^\x01]*)\x01\/MP\x02"
strContent=re.Replace(strContent,"<object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=$1 height=$2 ><param name=ShowStatusBar value=-1><param name=Filename value=$3><embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=$3 width=$1 height=$2></embed></object>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_MP=strContent
end function
function UBB_RM(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[RM=*([0-9]*),*([0-9]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "RM=$1,$2" & chr(2))
re.Pattern="\[\/RM\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/RM" & chr(2))
re.Pattern="\x01RM=*([0-9]*),*([0-9]*)\x02(.[^\x01]*)\x01\/RM\x02"
strContent=re.Replace(strContent,"<OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2><PARAM NAME=SRC VALUE=$3><PARAM NAME=CONSOLE VALUE=Clip1><PARAM NAME=CONTROLS VALUE=imagewindow><PARAM NAME=AUTOSTART VALUE=true></OBJECT><br><OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=video2 width=$1><PARAM NAME=SRC VALUE=$3><PARAM NAME=AUTOSTART VALUE=-1><PARAM NAME=CONTROLS VALUE=controlpanel><PARAM NAME=CONSOLE VALUE=Clip1></OBJECT>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_RM=strContent
end function
function UBB_FLASH(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[FLASH\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "FLASH" & chr(2))
re.Pattern="\[\/FLASH\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/FLASH" & chr(2))
re.Pattern="\x01FLASH\x02(.[^\x01]*)\x01\/FLASH\x02"
strContent=re.Replace(strContent,"<a href=""$1"" TARGET=_blank><IMG SRC=ubb/swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><OBJECT codeBase=end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_SOUND=strContent
end function
function UBB_URL(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[URL\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "URL" & chr(2))
re.Pattern="\[\/URL\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/URL" & chr(2))
re.Pattern="\x01URL\x02(.[^\x01]*)\x01\/URL\x02"
strContent=re.Replace(strContent,"<A HREF=""$1"" TARGET=_blank>$1</A>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
re.Pattern="\[URL=(.[^\[]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "URL=$1" & chr(2))
re.Pattern="\[\/URL\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/URL" & chr(2))
re.Pattern="\x01URL=(.[^\x01]*)\x02(.[^\x01]*)\x01\/URL\x02"
strContent=re.Replace(strContent,"<A HREF=""$1"" TARGET=_blank>$2</A>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_URL=strContent
end function
function UBB_EMAIL(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[EMAIL\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "EMAIL" & chr(2))
re.Pattern="\[\/EMAIL\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/EMAIL" & chr(2))
re.Pattern="\x01EMAIL\x02(\S+\@.[^\x01]*)\x01\/EMAIL\x02"
strContent=re.Replace(strContent,"<img align=absmiddle src=ubb/email1.gif><A HREF=""mailto:$1"">$1</A>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
re.Pattern="\[EMAIL=(\S+\@.[^\[]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "EMAIL=$1" & chr(2))
re.Pattern="\[\/EMAIL\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/EMAIL" & chr(2))
re.Pattern="\x01EMAIL=(\S+\@.[^\x01]*)\x02(.[^\x01]*)\x01\/EMAIL\x02"
strContent=re.Replace(strContent,"<img align=absmiddle src=ubb/email1.gif><A HREF=""mailto:$1"" TARGET=_blank>$2</A>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_EMAIL=strContent
end function
function UBB_HTML(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[HTML\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "HTML" & chr(2))
re.Pattern="\[\/HTML\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/HTML" & chr(2))
re.Pattern="\x01HTML\x02(.[^\x01]*)\x01\/HTML\x02"
strContent=re.Replace(strContent,"<table width='100%' border='0' cellspacing='0' cellpadding='6' class='"&abgcolor&"'><td><b>以下内容为程序代码:</b><br>$1</td></table>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_HTML=strContent
end function
function UBB_CODE(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[CODE\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "CODE" & chr(2))
re.Pattern="\[\/CODE\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/CODE" & chr(2))
re.Pattern="\x01CODE\x02(.[^\x01]*)\x01\/CODE\x02"
strContent=re.Replace(strContent,"<table width='100%' border='0' cellspacing='0' cellpadding='6' class='"&abgcolor&"'><td><b>以下内容为程序代码:</b><br>$1</td></table>")
re.Pattern="\x02"
strContent=re.replace(strContent, "]")
end if
re.Pattern="\x01"
strContent=re.replace(strContent, "[")
end if
set re=Nothing
UBB_CODE=strContent
end function
function UBB_COLOR(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[COLOR=(.[^\[]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "COLOR=$1" & chr(2))
re.Pattern="\[\/COLOR\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/COLOR" & chr(2))
re.Pattern="\x01COLOR=(.[^\x01]*)\x02(.[^\x01]*)\x01\/COLOR\x02"
strContent=re.Replace(strContent,"<font color=$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_COLOR=strContent
end function
function UBB_FACE(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[FACE=(.[^\[]*)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "FACE=$1" & chr(2))
re.Pattern="\[\/FACE\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "/FACE" & chr(2))
re.Pattern="\x01FACE=(.[^\x01]*)\x02(.[^\x01]*)\x01\/FACE\x02"
strContent=re.Replace(strContent,"<font face=$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_FACE=strContent
end function
function UBB_ALIGN(strText)
dim strContent
dim re,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
strContent=strText
re.Pattern="\[ALIGN=(center|left|right)\]"
Test=re.Test(strContent)
if Test then
strContent=re.replace(strContent, chr(1) & "ALIGN=$1" & chr(2))
re.Pattern="\[\/ALIGN\]"
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.replac |
|
上一篇:成为最牛程序员的五大要诀
下一篇:网页打开速度慢的原因分析！ |
|
|
|
