ubbcode.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 646 行 · 第 1/2 页

				TitleText="<img src=""" & m_strPicPath & "realplayer.gif"" alt="""" style=""margin:0px 2px -3px 0px"" border=""0""/>播放real视频流文件"		 
			ElseIf strType="ra" Then
				TitleText="<img src=""" & m_strPicPath & "realplayer.gif"" alt="""" style=""margin:0px 2px -3px 0px"" border=""0""/>播放real音频流文件"		 
			ElseIf strType="qt" Then
				TitleText="<img src=""" & m_strPicPath & "mediaplayer.gif"" alt="""" style=""margin:0px 2px -3px 0px"" border=""0""/>播放mov视频文件"		 
			End If
			strWidth=strMatch.SubMatches(1)
			strHeight=strMatch.SubMatches(2)
			If (len(strWidth)=0) Then 
				strWidth="400"
			Else
				strWidth=right(strWidth,(len(strWidth)-1))
			End If
			If (len(strHeight)=0) Then
				strHeight="300"
			Else
				strHeight=right(strHeight,(len(strHeight)-1))
			End If
			strSRC=strMatch.SubMatches(3)
			rndID="temp"&Int(100000 * Rnd)
			strContent= Replace(strContent,strMatch.Value,"<div class=""UBBContainer""><div class=""UBBTitle"">"&TitleText&"</div><div class=""UBBContent""><a id="""+rndID+"_href"" href=""javascript:MediaShow('"+strType+"','"+rndID+"','"+strSRC+"','"+strWidth+"','"+strHeight+"','"+m_strPicPath+"')""><img name="""+rndID+"_img"" src=""" & m_strPicPath & "mm_snd.gif"" style=""margin:0px 3px -2px 0px"" border=""0"" alt=""""/><span id="""+rndID+"_text"">在线播放</span></a><div id="""+rndID+"""></div></div></div>")
		Next
		Set strMatchs=nothing
		ProcessUbbCode_MP = strContent
	End Function

	Private Function ProcessUbbCode_S1(strText,uCodeC,tCode)
		Dim s
		s=strText
		re.Pattern="\["&uCodeC&"\][\s\n]*\[\/"&uCodeC&"\]"
		s=re.Replace(s,"")
		re.Pattern="\[\/"&uCodeC&"\]"
		s=re.Replace(s, Chr(1)&"/"&uCodeC&"]")
		re.Pattern="\["&uCodeC&"\]([^\x01]*)\x01\/"&uCodeC&"\]"
		s=re.Replace(s,tCode)
		re.Pattern="\x01\/"&uCodeC&"\]"
		s=re.Replace(s,"[/"&uCodeC&"]")
		If isxhtml Then
			If xml.loadxml("<div>" & xmlencode(s) &"</div>") Then
				ProcessUbbCode_S1=s
			Else
				ProcessUbbCode_S1=strText
			End If
		Else
			ProcessUbbCode_S1=s
		End If
	End Function

	Private Function ProcessUbbCode_UF(strText,uCodeC,tCode,Flag)
		Dim s
		Dim LoopCount
		LoopCount=0
		s=strText
		re.Pattern="\["&uCodeC&"=([^\]]*)\][\s\n ]*\[\/"&uCodeC&"\]"
		s=re.Replace(s,"")
		re.Pattern="\[\/"&uCodeC&"\]"
		s=re.Replace(s, chr(1)&"/"&uCodeC&"]")
		re.Pattern="\["&uCodeC&"=([^\]]*)\]([^\x01]*)\x01\/"&uCodeC&"\]"
		If Flag="1" Then 
			Do While Re.Test(s)
				s=re.Replace(s,tCode)
				LoopCount=LoopCount+1
				If LoopCount>MaxLoopCount Then Exit Do
			Loop
		ElseIf Flag="0" Then
			s=re.Replace(s,tCode)
		Else
			re.Pattern="\["&uCodeC&"=(["&Flag&"]*)\]([^\x01]*)\x01\/"&uCodeC&"\]"
			Do While Re.Test(s)
				s=re.Replace(s,tCode)
				LoopCount=LoopCount+1
				If LoopCount>MaxLoopCount Then Exit Do
			Loop
		End If
		re.Pattern="\x01\/"&uCodeC&"\]"
		s=re.Replace(s,"[/"&uCodeC&"]")
		If isxhtml Then
			If xml.loadxml("<div>" & xmlencode(s) &"</div>") Then
				ProcessUbbCode_UF=s
			Else
				ProcessUbbCode_UF=strText
			End If
		Else
			ProcessUbbCode_UF=s
		End If
	End Function

	Private Function ProcessUbbCode_iS1(strText,uCodeC,tCode)
		Dim s
		s=strText
		re.Pattern="\["&uCodeC&"=[^\]]*\][\s\n]\[\/"&uCodeC&"\]"
		s=re.Replace(s,"")
		re.Pattern="\[\/"&uCodeC&"\]"
		s=re.Replace(s, chr(1)&"/"&uCodeC&"]")
		re.Pattern="\["&uCodeC&"=([0-9]+),(#?[\w]+),([0-9]+)\]([^\x01]*)\x01\/"&uCodeC&"\]"
		s=re.Replace(s,tCode)
		re.Pattern="\x01\/"&uCodeC&"\]"
		s=re.Replace(s, "[/"&uCodeC&"]")
		If isxhtml Then
			If xml.loadxml("<div>" & xmlencode(s) &"</div>") Then
				ProcessUbbCode_iS1=s
			Else
				ProcessUbbCode_iS1=strText
			End If
		Else
			ProcessUbbCode_iS1=s
		End If
	End Function
		
	Private Function ProcessUbbCode_Align(strText)
		Dim s
		s=strText
		're.Pattern="\[align=(center|left|right)\][\s\n]*\[\/align\]"
		's=re.Replace(s,"")
		re.Pattern="\[\/align\]"
		s=re.Replace(s,chr(1)&"/align]")
		re.Pattern="\[align=(center|left|right)\]([^\x01]*)\x01\/align\]"
		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
				ProcessUbbCode_Align=s
			Else
				ProcessUbbCode_Align=strText
			End If
		Else
			ProcessUbbCode_Align=s
		End If
	End Function
		
	Private Function ProcessUbbCode_C(strText,uCodeC)
		Dim s,matches,match,CodeStr,rndID
		s=strText
		re.Pattern="\["&uCodeC&"\][\s\n]*\[\/"&uCodeC&"\]"
		s=re.Replace(s,"")
		re.Pattern="\[\/"&uCodeC&"\]"
		s=re.Replace(s,Chr(1)&"/"&uCodeC&"]")
		re.Pattern="\["&uCodeC&"\]([^\x01]*)\x01\/"&uCodeC&"\]"
		Set matches = re.Execute(s)
		re.Global=False
		For Each match In matches
			RAndomize
			rndID="CodeText"&Int(100000 * Rnd)
			CodeStr=match.SubMatches(0)
			CodeStr = Replace(CodeStr,"&nbsp;",Chr(32),1,-1,1)
			CodeStr = Replace(CodeStr,"<p>","",1,-1,1)
			CodeStr = Replace(CodeStr,"</p>","&#13;&#10;",1,-1,1)
			CodeStr = Replace(CodeStr,"[br]","&#13;&#10;",1,-1,1)
			CodeStr = Replace(CodeStr,"<br/>","&#13;&#10;",1,-1,1)
			CodeStr = Replace(CodeStr,"<br />","&#13;&#10;",1,-1,1)
			CodeStr = Replace(CodeStr,vbNewLine,"&#13;&#10;",1,-1,1)
			CodeStr = "<div class=""UBBContainer""><div class=""UBBTitle""><img src=""" & m_strPicPath & "html.gif"" style=""margin:0px 2px -3px 0px""> 以下是程序代码</div><div class=""UBBContent""><textarea rows=""8"" id="""&rndID&""" class=""UBBText"">"&CodeStr& "</textarea><br/><input onclick=""runEx('"&rndID&"')""  type=""button"" value=""运行此代码""/> <input onclick=""doCopy('"&rndID&"')""  type=""button"" value=""复制此代码""/><br/> [Ctrl+A 全部选择 提示：你可先修改部分代码，再按运行]</div></div>"
			s = re.Replace(s,CodeStr)
		Next
		re.Global=true
		Set matches=Nothing
		re.Pattern="\x01\/"&uCodeC&"\]"
		s=re.Replace(s,"[/"&uCodeC&"]")
		ProcessUbbCode_C=s
	End Function
	
	Public Function SplitArray(expression,delimiter,start)
		Dim TempArray()
		Dim m_arrTemp,i,n
		If Len(expression) = 0 Then
			SplitArray = Array(0,0,0,1,1,1,1,1,1,1,0,550,0,0,1)
			Exit Function
		End If
		m_arrTemp = Split(expression, delimiter)
		If start < 1 Then
			SplitArray = m_arrTemp
			Exit Function
		End If
		n = 0
		For i = start To UBound(m_arrTemp)
			ReDim Preserve TempArray(n)
			TempArray(n) = m_arrTemp(i)
			n = n + 1
		Next
		SplitArray = TempArray
	End Function
	
	Private Function ProcessUbbCode_Key(strText)
		Dim s,i,sContentKeyword,ArrayKeyword,strKeyword
		s=strText
		If Trim(ContentKeyword) <> "" Then
			sContentKeyword = Split(ContentKeyword, "@@@")
			If UBound(sContentKeyword) > 1 Then
				For i = 0 To UBound(sContentKeyword) - 1
					ArrayKeyword = Split(sContentKeyword(i), "$$$")
					If ArrayKeyword(0) <> "" Then
						strKeyword = ArrayKeyword(0)
						If Left(strKeyword,1) = "|" Then strKeyword = Replace(strKeyword, "|", vbNullString,1,1)
						If Right(strKeyword,1) = "|" Then strKeyword = Left(strKeyword,Len(strKeyword)-1)
						re.Pattern = "(^|[^\/\\\w\=])(" & Replace(strKeyword, "$", "\$") & ")"
						s=re.Replace(s, "$1<a target=""_blank"" href=""" & ArrayKeyword(1) & """ class=""UBBWordLink"">$2</a>")
					End If
				Next
			End If
		End If
		ProcessUbbCode_Key=s
	End Function

	Public Function SplitLines(byVal Content,byVal ContentNums) 
		Dim ts,i,l
		ContentNums=int(ContentNums)
		If IsNull(Content) Then Exit Function
		i=1
		ts = 0
		For i=1 to Len(Content)
		  l=Lcase(Mid(Content,i,5))
			If l="<br/>" Then
				ts=ts+1
			End If
		  l=Lcase(Mid(Content,i,4))
			If l="<br>" Then
				ts=ts+1
			End If
		  l=Lcase(Mid(Content,i,3))
			If l="<p>" Then
				ts=ts+1
			End If
		If ts>ContentNums Then Exit For 
		Next
		If ts>ContentNums Then
			Content=Left(Content,i-1)
		End If
		SplitLines=Content
	End Function

	Private Function InsertPageBreak(strText)
		Dim strPagebreak,s
		Dim i,IsCount,c,iCount,strTemp,Temp_String,Temp_Array
		strPagebreak="[page_break]"
		s=strText
		If maxPagesize<100 Or Len(s)<maxPagesize Then
			InsertPageBreak=s
		End If
		s=Replace(s, strPagebreak, "")
		's=Replace(s, "&nbsp;&nbsp;", "　")
		's=Replace(s, "&nbsp;", " ")
		If s<>"" and maxPagesize<>0 and InStr(1,s,strPagebreak)=0 then
			IsCount=True
			Temp_String=""
			For i= 1 To Len(s)
				c=Mid(s,i,1)
				If c="<" Then
					IsCount=False
				ElseIf c=">" Then
					IsCount=True
				Else
					If IsCount=True Then
						If Abs(Asc(c))>255 Then
							iCount=iCount+2
						Else
							iCount=iCount+1
						End If
						If iCount>=maxPagesize And i<Len(s) Then
							strTemp=Left(s,i)
							If CheckPagination(strTemp,"table|a|b>|i>|strong|div|span") then
								Temp_String=Temp_String & Trim(CStr(i)) & "," 
								iCount=0
							End If
						End If
					End If
				End If	
			Next
			If Len(Temp_String)>1 Then Temp_String=Left(Temp_String,Len(Temp_String)-1)
			Temp_Array=Split(Temp_String,",")
			For i = UBound(Temp_Array) To LBound(Temp_Array) Step -1
				s=Left(s,Temp_Array(i)) & strPagebreak & Mid(s,Temp_Array(i)+1)
			Next
		End If
		InsertPageBreak=s
	End Function
	
	Private Function CheckPagination(strTemp,strFind)
		Dim i,n,m_ingBeginNum,m_intEndNum
		Dim m_strBegin,m_strEnd,FindArray
		strTemp=LCase(strTemp)
		strFind=LCase(strFind)
		If strTemp<>"" and strFind<>"" then
			FindArray=split(strFind,"|")
			For i = 0 to Ubound(FindArray)
				m_strBegin="<"&FindArray(i)
				m_strEnd  ="</"&FindArray(i)
				n=0
				do while instr(n+1,strTemp,m_strBegin)<>0
					n=instr(n+1,strTemp,m_strBegin)
					m_ingBeginNum=m_ingBeginNum+1
				Loop
				n=0
				do while instr(n+1,strTemp,m_strEnd)<>0
					n=instr(n+1,strTemp,m_strEnd)
					m_intEndNum=m_intEndNum+1
				Loop
				If m_intEndNum=m_ingBeginNum then
					CheckPagination=True
				Else
					CheckPagination=False
					Exit Function
				End If
			Next
		Else
			CheckPagination=False
		End If
	End Function
	
	Public Function CheckSpecialChar(ByVal strText)
		Dim strMatchs, strMatch
		re.Pattern="[^A-Za-z0-9-\u4E00-\u9FA5]"
		Set strMatchs=re.Execute(strText)
		For Each strMatch in strMatchs
			strText=re.Replace(strText, "")
		Next
		CheckSpecialChar=strText
	End Function
	
End Class

%>