📄 dv_ubbcode.asp
字号:
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 + -