ubb_cls.asp

网趣系统时尚版8（支付宝）

					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
		YxBBs_Ubb_Reply=Str
	End Function

	Private Function YxBBs_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(YxBBs.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
		YxBBs_Ubb_Date=Str					
	End Function

	Private Function YxBBs_Ubb_Buy(Str,PostType)
		Dim Tmp_int,Tmp_My,tmp_str,i
		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 YxBBs.FoundUser Then
							Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容要求金钱数达到$3以上才可以购买并浏览</font><hr noshade size=1>$6")
						Else
							Tmp_My="<Form action='VoteSubmit.Asp?Action=buy' method='Get'><input type=hidden value="&BbsID&" name='ID'><input type=hidden value="&YxBBs.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
							If BBSID=0 Then
							Tmp_Str=""
							Else
							Tmp_Str=YxBBs.execute("select Buyer From[YX_bbs"&YxBBs.TB&"] where BbsID="&BbsID&"")(0)
							End If
							If Lcase(YxBBs.MyName)=Lcase(UserName) or YxBBs.ClassID<=2 Or YxBBs.IsBoardAdmin Then
								Dim PostBuyUser
								If (not isnull(Tmp_Str)) and 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)&"位用户购买</option>"&PostBuyUser & "</select>"
								Else
									PostBuyUser="<select name=buyuser size=1><option value=0>还没有用户购买</option></select>"
								End if
								If YxBBs.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&"|","|"&YxBBs.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(YxBBs.MyCoin)>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
		YxBBs_Ubb_Buy=Str
	End Function

	Function UBBCode_HighLight(Str)
		Dim HighLight
		Set HighLight = New YxBBs_CodeHighLight_Cls
		HighLight.VBCode=Str
		UBBCode_HighLight=HighLight.MakeLi()
		Set HighLight = NoThing
	End Function
End Class

Class YxBBs_CodeHighLight_Cls
	Private RegEx
	Public Keyword,ObjectCommand,Strings,VBCode
	Public KeyWordColor,ObjectCommandColor,StringsColor,Comment,CodeColor

	Private Sub Class_Initialize()
		Set RegEx = New RegExp
		RegEx.IgnoreCase = True
		RegEx.Global = True
		KeyWordColor="#0000FF"
		ObjectCommandColor="#FF0000"
		StringsColor="#FF00FF"
		Comment="#008000"
		CodeColor="#993300"
		Keyword="Set|Private|If|Then|Sub|End|Function|For|Next|Do|While|Wend|True|False|Nothing|Class|Request|Response|Dim|Call|Const|Rnd|To|SELECT|CASE"
		ObjectCommand="Left|Mid|Right|Int|Cint|Clng|String|Join|Array|IsNumeric|Trim|Session|Write|close|open|Server|ubound|split"
		VBCode=""
	End Sub

	Private Sub Class_Terminate()
		Set RegEx = Nothing
	End Sub

	Private Function M_Replace(Str,Pattern,Color)
		RegEx.Pattern = Pattern
		M_Replace=RegEx.Replace(Str,"<font color="&Color&">$1</font>")
	End Function

	Private Function String_Replace(Str,Pattern,Pattern1,Color,IsString)
		Dim Temp,RetStr,Matches,Match
		RegEx.Pattern =Pattern1
		Set Matches = RegEx.Execute(Str)
		For Each Match In Matches
			Temp=Re(Match.value)
			Str = Replace(Str,Match.value,Temp)
		Next
		RegEx.Pattern = Pattern
		If IsString=1 Then
			String_Replace=RegEx.Replace(Str,"<font color="&Color&">&quot;$1&quot;</font>")
		Else
			String_Replace=RegEx.Replace(Str,"<font color="&Color&">$1</font>")
		End If
	End Function


	Private Function Re(Str)
		Dim TRegEx,Temp
		Set TRegEx = New RegExp
		TRegEx.IgnoreCase = True
		TRegEx.Global = True
		TRegEx.Pattern="<.*?>"
		Temp=TRegEx.Replace(Str,"")
		Temp=Replace(Temp,"<","")
		Temp=Replace(Temp,">","")
		Re=Temp
		Set TRegEx=Nothing
	End Function

	Public Function MakeLi()
		Dim Temp
		If VBCode="" Then
			MakeLi=""
			Exit Function
		End If
		VBCode=HTMLEncode(VBCode)
		Temp=M_Replace(VBCode,"\b("&Keyword&")\b",KeyWordColor)
		Temp=M_Replace(Temp,"\b("&ObjEctCommand&")\b",ObjectCommandColor)
		Temp=String_Replace(Temp,"""(.*?)""","""(.*)(<.+?>)("&KeyWord&ObjectCommand&")+(<.+?>)(.*)""",StringsColor,1)
		Temp=String_Replace(Temp,"(('|rem).*)","'(.*)(<.+?>)("&KeyWord&ObjectCommand&")+(<.+?>)(.*)",Comment,0)
		MakeLi="<FONT  COLOR="&CodeColor&">"&RepVbCrlf(Temp)&"</FONT>"
	End Function

	Public Function RepVbCrlf(fString)
		RepVbCrlf = Replace(fString, CHR(10), "<BR> ")
	End Function

	Public Function HTMLEncode(fString)
		If IsNull(fString) Or fString="" Then
			HTMLEncode=""
			Exit Function
		End If
		fString = replace(fString, ">", "&gt;")
		fString = replace(fString, "<", "&lt;")
		'fString = Replace(fString, CHR(32), "&nbsp;")
		'fString = Replace(fString, CHR(9), "&nbsp;")
		'fString = Replace(fString, CHR(34), "&quot;")
		'fString = Replace(fString, CHR(39), "&#39;")
		'fString = Replace(fString, CHR(13), "")
		'fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
		'fString = Replace(fString, CHR(10), "<BR> ")
		HTMLEncode = fString
	End Function
End Class
</script>