dv_ubbcode.asp

前台及后台用户名密码都是：gz35gz35.com

			Else
				Exit Do
			End IF
			LoopCount = LoopCount+1
			If LoopCount > MaxLoopCount Then Exit Do
		Loop
		Dv_UbbCode_Abl = S
	End Function	
	Private Function Dv_UbbCode_S(strText)
		Dim s
		Dim Test
		Dim LoopCount
		LoopCount=0
		s=strText
		Do While True
			re.Pattern="\[SIZE=([1-7])\]"
			Test=re.Test(s)
			If Test Then
				re.Pattern="\[\/SIZE\]"
				Test=re.Test(s)
				If Test Then
					re.Pattern="\[SIZE=([1-7])\]"
					s=re.replace(s, chr(1) & "SIZE=$1" & chr(2))
					re.Pattern="\[\/SIZE\]"
					s=re.replace(s, chr(1) & "/SIZE" & chr(2))
					re.Pattern="\x01SIZE=([1-7])\x02\x01\/SIZE\x02"
					s=re.Replace(s,"")
					re.Pattern="\x01SIZE=([1-7])\x02(.[^\x01]*)\x01\/SIZE\x02"
					s=re.Replace(s,"<font size=$1>$2</font>")
					re.Pattern="\x02"
					s=re.replace(s, "]")
					re.Pattern="\x01"
					s=re.replace(s, "[")
				Else
					Exit Do
				End If 
			Else
				Exit Do
			End If
			 LoopCount=LoopCount+1
			 If LoopCount>MaxLoopCount Then Exit Do
		Loop
		Dv_UbbCode_S=s
	End Function

	Private Function Dv_UbbCode_Q(strText)
		Dim s
		Dim Test
		Dim LoopCount
		LoopCount=0
		s=strText
		re.Pattern="\[QUOTE\]"
		Test=re.Test(s)
		If Test Then
			re.Pattern="\[\/QUOTE\]"
			Test=re.Test(s)
			If Test Then
				re.Pattern="\[QUOTE\]"
				s=re.replace(s, chr(1) & "QUOTE" & chr(2))
				re.Pattern="\[\/QUOTE\]"
				s=re.replace(s, chr(1) & "/QUOTE" & chr(2))
				Do
					re.Pattern="\x01QUOTE\x02\x01\/QUOTE\x02"
					s=re.Replace(s,"")
					re.Pattern="\x01QUOTE\x02(.[^\x01]*)\x01\/QUOTE\x02"
					s=re.Replace(s,"<DIV class=quote>$1</div><br>")
					Test=re.Test(s)
					LoopCount=LoopCount+1
					If LoopCount>MaxLoopCount Then Exit Do
				Loop While(Test)
				re.Pattern="\x02"
				s=re.replace(s, "]")
				re.Pattern="\x01"
				s=re.replace(s, "[")
			End If 
		End If
		Dv_UbbCode_Q=s
	End Function

	Private Function Dv_UbbCode_C(strText)
		Dim s
		Dim Test
		Dim LoopCount
		LoopCount=0
		s=strText
		Do While True
			re.Pattern="\[COLOR=(.[^\[]*)\]"
			Test=re.Test(s)
			If Test Then
				re.Pattern="\[\/COLOR\]"
				Test=re.Test(s)
				If Test Then
					re.Pattern="\[COLOR=(.[^\[]*)\]"
					s=re.replace(s, chr(1) & "COLOR=$1" & chr(2))
					re.Pattern="\[\/COLOR\]"
					s=re.replace(s, chr(1) & "/COLOR" & chr(2))
					re.Pattern="\x01COLOR=(.[^\x01]*)\x02\x01\/COLOR\x02"
					s=re.Replace(s,"")
					re.Pattern="\x01COLOR=(.[^\x01]*)\x02(.[^\x01]*)\x01\/COLOR\x02"
					s=re.Replace(s,"<font color=$1>$2</font>")
					re.Pattern="\x02"
					s=re.replace(s, "]")
					re.Pattern="\x01"
					s=re.replace(s, "[")
				Else
					Exit Do
				End If
			Else
				Exit Do
			End If
			LoopCount=LoopCount+1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		Dv_UbbCode_C=s
	End Function

	Private Function Dv_UbbCode_F(strText)
		Dim s
		Dim Test
		Dim LoopCount
		LoopCount=0
		s=strText
		Do While True
			re.Pattern="\[FACE=(.[^\[]*)\]"
			Test=re.Test(s)
			If Test Then
				re.Pattern="\[\/FACE\]"
				Test=re.Test(s)
				If Test Then
					re.Pattern="\[FACE=(.[^\[]*)\]"
					s=re.replace(s, chr(1) & "FACE=$1" & chr(2))
					re.Pattern="\[\/FACE\]"
					s=re.replace(s, chr(1) & "/FACE" & chr(2))
					re.Pattern="\x01FACE=(.[^\x01]*)\x02\x01\/FACE\x02"
					s=re.Replace(s,"")
					re.Pattern="\x01FACE=(.[^\x01]*)\x02(.[^\x01]*)\x01\/FACE\x02"
					s=re.Replace(s,"<font face=$1>$2</font>")
					re.Pattern="\x02"
					s=re.replace(s, "]")
					re.Pattern="\x01"
					s=re.replace(s, "[")
				Else
					Exit Do
				End If
			Else
				Exit Do
			End If
			LoopCount=LoopCount+1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		Dv_UbbCode_F=s
	End Function
	Private Function Dv_UbbCode_name(strText)
		Dim s
		Dim Test,po
		s=strText
		re.Pattern="\[username=(.[^\[]*)](.[^\[]*)\[\/username\]"
		If Cint(Dvbbs.Board_Setting(56))=1 Then
			po=re.Replace(s,"[,$1,]")
			If  Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or InStr(po,","&Dvbbs.Membername&",")>0  or Dvbbs.master) Then
				s=re.Replace(s,"<hr noshade size=1><font color=red>以下内容是专门发给<B>$1</B>浏览</font><BR>$2<hr noshade size=1>")
			Else
				s=re.Replace(s,"<hr noshade size=1><font color=gray>以下内容是专门发给<B>$1</B>浏览</font><BR><hr noshade size=1>")
			End If 
		Else
			s=re.Replace(s,"$2")
		End If
		Dv_UbbCode_name=s
	End Function
	Private Function Dv_UbbCode_Get(strText,PostUserGroup,PostType,uCodeL,uCodeR,uCodeC,tCode1,tCode2,UsePoint,Flag)
		Dim s
		Dim Test
		Dim po,ii
		Dim LoopCount
		LoopCount=0
		s=strText
		UsePoint=CLng(UsePoint)
		Do While True
			re.Pattern=uCodeL
			Test=re.Test(s)
			If Test Then
				re.Pattern=uCodeR
				Test=re.Test(s)
				If Test Then
					re.Pattern=uCodeL
					s=re.replace(s, chr(1) & ""&uCodeC&"=$1" & chr(2))
					re.Pattern=uCodeR
					s=re.replace(s, chr(1) & "/"&uCodeC&"" & chr(2))
					re.Pattern="(\x01"&uCodeC&"=*([0-9]*)\x02)(\x01\/"&uCodeC&"\x02)"
					s=re.Replace(s,"")
					If (Flag=1 or PostUserGroup<4) and PostType=1 Then
						re.Pattern="(^.*)(\x01"&uCodeC&"=*([0-9]*)\x02)(.[^\x01]*)(\x01\/"&uCodeC&"\x02)(.*)"
						po=re.Replace(s,"$3")
						If  IsNumeric(po) Then
							ii=int(po) 
						Else
							ii=0
						End If 
						If  Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or UsePoint>=ii or Dvbbs.master) Then
							s=re.Replace(s,tCode1)
						Else
							s=re.Replace(s,tCode2)
						End If
					Else
						re.Pattern="(\x01"&uCodeC&"=*([0-9]*)\x02)(.[^\x01]*)(\x01\/"&uCodeC&"\x02)"
						s=re.Replace(s,"$3")
					End If 
					re.Pattern="\x02"
					s=re.replace(s, "]")
					re.Pattern="\x01"
					s=re.replace(s, "[")
				Else
					Exit Do
				End If 
			Else
				Exit Do
			End If
			LoopCount=LoopCount + 1
			If LoopCount>MaxLoopCount Then Exit Do