miniubb.asp

用ASP实现的论坛开发

<%
'//for Microsoft(R) Windows(R) Script 5.1
'//2004-9-5 修订
function miniUBB(UBBstring)
	dim Str:Str=UBBstring
	if not isnull(Str) then
		dim re
		Set re=new RegExp
			Str=Server.HTMLencode(Str)
			re.Pattern="(\[img\])(\S+)(\[\/img\])"
			Str=re.Replace(Str,"<img src=""$2"">")
			re.Pattern="(\[b\])(.[^\[]*)(\[\/b\])"
			Str=re.Replace(Str,"<b>$2</b>")
			re.Pattern="(\[color=)(\S+)(\])(.[^\[]*)(\[\/color\])"
			Str=re.Replace(Str,"<font color=""$2"">$4</font>")
			re.Pattern="(\[url=)(http|https|ftp)(:\/\/.[^\[]*)(\])(.[^\[]*)(\[\/url\])"
			Str=re.Replace(Str,"<a href=""$2$3"" target=_blank>$5</a>")
			re.Pattern="(\[center\])(.[^\[]*)(\[\/center\])"
			Str=re.Replace(Str,"<center>$2</center>")
			re.Pattern="(\[left\])(.[^\[]*)(\[\/left\])"
			Str=re.Replace(Str,"<div align=left>$2</div>")
			re.Pattern="(\[right\])(.[^\[]*)(\[\/right\])"
			Str=re.Replace(Str,"<div align=right>$2</div>")
			re.Pattern="(\[br\])"
			Str=re.Replace(Str,"<br>")
		miniUBB = Str
	else
		miniUBB = ""
	end if
end function 

'标题解码UBB
function enTitleUBB(content)
	dim re
	Set re=new RegExp
	re.IgnoreCase =True 
	re.Global=true
	're.Pattern="(\[t\])(.+?)(\[\/t\])"
	re.Pattern="(\[t\])(.[^\[]*)(\[\/t\])"
	content=re.Replace(content,"<b>$2</b>")
	're.Pattern="(\[#)(\S+?)(\])(.+?)(\[\/#\])"
	re.Pattern="(\[#)(.[^\[]*)(\])(.[^\[]*)(\[\/#\])"
	content=re.Replace(content,"<font color=""$2"">$4</font>")
	enTitleUBB=content
End Function 
'标题清除UBB
function deTitleUBB(content)
	dim re
	Set re=new RegExp
	re.IgnoreCase =True 
	re.Global=true
	're.Pattern="(\[t\])(.+?)(\[\/t\])"
	re.Pattern="(\[t\])(.[^\[]*)(\[\/t\])"
	content=re.Replace(content,"$2")
	're.Pattern="(\[#)(\S+?)(\])(.+?)(\[\/#\])"
	re.Pattern="(\[#)(.[^\[]*)(\])(.[^\[]*)(\[\/#\])"
	content=re.Replace(content,"$4")
	deTitleUBB=content
End Function 

'引用回复清除特殊功能帖的UBB text
Function FilterUBB(content)
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="(\[points=*([0-9]*)\])(.|\n)*(\[\/points\])"
	content=re.Replace(content,"")
	re.Pattern="(\[score=*([0-9]*)\])(.|\n)*(\[\/score\])"
	content=re.Replace(content,"")
	re.Pattern="(\[iworks=*([0-9]*)\])(.|\n)*(\[\/iworks\])"
	content=re.Replace(content,"")
	re.Pattern="(\[article=*([0-9]*)\])(.|\n)*(\[\/article\])"
	content=re.Replace(content,"")
	re.Pattern="(\[logins=*([0-9]*)\])(.|\n)*(\[\/logins\])"
	content=re.Replace(content,"")
	re.Pattern="(\[umoney=*([0-9]*)\])(.|\n)*(\[\/umoney\])"
	content=re.Replace(content,"")
	re.Pattern="(\[name=(.[^\[]*)\])(.|\n)*(\[\/name\])"
	content=re.Replace(content,"")
	re.Pattern="(\[unhide=(.[^\[]*)\])(.|\n)*(\[\/unhide\])"
	content=re.Replace(content,"")
	re.Pattern="(\[view=reply\])(.|\n)*(\[\/view\])"
	content=re.Replace(content,"")
	re.Pattern="(\[view=master\])(.|\n)*(\[\/view\])"
	content=re.Replace(content,"")
	re.Pattern="(\[view=bmaster\])(.|\n)*(\[\/view\])"
	content=re.Replace(content,"")
	re.Pattern="(\[view=suser\])(.|\n)*(\[\/view\])"
	content=re.Replace(content,"")
	re.Pattern="(\[view=founduser\])(.|\n)*(\[\/view\])"
	content=re.Replace(content,"")
	set re=Nothing
	FilterUBB=content
End Function

'编辑更新添加回隐藏文字
Function addUBBunhide(content,oldcontent)
	dim re,Matches,hide_Text,subMatch 
	Set re=new RegExp
	re.IgnoreCase =True 
	re.Global=true
	if	inStr(lcase(oldcontent),"[unhide=")>0 and _
		inStr(lcase(oldcontent),"[/unhide]")>0 and _
		inStr(lcase(content),"[/unhide]")>0 and _
		inStr(lcase(content),"[/unhide]")>0 _
		then
		're.Pattern="(\[unhide=(\S+?)\])(.+?)(\[\/unhide\])" 必须server htmlencode才可用
		re.Pattern="(\[unhide=(.[^\[]*)\])((.|\n)*)(\[\/unhide\])" '5.1
		Set Matches = re.Execute(oldcontent)  
		Set subMatch = Matches(0)
		hide_Text=subMatch.SubMatches(2)  
		re.Pattern="(\[unhide=("&subMatch.SubMatches(1)&")\])(\[hide_Text\])(\[\/unhide\])"
		content=re.Replace(content,"$1"&hide_Text&"$4")
	end if
	set re=Nothing
	addUBBunhide=content
	'多段识别上还不行
End Function 

Function FilterUBBunhide(content)
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	're.Pattern="(\[unhide=(\S+?)\])(.+?)(\[\/unhide\])"
	re.Pattern="(\[unhide=(.[^\[]*)\])(.|\n)*(\[\/unhide\])"
	content=re.Replace(content,"$1[hide_Text]$4")
	set re=Nothing
	FilterUBBunhide=content
End Function

Function Juncode(byVal iStr)
	if SQLserver then Juncode=iStr : exit function end if 
	if isNull(iStr) or isEmpty(iStr) then
		Juncode=""
		Exit function
	end if
	dim F,i,E
		E=array("Jn0;","Jn1;","Jn2;","Jn3;","Jn4;","Jn5;","Jn6;","Jn7;","Jn8;","Jn9;","Jn10;","Jn11;","Jn12;","Jn13;","Jn14;","Jn15;","Jn16;","Jn17;","Jn18;","Jn19;","Jn20;","Jn21;","Jn22;","Jn23;","Jn24;","Jn25;")
		'F=array("ゴ","ガ","ギ","グ","ゲ","ザ","ジ","ズ","ヅ","デ","ド","ポ","ベ","プ","ビ","パ","ヴ","ボ","ペ","ブ","ピ","バ","ヂ","ダ","ゾ","ゼ")
		F=array(chr(-23116),chr(-23124),chr(-23122),chr(-23120),_
				chr(-23118),chr(-23114),chr(-23112),chr(-23110),_
				chr(-23099),chr(-23097),chr(-23095),chr(-23075),_
				chr(-23079),chr(-23081),chr(-23085),chr(-23087),_
				chr(-23052),chr(-23076),chr(-23078),chr(-23082),_
				chr(-23084),chr(-23088),chr(-23102),chr(-23104),_
				chr(-23106),chr(-23108))
		Juncode=iStr
	for i=0 to 25
		Juncode=replace(Juncode,E(i),F(i))'□
	next
End Function

Function Jencode(byVal iStr)
	if SQLserver then Jencode=iStr : exit function end if 
	if isNull(iStr) or isEmpty(iStr) then
		Jencode=""
		Exit function
	end if
	dim F,i,E
		E=array("Jn0;","Jn1;","Jn2;","Jn3;","Jn4;","Jn5;","Jn6;","Jn7;","Jn8;","Jn9;","Jn10;","Jn11;","Jn12;","Jn13;","Jn14;","Jn15;","Jn16;","Jn17;","Jn18;","Jn19;","Jn20;","Jn21;","Jn22;","Jn23;","Jn24;","Jn25;")
		F=array(chr(-23116),chr(-23124),chr(-23122),chr(-23120),_
				chr(-23118),chr(-23114),chr(-23112),chr(-23110),_
				chr(-23099),chr(-23097),chr(-23095),chr(-23075),_
				chr(-23079),chr(-23081),chr(-23085),chr(-23087),_
				chr(-23052),chr(-23076),chr(-23078),chr(-23082),_
				chr(-23084),chr(-23088),chr(-23102),chr(-23104),_
				chr(-23106),chr(-23108))
		Jencode=iStr
		'搜索开启或注册编码
		for i=0 to 25
			Jencode=replace(Jencode,F(i),E(i))'□
		next
End Function
%>