cl_clsubb.asp

淘客网上商店网站程序 淘客网上商店网站程序 淘客网上商店网站程序

		If InStr(Ubblists,",24,")>0 Then s=Cl_UbbCode_S1(s,"b","<b>$1</b>")
		If InStr(Ubblists,",25,")>0 Then
			re.Pattern="\[em(.[^\[]*)\]"
			s=re.Replace(s,"<img src="""&Cl.WebDir&"Images/emot/em$1.gif"" border=""0"" />")
		End If
		If InStr(Ubblists,",26,")>0 Then s=Cl_UbbCode_S1(s,"u","<u>$1</u>")
		'不开放HTML支持，不转换HREF
		If IsOpenHTML=1 Then
			'自动识别网址
			'If InStr(Ubblists,",11,")>0 Then
			'	re.Pattern = "(^|[^<=""])(((http|https|ftp|rtsp|mms):(\/\/|\\\\))(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&amp;)|&)+)"
			'	s = re.Replace(s,"$1<a target=""_blank"" href=""$2"">$2</a>")
			'End If
			'自动识别www等开头的网址
			If InStr(Ubblists,",27,")>0 Then
				re.Pattern = "(^|[^\/\\\w\=])((www|bbs)\.(\w)+\.([\w\/\\\.\=\?\+\-~`@\'!%#]|(&amp;))+)"
				s = re.Replace(s,"$1<a target=""_blank"" href=""http://$2"">$2</a>")
			End If
		End If
		s=ReplaceHide(s)
		s=Cl.ReplaceKeyword(s)
		UbbCode=ImgSize(s,600)
	End Function
	Private Function ImgSize(strText,ssize)
		Dim s,ss,t,tt
		s=strText
		'去掉图片中的脚本代码
		re.Pattern="(width>)"
		s=re.Replace(s,"width&gt;")
		re.Pattern="<img(.[^>]*)src(=| =)(.[^ >]*)(.[^>]*)>"
		s=re.replace(s,"<img src=$3 onclick=""javascript:window.open(this.src);"" style=""cursor:pointer;"" onload=""javascript:if(this.width>"&ssize&")this.style.width='"&ssize&"px';"" border=""0"" />")
		re.Pattern="(width&gt;)"
		s=re.Replace(s,"width>")
		ImgSize=s
	End Function
	Private Function Cl_UbbCode_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&"]")
		Cl_UbbCode_S1=s
	End Function
	Function ReplaceHide(strText)
		Dim s,Matches,Match,SubMatch,subStr,rndid
		s=strText
		re.Pattern="\[\/hide\]"
		s=re.replace(s, Chr(1) & "/hide]")
		re.Pattern="\[hide\](.[^\x01]*)\x01\/hide\]"
		rndid=0
		Set Matches = re.Execute(s)
		For Each Match in Matches
			Set SubMatch = Match.SubMatches
			subStr = SubMatch(0)
			subStr = "<span class=""LinkSpecial"" id=""link_"&rndid&""" onclick=""togglespan(1, span_"&rndid&",link_"&rndid&");"">查看隐藏内容</span><span style=""display:none"" id=""span_"&rndid&"""><table cellspacing=""0"" class=""DynaTable_2""><tr><td class=""DynaTable_2_HeadingCell""><div class=""heading_2_special""><a class=""DynaTable_2_HeadingText"" href=""javascript:togglespan(2,span_"&rndid&",link_"&rndid&");""></a>隐藏内容如下</div></td></tr><tr><td class=""DynaTable_2_ContentCell""><p >"&subStr&"</p></td></tr></table></span>"
			s=replace(s,Match.value,subStr,1,1,0)
			rndid = rndid + 1
		Next
		Set Match = Nothing
		Set Matches = Nothing
		Set SubMatch = Nothing
		re.Pattern="\x01\/hide\]"
		s=re.replace(s,"[/hide]")
		ReplaceHide=s
	End Function
	Private Function Cl_UbbCode_iS1(strText,uCodeC,tCode,iCode)
		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&"]")
		Cl_UbbCode_iS1=s
	End Function
	Private Function Cl_UbbCode_iS2(strText,uCodeC,tCode1,iCode)
		Dim s
		s=strText
		re.Pattern="\["&uCodeC&iCode&"\][\s\n]*\[\/"&uCodeC&"\]"
		s=re.replace(s,"")
		re.Pattern="\[\/"&uCodeC&"\]"
		s=re.replace(s, chr(1)&"/"&uCodeC&"]")
		If uCodeC<>"flash" Then
			re.Pattern="\["&uCodeC&"[^\]]*\](([^\x01\n]*)(\.swf|\.swi)([^\x01\n]*))\x01\/"&uCodeC&"\]"
			s=re.Replace(s,"非法"&uCodeC&"多媒体标签，文件地址：$1")
		End If
		If uCodeC="img" Then
			re.Pattern="\["&uCodeC&iCode&"\]([^""\x01\n]*)\x01\/"&uCodeC&"\]"
		Else
			re.Pattern="\["&uCodeC&iCode&"\]([^\x01\n]*)\x01\/"&uCodeC&"\]"
		End If
		s=re.Replace(s,tCode1)
		re.Pattern="\x01\/"&uCodeC&"\]"
		s=re.replace(s,"[/"&uCodeC&"]")
		Cl_UbbCode_iS2=s
	End Function
	Private Function Cl_UbbCode_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]")
		Cl_UbbCode_Align=s
	End Function



	Private Function Cl_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
		Cl_UbbCode_Q=s
	End Function

	Private Function Cl_UbbCode_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&"]")
		Cl_UbbCode_UF=s
	End Function


End Class
%>