dv_ubbcode.asp

一个功能强大的asp招聘求职系统

		s=re.Replace(s,"<div align=""$1"">$2</div>")
		re.Pattern="\x01\/align\]"
		s=re.replace(s,"[/align]")
		If isxhtml Then
			If xml.loadxml("<div>" & xmlencode(s) &"</div>") Then
				Dv_UbbCode_Align=s
			Else
				Dv_UbbCode_Align=strText
			End If
		Else
			Dv_UbbCode_Align=s
		End If
	End Function

	Private Function Dv_UbbCode_U(strText,PostUserGroup,Flag)	'(帖子内容，用户组，是否开放图片标签)
		Dim s
		If Dvbbs.Forum_Setting(76)="" Or Dvbbs.Forum_Setting(76)="0" Then Dvbbs.Forum_Setting(76)="UploadFile/"
		If right(Dvbbs.Forum_Setting(76),1)<>"/" Then Dvbbs.Forum_Setting(76)=Dvbbs.Forum_Setting(76)&"/"
		s=strText
		re.Pattern="\[upload=([^\]\n]*)\][\s\n]\[\/UPLOAD\]"
		s=re.Replace(s,"")
		re.Pattern="\[\/UPLOAD\]"
		s=re.replace(s, chr(1)&"/upload]")
		re.Pattern="\[upload=(gif|jpg|jpeg|bmp|png)\]UploadFile/([^\x01\n]*)\x01\/UPLOAD\]"
		If Dvbbs.Forum_Setting(75)="0" Then 
			If Flag = 1 or PostUserGroup<4 Then
				s= re.Replace(s,"<br/><img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" />此主题相关图片如下：<br/><a href="""&Dvbbs.Forum_Setting(76)&"$2"" target=""_blank"" ><img "& DV_UBB_TITLE &" src="""&Dvbbs.Forum_Setting(76)&"$2"" border=""0"" alt=""按此在新窗口浏览图片"" /></a>")
			Else
				s= re.Replace(s,"<br/><img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href="""&Dvbbs.Forum_Setting(76)&"$2"" target=""_blank"">"&Dvbbs.Forum_Setting(76)&"$2</a>")
			End If 
		Else
			If Flag = 1 or PostUserGroup<4 Then
				s= re.Replace(s,"<br/><img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" />此主题相关图片如下：<br/><a href=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" target=""_blank"" ><img "& DV_UBB_TITLE &" src=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" border=""0"" /></a>")
			Else
				s= re.Replace(s,"<br/><img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" target=""_blank"">showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2</a>")
			End If
		End If
		re.Pattern="\[upload=(swf|swi)\]UploadFile/([^\x01\n]*)\x01\/UPLOAD\]"
		If Dvbbs.Forum_Setting(75)="0" Then 
			If Board_Setting(44) = 1 or PostUserGroup<4 Then
				s= re.Replace(s,"<br/><img "& DV_UBB_TITLE &" src=""skins/default/filetype/swf.gif"" border=""0"" /><a href="""&Dvbbs.Forum_Setting(76)&"$2"" target=""_blank"">点击浏览该FLASH文件</a>：<br/>"&_
				"<embed "& DV_UBB_TITLE &" src="""&Dvbbs.Forum_Setting(76)&"$2"" quality=""high"" pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""500"" height=""300""></embed>")
			Else
				s= re.Replace(s,"<br/><img "& DV_UBB_TITLE &" src=""skins/default/filetype/swf.gif"" border=""0"" /><a href="""&Dvbbs.Forum_Setting(76)&"$2"" target=""_blank"">"&Dvbbs.Forum_Setting(76)&"$2</a>")
			End If 
		Else
			s= re.Replace(s,"<br/><img "& DV_UBB_TITLE &" src=""skins/default/filetype/swf.gif"" border=""0"" /><a href=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" target=""_blank"">论坛开启了防盗链，请点击浏览该FLASH文件</a>")
		End If
		re.Pattern="\[upload=([^\]\n]+)\]viewFile\.asp\?id=([0-9]*)\x01\/UPLOAD\]"
		s= re.Replace(s,"<img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href=""viewFile.asp?BoardID="&Dvbbs.Boardid&"&ID=$2"" target=""_blank"">点击浏览该文件</a>")
		re.Pattern="\x01\/upload]"
		re.Pattern="\[upload=([^\]\n]+)\]([^\x01]*)\x01\/UPLOAD\]"
		s= re.Replace(s,"<img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href=""$2"" target=""_blank"">点击浏览该文件</a>")
		re.Pattern="\x01\/upload]"
		s=re.replace(s,"[/upload]")
		If isxhtml Then
			If xml.loadxml("<div>" & xmlencode(s) &"</div>") Then
				Dv_UbbCode_U=s
			Else
				Dv_UbbCode_U=strText
			End If
		Else
				Dv_UbbCode_U=s
		End If
	End Function

	Private Function Dv_UbbCode_Q(strText)
		Dim s
		Dim LoopCount
		LoopCount=0
		s=strText
		re.Pattern="\[quote\]((.|\n)*?)\[\/quote\]"
		Do While re.Test(s)
			s=re.Replace(s,"<div class=""quote"">$1</div>")
			LoopCount=LoopCount+1
			If LoopCount>MaxLoopCount Then Exit Do
		Loop
		Dv_UbbCode_Q=s
	End Function

	Private Function Dv_UbbCode_name(strText)
		Dim s
		Dim po,match
		s=strText
		re.Pattern="\[\/username\]"
		s=re.Replace(s,Chr(1)&"/username]")
		re.Pattern="\[username=([^\]]+)]([^\x01]*)\x01\/username\]"
		If Cint(Board_Setting(56))=1 Then
			Set match = re.Execute(s)
			If match.count>0 Then
				po=re.Replace(match.item(0),",$1,")
				If  Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or InStr(po,","&Dvbbs.Membername&",")>0 or Dvbbs.master) Then
					s=re.Replace(s,"<hr /><font color=""red"">以下内容是专门发给<b>$1</b>浏览</font><br/>$2<hr />")
				Else
	
					s=re.Replace(s,"<hr /><font color=""gray"">以下内容是专门发给<b>$1</b>浏览</font><br/><hr />")
				End If
			End If
		Else
		s=re.Replace(s,"$2")
		End If
		re.Pattern="\x01\/username\]"
		s=re.Replace(s,"[/username]")
		Set match=Nothing
		If isxhtml Then
			If xml.loadxml("<div>" & xmlencode(s) &"</div>") Then
				Dv_UbbCode_name=s
			Else
				Dv_UbbCode_name=strText
			End If
		Else
			Dv_UbbCode_name=s
		End If
	End Function
	
	Private Function Dv_UbbCode_Get(strText,PostUserGroup,PostType,uCodeC,tCode1,tCode2,UsePoint,Flag)'帖子内容,发帖人组别,发帖类型,,,,,,用户积分,是否开放ubb标签
		Dim s,ii,match
		Dim LoopCount
		s=strText
		UsePoint=CLng(UsePoint)
		re.Pattern="\["&uCodeC&"= *[0-9]*\][\s\n]*\[\/"&uCodeC&"\]"
		s=re.replace(s,"")
		re.Pattern="\[\/"&uCodeC&"\]"
		s=re.replace(s,Chr(1)&"/"&uCodeC&"]")
		re.Pattern="\["&uCodeC&"= *([0-9]+)\]([^\x01]*)\x01\/"&uCodeC&"\]"
		If Issupport=1 Then
			Dim matches
			Set matches = re.Execute(s)
			re.Global=False
			For Each match In matches
				If (Flag=1 or PostUserGroup<4) and PostType=1 Then
					ii=int(match.SubMatches(0))
					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
					s=re.Replace(s,"$2")
				End If
				LoopCount=LoopCount+1
				If LoopCount>MaxLoopCount Then Exit For
			Next
			Set matches=Nothing
		Else
			Dim Test
			re.Global=False
			Test=re.Test(s)
			Do While Test
				If (Flag=1 or PostUserGroup<4) and PostType=1 Then
					Set match = re.Execute(s)
					ii=int(re.Replace(match.item(0),"$1"))
					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
					s=re.Replace(s,"$2")
				End If
				LoopCount=LoopCount+1
				If LoopCount>MaxLoopCount Then Exit Do
				Test=re.Test(s)
			Loop
			Set match=Nothing
		End If
		re.Global=true
		re.Pattern="\x01\/"&uCodeC&"\]"
		s=re.replace(s,"[/"&uCodeC&"]")
		If isxhtml Then
			If xml.loadxml("<div>" & xmlencode(s) &"</div>") Then
				Dv_UbbCode_Get=s
			Else
				Dv_UbbCode_Get=strText
			End If
		Else
			Dv_UbbCode_Get=s
		End If
	End Function

	Private Function UBB_REPLYVIEW(strText,PostUserGroup,PostType)
		Dim s
		Dim vrs
		s=strText
		re.Pattern="\[replyview\][\s\n]*\[\/replyview\]"
		s=re.Replace(s,"")
		re.Pattern="\[\/replyview\]"
		s=re.replace(s, chr(1)&"/replyview]")
		re.Pattern="\[replyview\]([^\x01]*)\x01\/replyview\]"
		If (Board_Setting(15)="1" or PostUserGroup<4) and PostType=1  Then
			If isgetreed<>1 Then 
				Set vrs=dvbbs.execute("select AnnounceID from "&TotalUsetable&" where rootid="&Announceid&" and PostUserID="&Dvbbs.UserID)
				isgetreed=1
				If Not vRs.eof Then
					reed=1 
				Else
					reed=0
				End If
				Set vrs=Nothing
			End If 
			If Dvbbs.Membername<>"" and (reed=1 or Dvbbs.master) Then
				s=re.Replace(s,"<hr noshade=""noshade"" size=""1"" /><font color=""gray"">以下内容只有<b>回复</b>后才可以浏览</font><br/>$1<hr noshade=""noshade"" size=""1"" />")
			Else
				s=re.Replace(s,"<hr noshade=""noshade"" size=""1"" /><font color="""&Dvbbs.Mainsetting(1)&""">以下内容只有<b>回复</b>后才可以浏览</font><hr noshade=""noshade"" size=""1"" />")
			End If 
		Else
			s=re.Replace(s,"$1")
		End If 
		re.Pattern="\x01\/replyview\]"
		s=re.replace(s, "[/replyview]")
		If isxhtml Then
			If xml.loadxml("<div>" & xmlencode(s) &"</div>") Then
				UBB_REPLYVIEW=s
			Else
				UBB_REPLYVIEW=strText
			End If
		Else
			UBB_REPLYVIEW=s
		End If
	End Function

	Private Function UBB_USEMONEY(strText,PostUserGroup,PostType)
		Dim s
		Dim Test
		Dim ii,iii,match,buied
		Dim SplitBuyUser,iPostBuyUser
		Dim LoopCount
		s=strText
		re.Global=False
		re.Pattern="\[USEMONEY=*([0-9]+)\]((.|\n)*)\[\/USEMONEY\]"
		Test=re.Test(s)
		If Test Then
			If T_GetMoneyType >0 Then
				s=re.Replace(s,"<hr size=""1"" /><font color=""gray"">由于使用了金币帖子设置，因此出售帖UBB模式失效，以下是帖子内容：</font>&nbsp;&nbsp;<br />$2<hr size=""1"" />")
			Else
				If (Cint(Board_Setting(23))=1 or PostUserGroup<4) and PostType=1 Then
					Set match = re.Execute(s)
					ii=int(re.Replace(match.item(0),"$1"))
					If  Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or Dvbbs.master) Then
						If (Not IsNull(PostBuyUser)) And PostBuyUser<>"" Then
							SplitBuyUser=split(PostBuyUser,"|")
							iPostBuyUser="<option value=""0"">已购买用户</option>"
							for iii=0 to ubound(SplitBuyUser)
								iPostBuyUser=iPostBuyUser & "<option value="""&iii&""">"&SplitBuyUser(iii)&"</option>"
							next
						Else
							iPostBuyUser="<option value=""0"">还没有用户购买</option>"
						End If
						s=re.Replace(s,"<hr noshade=""noshade"" size=""1"" /><font color=""gray"">以下内容需要花费现金<b>$1</b>才可以浏览</font>&nbsp;&nbsp;<select size=""1"" name=""buyuser"">"&iPostBuyUser&"</select><br/>$2<hr noshade=""noshade"" size=""1"" />")
						re.Global=true
						re.Pattern="\[\/?USEMONEY=*[0-9]*\]"
						s=re.Replace(s,"")
					Else
						buied=0
						If (Not IsNull(PostBuyUser)) and PostBuyUser<>"" Then
							If Instr("|"&PostBuyUser&"|","|"&Dvbbs.Membername&"|")>0 Then buied=1
						End If
						If buied=1 Then
							s=re.Replace(s,"<hr noshade=""noshade"" size=""1"" /><font color=""gray"">以下内容需要花费现金<b>$1</b>才可以浏览，您已经购买本帖</font><br/>$2<hr noshade=""noshade"" size=""1"" />")
							re.Global=true
							re.Pattern="\[\/?USEMONEY=*[0-9]*\]"
							s=re.Replace(s,"")
						Else
							If Clng(UserPointInfo(0))>=ii Then
								s=re.Replace(s,"<form action=""BuyPost.asp"" mothod=""post""><font color="""&Dvbbs.Mainsetting(1)&""">以下内容需要花费现金<b>$1</b>才可以浏览，您目前有现金<b>"&UserPointInfo(0)&"</b>。<br/><br/>　　　　<input type=""hidden"" name=""boardid"" value="""&Dvbbs.boardid&""" /><input type=""hidden"" value="""&replyid_a&""" name=""replyid"" /><input type=""hidden"" value="""&AnnounceID_a&""" name=""id"" /><input type=""hidden"" value="""&RootID_a&""" name=""rootid""/><input type=""hidden"" value="""&totalusetable&""" name=""posttable"" /><input type=""submit"" name=""submit"" value=""好黑啊…我…我买了！"" />&nbsp;&nbsp;</font></form>")
							Else
								s=re.Replace(s,"<hr noshade=""noshade"" size=""1"" /><font color="""&Dvbbs.Mainsetting(1)&""">以下内容需要花费现金<b>$1</b>才可以浏览，您只有现金<b>"&UserPointInfo(0)&"</b>，无法购买。</font><hr noshade=""noshade"" size=""1"" />")
							End If
						End If
					End If
				Else
					re.Global=true