⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dv_ubbcode.asp

📁 一个功能强大的asp招聘求职系统
💻 ASP
📖 第 1 页 / 共 5 页
字号:
					newstyle=""
				 	For each style in Stylestr
				 		style1=split(style,":")
				 		If UBound(style1)>0 Then
				 			style_a=LCase(Trim(style1(0)))
					 		style_b=LCase(Trim(style1(1)))
					 		If UBound(style1)>1 Then
					 				For i =2 to UBound(style1)
					 				style_b=style_b& ":"& style1(i)
					 				Next
					 			End If
					 		'吃掉POSITION:,top,left几个属性
					 		If (style_a<>"xss" and InStr(style_b,"expression")=0 and InStr(style_a,"script")=0) Then
					 			newstyle=newstyle&style_a&":"&style_b&";"
					 		End If
				 		End If
					Next
					node.text=newstyle
				End If
			Next
		'所有的属性的检查过滤
		For Each newnode in xml.documentElement.selectNodes("//*")
				For Each node in newnode.attributes
					If Left(LCase(Node.nodeName),2)="on" Then
						newnode.attributes.removeNamedItem(Node.nodeName)
						checktag mt,PostUserGroup
						Exit Sub
					Else
						nodetext=entity2Str(node.text)
						If InStr(nodetext,"script:")>0 or InStr(nodetext,"document.")>0 Or InStr(nodetext,"xss:") > 0 Or InStr(nodetext,"expression") > 0 Then
								newnode.attributes.removeNamedItem(Node.nodeName)
								checktag mt,PostUserGroup
								Exit Sub
						End If
					End If
				Next
		Next
		'改掉所有的id属性避免造成混乱
		For Each newnode in xml.documentElement.selectNodes("//*")
			For Each node in newnode.attributes
					If LCase(Node.nodeName)="id" or  LCase(Node.nodeName)="name" Then
						node.text=replace(node.text,"dv_","")
					End If
				Next
		Next
		Dim hasname,hasvalue
		For Each Node in xml.documentElement.getElementsByTagName("*")
			If LCase(Node.nodeName)="param" Then
				hasname=0
				hasvalue=0
				iskill=0
				For each attributes1 in Node.attributes
					If LCase(attributes1.nodeName)="name" Then
						If LCase(attributes1.text)="filename" or LCase(attributes1.text)="src" or LCase(attributes1.text)="console" Then
							hasname=1
						End If
					End If
					If LCase(attributes1.nodeName)="value" Then
						hasvalue=1
					End If
				Next
				If hasname=1 and hasvalue=1 Then
					For each attributes1 in Node.attributes
						If LCase(attributes1.nodeName)="value" Then
							nodetext=entity2Str(attributes1.text)
							If InStr(nodetext,".asp")>0 Then
								nodetext=replace(nodetext,"showimg.asp","")
								If InStr(nodetext,".asp")>0 Then
									iskill=1
								End If
							End If
						End If
					Next	
				End If
				If iskill=1 Then
					Set Fnode=node.parentNode.parentNode
					If Not Fnode is nothing Then
						Set newnode=xml.createTextNode(node.parentNode.xml)		
						node.parentNode.parentNode.replaceChild newnode,node.parentNode
					Else
						Set newnode=xml.createTextNode(node.xml)
						node.parentNode.replaceChild newnode,node
					End If
					checktag mt,PostUserGroup
					Exit Sub
				End If
			Else
				For each attributes1 in Node.attributes
				If LCase(attributes1.nodeName)="src" Then
						nodetext=entity2Str(attributes1.text)
						If InStr(nodetext,".asp")>0 Then
							nodetext=replace(nodetext,"showimg.asp","")
							If InStr(nodetext,".asp")>0 Then
								Set newnode=xml.createTextNode(node.xml)		
								node.parentNode.replaceChild newnode,node
								checktag mt,PostUserGroup
								Exit Sub
							End If
						End If
				End If	
				Next
			End If
		Next
		Dim XML1,titletext,thissrc,objcount
		If Cint(Board_Setting(9) * mt)=0 Then
			For Each Node in xml.documentElement.getElementsByTagName("*")
				'禁止所有自动播放的标签
				If LCase(Node.nodeName)="param" Then
					hasname=0
					hasvalue=0
					For each attributes1 in Node.attributes
						If LCase(attributes1.nodeName)="name" Then
							If LCase(attributes1.text)="autostart" Then
								hasname=1
							End If
						End If
						If LCase(attributes1.nodeName)="value" Then
								hasvalue=1
						End If
					Next
					If hasname=1 and hasvalue=1 Then
						For each attributes1 in Node.attributes
							If LCase(attributes1.nodeName)="value" Then
								Node.attributes.removeNamedItem(attributes1.nodeName)
							End If
						Next
						Node.attributes.setNamedItem(xml.createNode(2,"value","")).text="false"
					End If
				ElseIf LCase(Node.nodeName)="embed" Then
					For each attributes1 in Node.attributes
						If LCase(attributes1.nodeName)="autoplay" Then
							Node.attributes.removeNamedItem(attributes1.nodeName)
						End If
						If LCase(attributes1.nodeName)="src" Then
							thissrc=entity2Str(attributes1.text)
							If InStr(thissrc,".swf")> 0 Or InStr(thissrc,".swi") > 0 Then
								Node.attributes.removeNamedItem(attributes1.nodeName)
							End If
						End If
						
					Next
					Node.attributes.setNamedItem(xml.createNode(2,"autoplay","")).text="false"
				End If
			Next
		'加插媒体被禁止自动播放的标签
		
		For Each Node in xml.documentElement.getElementsByTagName("embed")
				Set titletext=node.attributes.getNamedItem("title")
				If titletext is nothing Then
					titletext=""
				Else
					titletext=titletext.text
				End If 
				If titletext<>UBB_TITLE Then
					Node.attributes.setNamedItem(xml.createNode(2,"title","")).text=UBB_TITLE
					Set xml1=Server.Createobject("msxml2.DOMDocument"& MsxmlVersion)
					Set thissrc=node.attributes.getNamedItem("src")
					If thissrc is nothing Then
						thissrc=""
					Else
						thissrc=entity2Str(thissrc.text)
					End If
					thissrc="<div>"& Node.xml& replace(Mtinfo,"$4",thissrc)&"</div>"
					If xml1.loadxml(thissrc) Then
						node.parentNode.replaceChild xml1.documentElement,node
						checktag mt,PostUserGroup
						Exit Sub
					End If	
				End If
		Next
		End If
		
		If instr(","& can_Post_Style &",",","& PostUserGroup &",") = 0 Then
			For Each Node in xml.documentElement.selectNodes("//@*")
				If LCase(Node.nodeName)="style" Then
					Stylestr=node.text
					Stylestr=split(Stylestr,";")
					newstyle=""
				 	For each style in Stylestr
				 		style1=split(style,":")
				 		If UBound(style1)>0 Then
				 			style_a=LCase(Trim(style1(0)))
					 		style_b=LCase(Trim(style1(1)))
					 		If UBound(style1)>1 Then
					 				For i =2 to UBound(style1)
					 				style_b=style_b& ":"& style1(i)
					 				Next
					 		End If
					 		'吃掉POSITION:,top,left几个属性
					 		If (style_a<>"top" and style_a<>"left" and style_a<>"bottom" and style_a<>"right" and style_a<>"" and style_a<> "position") Then
						 			'去掉过宽的属性
						 			If style_a="width" Then
						 				If InStr(style_b,"px")>0 Then
						 					style_b=replace(style_b,"px","")
						 					If IsNumeric(style_b) Then
						 						If CLng(style_b)>600 Then style_b=600
						 					End If
						 					style_b=style_b&"px"
						 				ElseIf InStr(style_b,"%")>0 Then
						 					style_b=replace(style_b,"%","")
						 					If IsNumeric(style_b) Then
						 						If CLng(style_b)>100 Then style_b=100
						 					End If
						 					style_b=style_b&"%"
						 			End If
					 				'去掉过大的字体
						 			If style_a = "font-size" Then
						 				If InStr(style_b,"px")>0 Then
						 					style_b=replace(style_b,"px","")
						 					If IsNumeric(style_b) Then
						 						If CLng(style_b)> 200 Then style_b=200
						 					End If
						 					style_b=style_b&"px"
						 				ElseIf InStr(style_b,"%")> 0 Then
						 					style_b=replace(style_b,"%","")
						 					If IsNumeric(style_b) Then
						 						If CLng(style_b)>100 Then style_b=100
						 					End If
						 					style_b=style_b&"%"
						 				End If
						 			End If
					 			End If 
					 			newstyle=newstyle&style_a&":"&style_b&";"
					 		End If
				 		End If
					Next
					node.text=newstyle
				End If
			Next
		End If
	End Sub
	Private Function checkXHTML(mt,PostUserGroup)
		checktag mt,PostUserGroup
		checkXHTML=Rexmlencode(Mid(xml.documentElement.xml,6,Len (xml.documentElement.xml)-11))
	End Function
	Function checkimg(textstr)
		Dim node,titletext,srctext,newnode
		If xml.loadxml("<div>" & xmlencode(textstr) &"</div>")Then
			For Each Node in xml.documentElement.getElementsByTagName("img")
				Set titletext=node.attributes.getNamedItem("title")
				If titletext is nothing Then
					titletext=""
				Else
					titletext=titletext.text
				End If 
				If titletext=UBB_TITLE Then
					Rem 是否开启滚轮改变图片大小的功能,如果不需要可以屏蔽
					Rem Node.attributes.setNamedItem(xml.createNode(2,"onmousewheel","")).text="return bbimg(this);"
					Node.attributes.setNamedItem(xml.createNode(2,"onload","")).text="imgresize(this);"
					Node.attributes.setNamedItem(xml.createNode(2,"alt","")).text="图片点击可在新窗口打开查看"	
				Else
					Rem 是否开启滚轮改变图片大小的功能,如果不需要可以屏蔽
					Rem Node.attributes.setNamedItem(xml.createNode(2,"onmousewheel","")).text="return bbimg(this);"
					Node.attributes.setNamedItem(xml.createNode(2,"onload","")).text="imgresize(this);"
					Node.attributes.setNamedItem(xml.createNode(2,"style","")).text="cursor: pointer;"
					Node.attributes.setNamedItem(xml.createNode(2,"alt","")).text="图片点击可在新窗口打开查看"
					Node.attributes.setNamedItem(xml.createNode(2,"onclick","")).text="javascript:window.open(this.src);"
					If Not node.parentNode is Nothing Then
						If node.parentNode.nodename = "a" Then
								node.attributes.removeNamedItem("onclick")
						End If
					End If
				End If
			Next
			checkimg=Rexmlencode(Mid(xml.documentElement.xml,6,Len (xml.documentElement.xml)-11))
		Else
			checkimg=textstr
		End If
	End Function
	Private Function bbimg(strText)
		Dim s
		s=strText
		re.Pattern="<img(.[^>]*)([/| ])>"
		s=re.replace(s,"<img$1/>")
		If InStr(Ubblists,",40,")=0 Then

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -