dv_ubbcode.asp

来自「一个很不错的论坛系统」· ASP 代码 · 共 881 行 · 第 1/4 页

	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"
					'If LoopCount mod 2=0 Then 
						's=re.Replace(s,"<table style=""width:95%"" cellpadding=5 cellspacing=1 class=tableborder1><TR><TD class="&abgcolor&">$1</td></tr></table><br>")
						s=re.Replace(s,"<DIV class=quote>$1</div><br>")
					'Else
						's=re.Replace(s,"<table style=""width:95%"" cellpadding=5 cellspacing=1 class=tableborder1><TR><TD class="&bgcolor&">$1</td></tr></table><br>")
					'End If
					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
		Dim LoopCount
		LoopCount=0
		s=strText
		Do While True
			re.Pattern="\[username=(.[^\[]*)\]"
			Test=re.Test(s)
			If Test Then
				re.Pattern="\[\/username\]"
				Test=re.Test(s)
				If Test Then
					
					re.Pattern="\[username=(.[^\[]*)\]"
					s=re.replace(s, chr(1) & "username=$1" & chr(2))
					re.Pattern="\[\/username\]"
					s=re.replace(s, chr(1) & "/username" & chr(2))
					re.Pattern="\x01username=(.[^\x01]*)\x02\x01\/username\x02"
					s=re.Replace(s,"")
					re.Pattern="\x01username=(.[^\x01]*)\x02(.[^\x01]*)\x01\/username\x02"
					If Cint(Dvbbs.Board_Setting(56))=1 Then
						po=re.Replace(s,"$1")
						po=","&po&","
						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
					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_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")