<%Const MaxLoopcount=100%>
<script language=vbscript runat=server>
Class BBS94KKubb_Cls
	Public UbbString,Re
	Private Sub Class_Initialize()
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
	End Sub
	Private Sub class_terminate()
		Set Re=Nothing
	End Sub
	
	Rem 入口(内容，1=帖子|2=留言公告等)
	Public Function Ubb(Str,PostType)
		If isNull(Str) or Str="" then
			Ubb=""
			Exit function
		End if
		If UbbString="" Or IsNull(UbbString) Then
			UbbString=BBS94KK.Fun.UbbString(Str)
		End If
		If instr(UbbString,",41,")>0 And PostType=1 Then
			Str=BBS94KK_HtmlCode(Str,PostType)
		Else
			Str=BBS94KK_UBB(str,postType)
		End If
		UBB=Str
	End Function
	
	Private Function BBS94KK_UBB(Str,PostType)
	Dim Temp
		If isNull(Str) or Str="" then
			BBS94KK_UBB=""
			Exit function
		End if
		Str=Html_Code(Str)
		If InStr(UbbString,",no,")>0 Then
		'Str = server.htmlencode(Str)
		BBS94KK_UBB="<form><div style='border:solid 1px #6D683D;background-color:#AAA'><span style='line-height:22px'><b>此帖内容含有错误标记：</b></span><div style='text-align :center;'><textarea style='border:solid 1px #EEE;width:99%;' name='dbg' rows='10' id='dbgno'>" & text_encode(Str) & "</textarea></div> <div style='float:right;text-align :right'><img src='Images/plus.gif' style='cursor:pointer' onclick=""code_Size(5,document.getElementById('dbgno'))"" alt='增加编辑框的高度' /> <img src='Images/minus.gif' style='cursor:pointer' onclick=""code_Size(-5,document.getElementById('dbgno'))"" alt='减小输入框的高度' />&nbsp; &nbsp;</div><div><input type='button' class='button' value='运行此代码' style='width:80px' onclick='runit(this.form.dbg)'></div></div></form>"
		Exit Function
		End If
		
		re.Pattern="<img.[^>]*src(=| )(.[^>]*)>"
		str=re.replace(str,"<img src=$2>")
		If InStr(UbbString,",0,")>0 Then
			re.pattern="((javascript:)|(jscript:)|(object)|(js:)|(location.)|(vbscript:)|(vbs:)|(\.value)|(about:)|(file:)|(document.cookie)|(on(mouse|exit|error|click|key|load)))"
			str=re.replace(str,"<span style='color:#000'>$1</span>")
		End If
		If InStr(UbbString,",31,")>0 Then Str=BBS94KK_Ubb1(Str,"\[quote\]","\[\/quote\]","<table cellpadding=0 cellspacing=0 border=1 WIDTH='90%' style='border-collapse: collapse' bordercolor=red align=center><tr><td bgcolor='#f2f8ff'><p style='margin:15'>$1</p></td></tr></table><br>") 
		If InStr(UbbString,",39,")>0 Then Str=BBS94KK_Ubb_Reply(Str,PostType)
		If InStr(UbbString,",40,")>0 Then Str=BBS94KK_Ubb_Buy(Str,PostType)
		If InStr(UbbString,",32,")>0 Then Str=BBS94KK_GetUBB(Str,"\[coin=*([0-9]*)\]","\[\/coin\]","$1<hr noshade size=1><font color=gray>以下内容需要金钱数达到<B>$3</B>才可以浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要金钱数达到<B>$3</B>才可以浏览</font><hr noshade size=1>$6",PostType,32)
		If InStr(UbbString,",33,")>0 Then Str=BBS94KK_GetUBB(Str,"\[mark=*([0-9]*)\]","\[\/mark\]","$1<hr noshade size=1><font color=gray>以下内容需要积分数达到<B>$3</B>才可以浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要积分数达到<B>$3</B>才可以浏览</font><hr noshade size=1>$6",PostType,33)	
		If InStr(UbbString,",35,")>0 Then Str=BBS94KK_Ubb_Login(Str,PostType)
		If InStr(UbbString,",36,")>0 Then Str=BBS94KK_Ubb_Sex(Str,PostType)
		If InStr(UbbString,",37,")>0 Then Str=BBS94KK_Ubb_Name(Str,PostType)
		If InStr(UbbString,",38,")>0 Then Str=BBS94KK_Ubb_Date(Str,PostType)
		If InStr(UbbString,",27,")>0 Then Str=BBS94KK_Ubb2(Str,"\[flash\]","\[\/flash\]","<a href=""$1"" TARGET=_blank><IMG SRC='Pic/FileType/swf.gif' border='0' alt='点击开新窗口欣赏该FLASH动画!' />[全屏欣赏]</a><br><OBJECT codeBase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0' classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' width='500' height='400'><PARAM name='movie' VALUE=""$1""><PARAM name='quality' VALUE=high><embed src=""$1"" quality='high' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='500' height='400'>$2</embed></OBJECT>","<a href=""$1"" target='_blank'><img src=Pic/FileType/swf.gif border=0>[此处含有一FLASH动画，点击观看]</A>",BBS94KK.Info(66)) 
		If InStr(UbbString,",7,")>0 Then Str=BBS94KK_Ubb1(Str,"\[b\]","\[\/b\]","<b>$1</b>")
		If InStr(UbbString,",8,")>0 Then Str=BBS94KK_Ubb1(Str,"\[i\]","\[\/i\]","<i>$1</i>")
		If InStr(UbbString,",9,")>0 Then Str=BBS94KK_Ubb1(Str,"\[u\]","\[\/u\]","<u>$1</u>")
		If InStr(UbbString,",10,")>0 Then Str=BBS94KK_Ubb1(Str,"\[sup\]","\[\/sup\]","<sup>$1</sup>")
		If InStr(UbbString,",11,")>0 Then Str=BBS94KK_Ubb1(Str,"\[sub\]","\[\/sub\]","<sub>$1</sub>")
		If InStr(UbbString,",12,")>0 Then Str=BBS94KK_Ubb1(Str,"\[color=((#.{6})|.{3,6})\]","\[\/color\]","<font color=$1>$3</font>") 
		If InStr(UbbString,",13,")>0 Then Str=BBS94KK_Ubb1(Str,"\[url=(.{5,}?)\]","\[\/url\]","<a href=""$1"" target='_blank'>$2</a>") 
		If InStr(UbbString,",14,")>0 Then Str=BBS94KK_Ubb1(Str,"\[right\]","\[\/right\]","<div align=right>$1</div>")	
		If InStr(UbbString,",15,")>0 Then Str=BBS94KK_Ubb1(Str,"\[light\]","\[\/light\]","<span style=""behavior:url(inc/font.htc)"">$1</span>") 
		If InStr(UbbString,",17,")>0 Then Str=BBS94KK_Ubb1(Str,"\[size=([1-7])\]","\[\/size\]","<font size=$1>$2</font>") 
		If InStr(UbbString,",18,")>0 Then Str=BBS94KK_Ubb1(Str,"\[dir=([0-9]{1,3}),([0-9]{1,3})\]","\[\/dir\]","<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>") 
		If InStr(UbbString,",19,")>0 Then Str=BBS94KK_Ubb1(Str,"\[fly\]","\[\/fly\]","<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>") 
		If InStr(UbbString,",21,")>0 Then Str=BBS94KK_Ubb1(Str,"\[align=(center|left|right)\]","\[\/align\]","<div align=$1>$2</div>") 
		If InStr(UbbString,",22,")>0 Then Str=BBS94KK_Ubb1(Str,"\[shadow=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\]","\[\/shadow\]","<table width=$1 ><tr><td style=""filter:shadow(color=$2, stregExngth=$3)"">$4</td></tr></table>") 
		If InStr(UbbString,",23,")>0 Then Str=BBS94KK_Ubb1(Str,"\[sound\]","\[\/sound\]","<a href=""$1"" target=_blank><IMG SRC=Pic/FileType/mid.gif border=0 alt='背景音乐'></a><bgsound src=""$1"" loop=""-1"">")
		If InStr(UbbString,",24,")>0 Then Str=BBS94KK_Ubb2(Str,"\[img\]","\[\/img\]","<img src=$1>","<a href=$1 target=_blank>$1</a>",BBS94KK.Info(65)) 
		Str=JsImg(Str,550)
		If InStr(UbbString,",16,")>0 Then re.pattern="\[em*([0-9]*)]":str=re.replace(str,"<img src=pic/emot/em$1.gif>")
		If InStr(UbbString,",25,")>0 Then
			If BBS94KK.Info(39)="1" Then
				Temp="<fieldset><legend>上传的动画</legend><br><img src='Pic/FileType/$1.gif' align='absmiddle' /> <A HREF=""ViewFile.asp?FileName=$5"" TARGET=""_blank"">$5</a> [ <font color=blue>$2</font> KB ] <font color=""#999999"">(缩略时请点打开新窗口)</font><br><br>&nbsp;&nbsp;<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,19,0"" width=""480"" height=""400""><param name=""movie"" value="""&BBS94KK.Info(36)&"/$5"" /><param name=""quality"" value=""high"" /><embed src="""&BBS94KK.Info(36)&"/$5"" quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""480"" height=""400""></embed></object><br><br></fieldset>"
			Else
				Temp="<param name=""movie"" value="""&BBS94KK.Info(36)&"$5"" /><param name=""quality"" value=""high"" /><embed src="""&BBS94KK.Info(36)&"/$5"" quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""480"" height=""400""></embed></object>"
			End If
			Str=BBS94KK_Ubb2(Str,"\[upload=(swf|swi),*(#*[0-9\.]*),0,*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]",Temp,"<A HREF=""ViewFile.asp?FileName=$6"" TARGET='_blank'><img src='Pic/FileType/swf.gif' border=0 alt='动画文件' />[此处含有一FLASH动画，点击观看]</a>",BBS94KK.Info(66)) 
			IF BBS94KK.Info(39)="1" Then
				Temp="<fieldset><legend>上传的图片</legend><br>&nbsp;<img src='Pic/FileType/$1.gif' align='absmiddle' /> <A HREF=""ViewFile.asp?FileName=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB <font color=blue>$4</font>×<font color=blue>$5</font> ] <font color=#999999>(缩略时请点击查看原图)</font><br><br>&nbsp;<img useMap=""#Map"" SRC=""ViewFile.asp?FileName=$6"" border=""0"" width=""$3"" /><br><br></fieldset>"
			Else
				Temp="<A HREF=""ViewFile.asp?FileName=$6"" TARGET=_blank>$6</a><img useMap=""#Map"" SRC=""ViewFile.asp?FileName=$6"" border=""0"" width=""$3"" /></a>"
			End If
			Str=BBS94KK_Ubb2(Str,"\[upload=("&BBS94KK.Info(35)&"),*(#*[0-9\.]*),([0-9]{1,3}),*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]",Temp,"<A HREF=""ViewFile.asp?FileName=$6"" TARGET=_blank>$6</a>",BBS94KK.Info(65)) 
			If BBS94KK.Info(39)="1" Then
				Temp="<fieldset><legend>上传的附件</legend><br>&nbsp;&nbsp;<IMG SRC=Pic/FileType/$1.gif align=absmiddle> <a href=""ViewFile.asp?FileName=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB ]<br><br></fieldset>"
			Else
				Temp="<IMG SRC=Pic/FileType/$1.gif align=absmiddle> <a href=""ViewFile.asp?FileName=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB ]"
			End If
			Str=BBS94KK_Ubb3(Str,"\[upload=("&BBS94KK.Info(34)&"),*(#*[0-9\.]*),*(#*[0-9\.]*),*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]",Temp)
		End If
		If InStr(UbbString,",20,")>0 Then Str=BBS94KK_Ubb1(Str,"\[move\]","\[\/move\]","<MARQUEE scrollamount=3>$1</marquee>") 
		If InStr(UbbString,",26,")>0 Then
			re.pattern="\[EMAIL\]([^\s@]+@[^\.]+\..+?)\[\/EMAIL\]"
			str=re.replace(str,"<a href=""mailto:$1"" target='_blank'>$1</a>")
			re.pattern="\[EMAIL=([^\s@]+@[^\.]+?\..+?)\](.+?)\[\/EMAIL\]"
			str=re.replace(str,"<a href=""mailto:$1"" target='_blank'>$2</a>")
		End If
		If InStr(UbbString,",30,")>0 Then Str=BBS94KK_Ubb1(Str,"\[ra\]","\[\/ra\]","<b>这个是 RealPlayer 音乐：</b><br><object classid=clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=280 height=70><param name=_ExtentX value=7938><param name=_ExtentY value=2646><param name=AUTOSTART value=0><param name=SHUFFLE value=0><param name=PREFETCH value=0><param name=NOLABELS value=0><param name=LOOP value=0><param name=NUMLOOP value=0><param name=CENTER value=0><param name=MAINTAINASPECT value=0><param name=BACKGROUNDCOLOR value=#000000><PARAM NAME=SRC VALUE=$1></object>") 
		If InStr(UbbString,",42,")>0 Then Str=BBS94KK_Ubb1(Str,"\[face=(.[^\[]*)\]","\[\/face\]","<font face=""$1"">$2</font>") 
		If InStr(UbbString,",28,")>0 Then Str=BBS94KK_Ubb1(Str,"\[mp=([0-9]{1,3}),([0-9]{1,3})\]","\[\/mp\]","<br><b>此主题相关媒体如下：<a href=""$3"" TARGET='_blank'>(点这里下载)</a></b><br><object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=$1 height=$2 >" & vbcrlf & "<param name=ShowStatusBar value=-1>" & vbcrlf & "<param name=Filename value=""$3"">" & vbcrlf & "<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>" & vbcrlf & "</embed>" & vbcrlf & "</object>") 
		If InStr(UbbString,",29,")>0 Then Str=BBS94KK_Ubb1(Str,"\[rm=*([0-9]*),*([0-9]*)\]","\[\/rm\]","<b>此主题相关媒体如下：<a href=""$3"" TARGET='_blank'>(点这里下载)</a></b><br><OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2>" & vbcrlf & "<PARAM NAME=SRC VALUE=$3>" & vbcrlf & "<PARAM NAME=CONSOLE VALUE=Clip1>" & vbcrlf & "<PARAM NAME=CONTROLS VALUE=imagewindow>" & vbcrlf & "<PARAM NAME=AUTOSTART VALUE=false>" & vbcrlf & "</OBJECT>" & vbcrlf & "<br>" & vbcrlf & "<OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=video2 width=$1>" & vbcrlf & "<PARAM NAME=SRC VALUE=$3>" & vbcrlf & "<PARAM NAME=AUTOSTART VALUE=0>" & vbcrlf & "<PARAM NAME=CONTROLS VALUE=controlpanel>" & vbcrlf & "<PARAM NAME=CONSOLE VALUE=Clip1>" & vbcrlf & "</OBJECT>") 

		If BBS94KK.Info(82)="1" Then
		Rem	 自动识别网址
			If  InStr(UbbString,",2,")>0 Or InStr(UbbString,",3,")>0 Or InStr(UbbString,",4,")>0 Or InStr(UbbString,",5,")>0 Or InStr(UbbString,",6,")>0 Then
				re.Pattern = "^((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)"
				str = re.Replace(str,"<a target=_blank href=""$1"">$1</a>")
				re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)$([^\[]*)"
				
				str = re.Replace(str,"<a target=_blank href=""$1"">$1</a>")
				re.Pattern = "(^|[^<=""])((http|ftp):(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&amp;)|&)+)"
				str = re.Replace(str,"$1<a target=_blank href=""$2"">$2</a>")
			End If
			Rem 自动识别www等开头的网址
			If InStr(UbbString,",1,")>0  Then
				re.Pattern = "([\s])((www|cn)[.](\w)+[.]{1,}(net|com|cn|org|cc)(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)"
				str = re.Replace(str,"<a target=_blank href=""http://$2"">$2</a>")
			End If
		End If
		BBS94KK_UBB=Str
	End function
	
	Private Function JsImg(str,MaxSize)
		Dim s
		s=str
		re.Pattern="<img(.[^>]*)>"
			s=re.replace(s,"<img$1 onload=""return imgzoom(this,"&MaxSize&")"" border=0  onclick=""javascript:window.open(this.src);"" style=""cursor: pointer"" useMap=#Map>")
		JsImg=s
	End Function
	
	Private Function Html_Code(byval Str)
		If IsNull(Str) then
			 Html_code=""
		Else
			re.Pattern="(>)"&chr(13)&chr(10)&"(<)"
			Str=re.Replace(Str,"$1$2")	
			re.Pattern="(>)"&chr(13)&"(<)"
			Str=re.Replace(Str,"$1$2")
			re.Pattern="(>)"&chr(10)&"(<)"
			Str=re.Replace(Str,"$1$2")
			Str=replace(Str, chr(13)&chr(10), "<br>")
			Str=replace(Str, chr(13), "<br>")
			Str=replace(Str, chr(10), "<br>")
			Str=replace(Str, "  ", "&nbsp;&nbsp;")
			Html_Code=Str
		End if
	End Function
	Public Function Sign_Code(byval Str)
		If IsNull(Str) or Str="" Then
			Sign_Code=""
			Exit Function
		End If
		Str=Html_Code(Str)
		re.pattern="((javascript:)|(jscript:)|(object)|(js:)|(location.)|(vbscript:)|(vbs:)|(\.value)|(about:)|(file:)|(document.cookie)|(on(mouse|exit|error|click|key|load)))"
		str=re.replace(str,"<font color='#000000'>$1</font>")
		If InStr(Lcase(Str),"[/b]")>0 Then Str=BBS94KK_Ubb1(Str,"\[b\]","\[\/b\]","<b>$1</b>")
		If InStr(Lcase(Str),"[/i]")>0 Then Str=BBS94KK_Ubb1(Str,"\[i\]","\[\/i\]","<i>$1</i>")
		If InStr(Lcase(Str),"[/u]")>0 Then Str=BBS94KK_Ubb1(Str,"\[u\]","\[\/u\]","<u>$1</u>")
		If InStr(Lcase(Str),"[/color]")>0 Then Str=BBS94KK_Ubb1(Str,"\[color=((#.{6})|.{3,6})\]","\[\/color\]","<font color=#$1>$3</font>") 
		If InStr(Lcase(Str),"[/url]")>0 Then Str=BBS94KK_Ubb1(Str,"\[url=(.{5,}?)\]","\[\/url\]","<a href=""$1"" target='_blank'>$2</a>") 
		If InStr(Lcase(Str),"[/right]")>0 Then Str=BBS94KK_Ubb1(Str,"\[right\]","\[\/right\]","<div align=right>$1</div>")	
		If InStr(Lcase(Str),"[/light]")>0 Then Str=BBS94KK_Ubb1(Str,"\[light\]","\[\/light\]","<span style=""behavior:url(inc/font.htc)"">$1</span>") 
		If InStr(Lcase(Str),"[em")>0 Then re.pattern="\[em*([0-9]*)]":str=re.replace(str,"<img src=pic/emot/em$1.gif>")
		If InStr(Lcase(Str),"[/size]")>0 Then Str=BBS94KK_Ubb1(Str,"\[size=([1-7])\]","\[\/size\]","<font size=$1>$2</font>") 
		If InStr(Lcase(Str),"[/fly]")>0 Then Str=BBS94KK_Ubb1(Str,"\[fly\]","\[\/fly\]","<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>") 
		If InStr(Lcase(Str),"[/move]")>0 Then Str=BBS94KK_Ubb1(Str,"\[move\]","\[\/move\]","<MARQUEE scrollamount=3>$1</marquee>") 
		If InStr(Lcase(Str),"[/aling]")>0 Then Str=BBS94KK_Ubb1(Str,"\[align=(center|left|right)\]","\[\/align\]","<div align=$1>$2</div>") 
		If InStr(Lcase(Str),"[/shadow]")>0 Then Str=BBS94KK_Ubb1(Str,"\[shadow=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\]","\[\/shadow\]","<table width=$1 ><tr><td style=""filter:shadow(color=$2, stregExngth=$3)"">$4</td></tr></table>") 
		If InStr(Lcase(Str),"[/sound]")>0 Then Str=BBS94KK_Ubb1(Str,"\[sound\]","\[\/sound\]","<a href=""$2"" target=_blank><IMG SRC=Pic/FileType/mid.gif border=0 alt='背景音乐'></a><bgsound src=""$2"" loop=""-1"">") 
		If InStr(Lcase(Str),"[/img]")>0 Then Str=BBS94KK_Ubb2(Str,"\[img\]","\[\/img\]","<img border=""0"" src=""$1""  />","<a href=$1 target=_blank>$1</a>",BBS94KK.Info(65)) 
		If InStr(Lcase(Str),"[/email]")>0 Then
			re.pattern="\[EMAIL\]([^\s@]+@[^\.]+\..+?)\[\/EMAIL\]"
			str=re.replace(str,"<a href=""mailto:$1"" target='_blank'>$1</a>")
			re.pattern="\[EMAIL=([^\s@]+@[^\.]+?\..+?)\](.+?)\[\/EMAIL\]"
			str=re.replace(str,"<a href=""mailto:$1"" target='_blank'>$2</a>")
		End If
		Str=JsImg(Str,550)
		Sign_Code=Str
	End Function
	
	Private Function text_encode(byval str)
		If isnull(str) then
			text_encode=""
		Else
			re.Pattern="(<br></p>)"
			're.Pattern="(<\/p>"&vbNewLine&"<P>)"
			Str=re.Replace(Str,chr(10))
			re.Pattern="(<br>|<p><\/p>|<p>|<\/p>)"
			Str=re.Replace(Str,chr(10))
			text_encode=replace(str,"&nbsp;"," ")
		End if
	End function
	Private Function BBS94KK_Ubb1(Str,uCodeL,uCodeR,tCode)
		Dim s
		s=str
		re.Pattern=uCodeL&uCodeR
		s=re.Replace(s,"")
		re.Pattern=uCodeL&"(.+?)"&uCodeR
		s=re.Replace(s,tCode)
		re.Pattern=uCodeL
		s=re.Replace(s,"")
		re.Pattern=uCodeR
		s=re.Replace(s,"")
		BBS94KK_Ubb1=s
	End Function
	Private Function BBS94KK_Ubb3(Str,uCodeL,uCodeR,tCode)
		Dim s
		s=str
		re.Pattern=uCodeL&uCodeR
		s=re.Replace(s,"")
		re.Pattern=uCodeL&"(.+?)"&uCodeR
		s=re.Replace(s,tCode)
		re.Pattern=uCodeL
		s=re.Replace(s,"")
		re.Pattern=uCodeR
		s=re.Replace(s,"")
		BBS94KK_Ubb3=s
	End Function
	
	Private Function BBS94KK_Ubb2(Str,uCodeL,uCodeR,tCode1,tCode2,BBSCheck)
		Dim s
		s=str
		re.Pattern=uCodeL&uCodeR
		s=re.Replace(s,"")
		re.Pattern=uCodeL&"(.+?)"&uCodeR
		If BBScheck="1" Then
		s=re.Replace(s,tCode1)
		Else
		s=re.Replace(s,tCode2)
		End If
		BBS94KK_Ubb2=s
	End Function

	Private Function BBS94KK_HtmlCode(Str,PostType)
		dim ary_String,i,n,n_pos
		ary_String=split(Str,"[code]")
		n=ubound(ary_String)
		If n<1 then
			BBS94KK_HtmlCode=BBS94KK_UBB(Str,PostType)
			Exit function
		End If
		ary_String(0)=BBS94KK_UBB(ary_String(0),postType)
		for i=1 to n
			n_pos=inStr(ary_String(i),"[/code]")
			If n_pos>0 then
				ary_String(i)="<form><div style='border:solid 1px #6D683D;background-color:#AAA'><div style='text-align :center;'><textarea style='border:solid 1px #EEE;width:99%;' name='dbg' rows='10' id='dbg"&i&"'>" & text_encode(left(ary_String(i),n_pos-1)) & "</textarea></div> <div style='float:right;text-align :right'><img src='Images/plus.gif' style='cursor:pointer' onclick=""code_Size(5,document.getElementById('dbg"&i&"'))"" alt='增加编辑框的高度' /> <img src='Images/minus.gif' style='cursor:pointer' onclick=""code_Size(-5,document.getElementById('dbg"&i&"'))"" alt='减小输入框的高度' />&nbsp; &nbsp;</div><div><input type='button' class='button' value='运行此代码' style='width:80px' onclick='runit(this.form.dbg)'> <input type='button' class='button' value='复制到剪贴板' style='width:90px' onclick='copyit(this.form.dbg)'> <input type='button' class='button' value='代码另存为' style='width:80px' onclick='saveAs(this.form.dbg)'></div></div></form>" & BBS94KK_UBB(right(ary_String(i),len(ary_String(i))-n_pos-6),PostType)

			Else
				ary_String(i)="[code]" & BBS94KK_UBB(ary_String(i),PostType)
			End if
		next
		BBS94KK_HtmlCode=join(ary_String,"")
	End Function
	
	Rem 入口（内容,开始的UBB，结束的UBB，显示允许，显示不允许，标记：1=帖子/2=留言公告，类型）
	Private Function BBS94KK_GetUBB(Str,uCodeL,uCodeR,tCode1,tCode2,postType,Btype)
		Dim Test
		Dim po,ii
		Dim LoopCount
		Dim MyInfo
		LoopCount=0
		Do While True
			re.Pattern=uCodeL
			Test=re.Test(Str)
			If Test Then
				re.Pattern=uCodeR
				Test=re.Test(Str)
				If Test Then
					If PostType=1 Then
						re.Pattern="(^.*)("&uCodeL&")(.+?)("&uCodeR&")(.*)"
						po=re.Replace(Str,"$3")
						If  IsNumeric(po) Then
							ii=int(po) 
						Else
							ii=0
						End If 
						If Not BBS94KK.Founduser Then
							Str=re.Replace(str,tCode2)
						Else
							Select Case BType
							Case 32
							MyInfo=Session(CacheName & "MyInfo")(7)
							Case 33
							MyInfo=Session(CacheName & "MyInfo")(6)
							Case 34
							MyInfo=Session(CacheName & "MyInfo")(15)
							End Select
							If Lcase(BBS94KK.MyName)=Lcase(UserName) or int(MyInfo)>=int(ii) or Session(CacheName&"MyGradeInfo")(39)="1" or BBS94KK.IsBoardAdmin Then
								Str=re.Replace(str,tCode1)
							Else
								Str=re.Replace(str,tCode2)
							End If
						End If
					Else
						re.Pattern="("&uCodeL&")(.+?)("&uCodeR&")"
						s=re.Replace(s,"$3")
					End If 
				Else
					Exit Do
				End If 
			Else
				Exit Do
			End If
			LoopCount=LoopCount + 1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		BBS94KK_GetUBB=Str
	End Function
	Private Function BBS94KK_Ubb_Login(Str,PostType)
		Dim Test
		Dim LoopCount
		LoopCount=0
		Do While True
			re.Pattern="\[login\]"
			Test=re.Test(Str)
			If Test Then
				re.Pattern="\[\/login\]"
				Test=re.Test(Str)
				If Test Then
					re.Pattern="(^.*)(\[login\])(.+?)(\[\/login\])(.*)"
					If BBS94KK.FoundUser Then
						Str=re.Replace(str,"$1<hr size=1><font color=#A2A2A2>此帖内容<b>必须登陆</b>后才能浏览</font><BR>$3</font><hr size=1>$5")
					Else
						Str=re.Replace(str,"$1<hr size=1><font color=Red>此帖内容<b>必须<a href=login.asp>登陆</a></b>后才能浏览<BR></font><hr size=1>$5")
					End if
				Else
					Exit Do
				End If 
			Else
				Exit Do
			End If
			LoopCount=LoopCount + 1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		BBS94KK_Ubb_Login=Str
	End Function
	Private Function BBS94KK_Ubb_Sex(Str,PostType)
		Dim Test
		Dim LoopCount
		Dim Tmp_Str,po
		LoopCount=0
		Do While True
			re.Pattern="\[sex=*([0-1]*)\]"
			Test=re.Test(Str)
			If Test Then
				re.Pattern="\[\/sex\]"
				Test=re.Test(Str)
				If Test Then
					re.Pattern="(^.*)(\[sex=*([0-1]*)\])(.+?)(\[\/sex\])(.*)"
					If PostType=1 Then
						po=re.replace(str,"$3")
						If isnumeric(po) then
							If int(po)=0 then Tmp_Str="女"
							If int(po)=1 then Tmp_Str="男"
							If Not BBS94KK.FoundUser Then
								str=re.Replace(str,"$1<hr size=1><font color=Red>此内容需要性别为<font color=red> <b>"&Tmp_Str&"</b></font> 和作者才能浏览：</font><BR><hr size=1>$6")
							Else
							If (Session(CacheName & "MyInfo")(3)="1" And int(po)=1) or (Session(CacheName & "MyInfo")(3)="0" And int(po)=0) or Lcase(BBS94KK.MyName)=Lcase(UserName) Then
								str=re.Replace(str,"$1<hr size=1><font color=#A2A2A2>此内容需要性别为<font color=red> <b>"&Tmp_Str&"</b></font> 和作者才能浏览：</font><BR>$4<hr size=1>$6")
							Else
								str=re.Replace(str,"$1<hr size=1><font color=Red>此内容需要性别为<font color=red> <b>"&Tmp_Str&"</b></font> 和作者才能浏览：</font><BR><hr size=1>$6")
							End If
							End If
						End if
					Else
						Str=re.Replace(str,"$4")
					End If
				Else
					Exit Do
				End If 
			Else
				Exit Do
			End If
			LoopCount=LoopCount + 1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		BBS94KK_Ubb_Sex=Str
	End Function
	Private Function BBS94KK_Ubb_Name(Str,PostType)
		Dim Test
		Dim LoopCount
		Dim Tmp_My,tmp_str,I
		LoopCount=0
		Do While True
			re.Pattern="\[username=(.[^\[]*)\]"
			Test=re.Test(Str)
			If Test Then
				re.Pattern="\[\/username\]"
				Test=re.Test(Str)
				If Test Then
					re.Pattern="(^.*)(\[username=(.[^\[]*)\])(.+?)(\[\/username\])(.*)"
					If PostType=1 Then
						Tmp_Str=re.replace(str,"$3")
						Tmp_Str=split(Tmp_Str,",")
						Tmp_My=False
						For i=0 to ubound(Tmp_Str)
							If lcase(BBS94KK.MyName)=lcase(Tmp_Str(i)) then Tmp_My=True:Exit For
						Next
						If Tmp_My or Lcase(BBS94KK.MyName)=Lcase(UserName) Then
							Str=re.Replace(str,"$1<hr size=1><font color=#A2A2A2>此内容只有作者和 <b>$3</b> 能浏览：</font><BR>$4<hr size=1>$6")
						Else
							Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和 <b>$3</b> 能浏览：</font><BR><hr size=1>$6")
						End if
					Else
						Str=re.Replace(str,"$4")
					End If
				Else
					Exit Do
				End If 
			Else
				Exit Do
			End If
			LoopCount=LoopCount + 1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		BBS94KK_Ubb_Name=Str
	End Function
	
	Private Function BBS94KK_Ubb_Reply(Str,PostType)
		Dim Test
		Dim LoopCount
		LoopCount=0
		Do While True
			re.Pattern="\[reply\]"
			Test=re.Test(Str)
			If Test Then
				re.Pattern="\[\/reply\]"
				Test=re.Test(Str)
				If Test Then
					re.Pattern="(^.*)(\[reply\])((.|\n)+?)(\[\/reply\])(.*)"
					IF PostType=1 Then
						If Not BBS94KK.FoundUser Then
							str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和已经回复此帖的浏览者能浏览：</font><BR><hr size=1>$6")
						Else
							If SESSION(CacheName& "MyGradeInfo")(36)="1" or Lcase(BBS94KK.MyName)=Lcase(UserName) or Not BBS94KK.execute("select BbsID From[KK_bbs"&BBS94KK.TB&"] where ReplyTopicID="&ID&" and name='"&BBS94KK.MyName&"'").eof then
								str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和已经回复此帖的浏览者能浏览：</font><BR>$3<hr size=1>$6")
							Else
								str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和已经回复此帖的浏览者能浏览：</font><BR><hr size=1>$6")
							End if
						End If
					Else
						str=re.Replace(str,"$3")
					End If
				Else
					Exit Do
				End If 
			Else
				Exit Do
			End If
			LoopCount=LoopCount + 1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		BBS94KK_Ubb_Reply=Str
	End Function
	Private Function BBS94KK_Ubb_Date(Str,PostType)
		Dim Tmp_int,Tmp_My,tmp_str
		Dim Test
		Dim LoopCount
		LoopCount=0
		Do While True
			re.Pattern="\[date=(.[^\[]*)\]"
			Test=re.Test(Str)
			If Test Then
				re.Pattern="\[\/date\]"
				Test=re.Test(Str)
				If Test Then	
					re.Pattern="(^.*)(\[date=(.[^\[]*)\])(.+?)(\[\/date\])(.*)"
					IF PostType=1 Then
						Tmp_Str=re.replace(str,"$3")
						If IsDate(Tmp_Str) Then Tmp_Int=Datediff("d",cdate(Tmp_Str),cdate(BBS94KK.NowBbsTime)) Else Tmp_Int=-1
						If int(Tmp_Int)>0 Then
							Str=re.Replace(Str,"$1<hr size=1><font color=Red>此内容只有：<b>"&Tmp_Str&"</b>这天以后才能浏览：</font><BR>$4<hr size=1>$6")
						Else
							Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有：<b>"&Tmp_Str&"</b>这天以后才能浏览：</font><BR><hr size=1>$6")
						End If
					Else
						Str=re.Replace(str,"$1")
					End If
				Else
					Exit Do
				End If 
			Else
				Exit Do
			End If
			LoopCount=LoopCount + 1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		BBS94KK_Ubb_Date=Str					
	End Function
	Private Function BBS94KK_Ubb_Buy(Str,PostType)
		Dim Tmp_int,Tmp_My,tmp_str,i,Buy_Rs
		Dim Test
		Dim LoopCount
		LoopCount=0
		Do While True
			re.Pattern="\[buypost=*([0-9]*)\]"
			Test=re.Test(Str)
			If Test Then
				re.Pattern="\[\/buypost\]"
				Test=re.Test(Str)
				If Test Then
					re.Pattern="(^.*)(\[buypost=*([0-9]*)\])(.+?)(\[\/buypost\])(.*)"
					If PostType=1 Then
						If Not BBS94KK.FoundUser Then
							Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容要求金钱数达到$3以上才可以购买并浏览</font><hr noshade size=1>$6")
						Else
							Tmp_My="<Form style='margin:0px;' action='Submit.asp?Action=buy' method='Get'><input type=hidden value="&BbsID&" name='ID'><input type=hidden value="&BBS94KK.TB&" name='TB'><input type=submit  value='好黑啊…我…我买了！'></form>"
							Tmp_Int=re.Replace(str,"$3")
							If isnumeric(Tmp_Int) Then Tmp_Int=int(Tmp_Int) Else Tmp_Int=0
							Tmp_Str=""
							If BBSID<>0 Then
								Set Buy_Rs=BBS94KK.execute("select Username From[KK_Buyer] where BbsID="&BbsID)
								If Not Buy_Rs.Eof Then
									Tmp_Str=Buy_Rs(0)
								End If
								Buy_Rs.close
								Set Buy_Rs=Nothing
							End If
							If Lcase(BBS94KK.MyName)=Lcase(UserName) or SESSION(CacheName&"MyGradeInfo")(39)="1" Or BBS94KK.IsBoardAdmin Then
								Dim PostBuyUser
								If Tmp_Str<>"" then
									Tmp_Str=split(Tmp_Str,"|")
									PostBuyUser=""
									For i=0 to ubound(Tmp_Str)
									PostBuyUser=PostBuyUser & "<option value="&i&">"&Tmp_Str(i)&"</option>"
									Next
									PostBuyUser="<select name=buyuser size=1><option value=0>共有"&ubound(Tmp_Str)+1&"位用户购买</option>"&PostBuyUser & "</select>"
								Else
									PostBuyUser="<select name=buyuser size=1><option value=0>还没有用户购买</option></select>"
								End if
								If BBS94KK.MyName<>UserName Then PostBuyUser=Tmp_My&PostBuyUser
								Str=re.Replace(str,"$1<hr size=1><font color=Red>以下为需要金钱数达到<B>$3</B>才能浏览的内容</font>&nbsp;&nbsp;"&PostBuyUser&"<BR>$4<hr size=1>$6")
							Else
								If instr("|"&Tmp_Str&"|","|"&BBS94KK.MyName&"|")>0 then
									Str=re.Replace(str,"$1<hr noshade size=1>以下为需要花 <del><B>$3</B></del> 金钱才能购买并浏览的内容，您已经购买本帖<BR>$4<hr noshade size=1>$6")
								Else
									If Int(Session(CacheName & "MyInfo")(7))>Tmp_Int then
										str=re.Replace(str,"$1<hr size=1><font color=Red>此帖子内容需要您花 <B>$3</B> 金钱来购买浏览&nbsp;&nbsp;"&Tmp_My&"</font><hr size=1>$6")
									Else
										str=re.Replace(str,"$1<hr size=1><font color=Red>此内容要求金钱数达到 <B>$3</B> 以上才可以购买并浏览</font><hr size=1>$6")
									end if
								End if
							End if
						End if
					Else
						Str=re.Replace(str,"$4")
					End If
				Else
					Exit Do
				End If 
			Else
				Exit Do
			End If
			LoopCount=LoopCount + 1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		BBS94KK_Ubb_Buy=Str
	End Function
End Class
</script>