⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 ubbcode.asp

📁 安全性好,适用于制作论坛和进行资源下载的个人和大型网站使用!
💻 ASP
📖 第 1 页 / 共 3 页
字号:
🔍
123 
	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%"" bgcolor=""#FFFFFF"">$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 =  HTMLcode(strContent)

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

'脚本标签
If InStr(Lcase(strContent),"script")>0 Then
re.Pattern="(javascript)"
strContent=re.Replace(strContent,"<I>&#106avascript</I>")
re.Pattern="(vbscript:)"
strContent=re.Replace(strContent,"<I>&#118bscript:</I>")
re.Pattern="(jscript:)"
strContent=re.Replace(strContent,"<I>&#106script:</I>")
End If
	
If InStr(Lcase(strContent),"js:")>0 Then
re.Pattern="(js:)"
strContent=re.Replace(strContent,"<I>&#106s:</I>")
End If
	
If InStr(Lcase(strContent),"value")>0 Then
re.Pattern="(value)"
strContent=re.Replace(strContent,"<I>&#118alue</I>")
End If
	
If InStr(Lcase(strContent),"about:")>0 Then
re.Pattern="(about:)"
strContent=re.Replace(strContent,"<I>about&#58</I>")
End If
	
If InStr(Lcase(strContent),"file:")>0 Then
re.Pattern="(file:)"
strContent=re.Replace(strContent,"<I>file&#58</I>")
End If
	
If InStr(Lcase(strContent),"document.cookie")>0 Then
re.Pattern="(document.cookie)"
strContent=re.Replace(strContent,"<I>documents&#46cookie</I>")
End If
	
If InStr(Lcase(strContent),"vbs:")>0 Then
re.Pattern="(vbs:)"
strContent=re.Replace(strContent,"<I>&#118bs:</I>")
End If
	
If InStr(Lcase(strContent),"on(")>0 Then
re.Pattern="(on(mouse|exit|error|click|key))"
strContent=re.Replace(strContent,"<I>&#111n$2</I>")
End If

'特殊内容标签(版主贴)
If InStr(Lcase(strContent),"[master]")>0 Then
re.Pattern="\[MASTER\](.*)\[\/MASTER\]"
      If checkbbsadmin(bid)>0 or checkadmin(ckuname)>=3 Then
	        strContent=re.Replace(strContent,"<table style=""width:100%"" cellpadding=1 cellspacing=1 bgcolor=#CFCFCF><TR><TD bgcolor=#F0F0F0 width=""100%""><Font color=RED><B>&nbsp;以下是给版主的悄悄话：</B></Font><BR>$1</td></tr></table>")
      Else
		strContent=re.Replace(strContent,"<table style=""width:90%"" cellpadding=1 cellspacing=1 bgcolor=#CFCFCF align=center><TR><TD bgcolor=#F0F0F0 width=""100%""><Font color=RED><B>&nbsp;此部分内容是给版主的悄悄话...</B></Font></td></tr></table>")
      End If
End If

'加密贴
If InStr(Lcase(strContent),"[locked=")>0 Then
Dim xi,yi,xContent
xi=InStr(Lcase(strContent),"[locked=")
xContent=Mid(strContent,xi)
xi=InStr(xContent,"=")+1
yi=InStr(xContent,"]")
xContent=Mid(xContent,xi,yi-xi)
re.Pattern="(\[LOCKED=(.[^\[]*)\])(.*)(\[\/LOCKED\])"
     if checkbbsadmin(bid)>0 or Request.Form("LockPassd")=xContent or checkadmin(ckuname)>=3 then
	       strContent=re.Replace(strContent,"<table style=""width:100%"" cellpadding=1 cellspacing=1 bgcolor=#CFCFCF><TR><TD bgcolor=#F0F0F0 width=""100%""><Font color=RED><B>&nbsp;以下是加密内容：</B></Font><BR>$3</td></tr></table>")
     else
	       strContent=re.Replace(strContent,"<table style=""width:90%"" cellpadding=1 cellspacing=1 bgcolor=#CFCFCF align=center><Form name=""LockForm"" Method=POST Action=""?action=openlocked&aid=" & aid & """><TR><TD bgcolor=#F0F0F0 width=""100%""><Font color=RED><B>&nbsp;此部份内容已被加密...</B></Font> 请输入口令查看：<input type=password size=20 maxlength=16 name=""LockPassd"" class=input> <input type=submit value=""确 定"" name=""submit""></td></tr></Form></table>")
     end if
End If

'回复贴
If InStr(Lcase(strContent),"[showtoreply]")>0 Then
re.Pattern="\[showtoreply\](.*)\[\/showtoreply\]"
dim canread,ubbrs
canread=false
     if isnull(userid) or userid="" then
        canread=false
     else
     set ubbrs=conn.execute("select top 1 * from hx66_saybbs where hx66_iid="&aid&" and hx66_user='"&ckuname&"'")
        if not ubbrs.eof or ztuser=ckuname or checkadmin(ckuname)>=3 then canread=true
     set ubbrs=nothing
     end if
  if canread=true then
             strContent=re.Replace(strContent,"<table style=""width:100%"" cellpadding=1 cellspacing=1 bgcolor=#CFCFCF><TR><TD bgcolor=#F0F0F0 width=""100%""><Font color=RED><B>&nbsp;此内容只有作者和已经回复此帖的浏览者能浏览：</B></Font><BR>$1</td></tr></table>")
  else
             strContent=re.Replace(strContent,"<table style=""width:100%"" cellpadding=1 cellspacing=1 bgcolor=#CFCFCF><TR><TD bgcolor=#F0F0F0 width=""100%""><Font color=RED><B>&nbsp;此内容只有作者和已经回复此帖的浏览者能浏览...</B></Font></td></tr></table>")
  end if
End If

'积分贴
re.Pattern="(^.*)(\[point=(.[*([0-9]*)\])(.*)(\[\/point\])(.*)"
're.Pattern="(^.*)(\[point=*([0-9]*)\])(.[^\[]*)(\[\/point\])(.*)"
dim needpoint,userpoint
needpoint=re.Replace(strContent,"$3")
if IsNumeric(needpoint) then needmark=int(needpoint) else needpoint=0
   if isnull(userid) or userid="" then
        userpoint="0"
   else
        dim rsaud,sqlaud
        set rsaud=server.CreateObject("adodb.recordset")
        sqlaud="select * from hx66_uinfo where hx66_uname='"&ckuname&"'"
        rsaud.open sqlaud,conn,1,1
           if not rsaud.eof then
              userpoint=rsaud("hx66_money")
           else
              userpoint="0"
           end if
        rsaud.close
        set rsaud=nothing
  end if
  if userpoint-needpoint>=0 or ztuser=ckuname or checkadmin(ckuname)>=3 then
	     strContent=re.Replace(strContent,"<table style=""width:100%"" cellpadding=1 cellspacing=1 bgcolor=#CFCFCF><TR><TD bgcolor=#F0F0F0 width=""100%""><Font color=RED><B>&nbsp;此内容需要论坛积分 <b>"&needpoint&"</b> 以上的用户才能浏览：</B></Font><BR>$4</td></tr></table>")
  else
             strContent=re.Replace(strContent,"<table style=""width:100%"" cellpadding=1 cellspacing=1 bgcolor=#CFCFCF><TR><TD bgcolor=#F0F0F0 width=""100%""><Font color=RED><B>&nbsp;此内容需要论坛积分 <b>"&needpoint&"</b> 以上的用户才能浏览...</B></Font></td></tr></table>")
  end if


'IMG Code
strContent=UBB_IMG(strContent)

'FLASH Code
strContent=UBB_FLASH(strContent)

'URL Code
strContent=UBB_URL(strContent)

'URL SOUND
strContent=UBB_SOUND(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)

'RM Code
strContent=UBB_RM(strContent)

'UPLOAD Code
strContent=UBB_UPLOAD(strContent)

'自动识别网址
re.Pattern = "(^|[^==""])((http|https|ftp|rtsp|mms|pnm|mmst):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)"
strContent = re.Replace(strContent,"$1<img align=absmiddle src=images/url.gif border=0><a target=_blank href=$2>$2</a>")
re.Pattern = "((http|https|ftp|rtsp|mms|pnm|mmst):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)$"
strContent = re.Replace(strContent,"<img align=absmiddle src=images/url.gif border=0><a target=_blank href=$1>$1</a>")
re.Pattern = "([^>=""])((http|https|ftp|rtsp|mms|pnm|mmst):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)"
strContent = re.Replace(strContent,"$1<img align=absmiddle src=images/url.gif border=0><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,"$1<img align=absmiddle src=images/url.gif border=0><a target=_blank href=http://$2>$2</a>")

'em code
if instr(lcase(strContent),"[em")>0 then
	for i=1 to 34
	strContent=replace(lcase(strContent),"[em"&i&"]","<img src=emot/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), "&#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 htmlcoder(str)
if not isnull(str) and str<>"" then
	str = replace(str, ">", "&gt;")
	str = replace(str, "<", "&lt;")
	str = Replace(str, CHR(32), " ")
	str = Replace(str, CHR(9), "&nbsp;")
	str = Replace(str, CHR(34), "&quot;")
	str = Replace(str, CHR(39), "&#39;")
	str = Replace(str, CHR(13), "")
	str = Replace(str, CHR(10), "<br>")
	str = Replace(str, "script", "&#115;cript")
	str = Replace(str, "＆#115;", "&#115;")
htmlcoder = str
end if
end function
%>
123

⌨️ 快捷键说明

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