📄 ubbcode.asp

📁 一个用jsp 编写的个人主页网站哦。希望对大家有所帮助啊
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
			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></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 = JScode(strContent)

'UbbCode
dim re,ii,po
dim reContent,Test
Set re=new RegExp
re.IgnoreCase =true
re.Global=True

'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>")

'em code
if instr(lcase(strContent),"[em")>0 then
	for i=1 to 30
	strContent=replace(lcase(strContent),"[em"&i&"]","<img src=pic/em"&i&".gif border=0 align=middle>")
	next
else
	re.Pattern="\[em(.[^\[]*)\]"
	strContent=re.Replace(strContent,"")
end if

	set objRegExp=Nothing
	UBBCode=strContent

set re=Nothing
UBBCode=strContent
end function

function HTMLcode(HtmlStr)
if not isnull(HtmlStr) then
    HtmlStr = replace(HtmlStr, ">", "&gt;")
    HtmlStr = replace(HtmlStr, "<", "&lt;")
    HtmlStr = Replace(HtmlStr, CHR(32), "<I></I>&nbsp;")
    HtmlStr = Replace(HtmlStr, CHR(9), "&nbsp;")
    HtmlStr = Replace(HtmlStr, CHR(34), "&quot;")
    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 JScode(JSstr)
if not isnull(JSstr) then
dim ts
dim re
dim reContent
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(javascript)"
ts=re.Replace(JSstr,"&#106avascript")
re.Pattern="(jscript:)"
ts=re.Replace(ts,"&#106script:")
re.Pattern="(js:)"
ts=re.Replace(ts,"&#106s:")
re.Pattern="(value)"
ts=re.Replace(ts,"&#118alue")
re.Pattern="(about:)"
ts=re.Replace(ts,"about&#58")
re.Pattern="(file:)"
ts=re.Replace(ts,"file&#58")
re.Pattern="(document.cookie)"
ts=re.Replace(ts,"documents&#46cookie")
re.Pattern="(vbscript:)"
ts=re.Replace(ts,"&#118bscript:")
re.Pattern="(vbs:)"
ts=re.Replace(ts,"&#118bs:")
re.Pattern="(on(mouse|exit|error|click|key))"
ts=re.Replace(ts,"&#111n$2")
re.Pattern="(&#)"
ts=re.Replace(ts,"＆#")
JScode=ts
set re=nothing
end if
End Function

function findgbchk(gbstr)

dim gbchk,forms,tempform,gbform
set rschk=server.createobject("adodb.recordset")
rschk.open "select gbchk from admin",conn,1,1
gbchk=rschk("gbchk")
rschk.close
gbchk=split(gbchk,"|")

	dim i
	for i = 0 to ubound(gbchk)
	  if instr(gbstr,gbchk(i))>0 then
		gbform=Replace(gbstr,gbchk(i),"***")
		exit for
	  else
	    gbform=gbstr
	  end if
	next
	findgbchk=gbform
end function
%>
上一页 12
💿 文件大小 884 K
👤 上传用户 Mrsliu
📂 所属分类 Jsp/Servlet
🏷️ 相关标签

#jsp #编写 #家 #页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -