📄 ubb_cls.asp
字号:
<%Const MaxLoopcount=100%>
<script language=vbscript runat=server>
Class YxBBsubb_Cls
Public UbbString,Re
Private Sub Class_Initialize()
End Sub
Rem 入口(内容，1=帖子|2=留言公告等)
Public Function Ubb(Str,PostType)
If isNull(Str) or Str="" then
Ubb=""
Exit function
End if
If UbbString="" Or IsNull(UbbString) Then
UbbString=YxBBs.Fun.UbbString(Str)
End If
If instr(UbbString,",41,")>0 And PostType=1 Then
Str=YxBBs_Code(Str,PostType)
Else
Str=YxBBs_UBB(str,postType)
End If
UBB=Str
End Function
Private Function YxBBs_UBB(Str,PostType)
If isNull(Str) or Str="" then
YxBBs_UBB=""
Exit function
End if
Str=Html_Code(Str)
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
If InStr(UbbString,",0,")>0 Then
re.pattern="((javascript:)|(jscript:)|(object)|(js:)|(location.)|(vbscript:)|(vbs:)|(\.value)|(about:)|(file:)|(document.cookie)|(on(mouse|exit|error|click|key|load)))"
str=re.replace(str,"<font color=#000000>$1</font>")
End If
If InStr(UbbString,",35,")>0 Then Str=YxBBs_Ubb_Login(Str,PostType)
If InStr(UbbString,",36,")>0 Then Str=YxBBs_Ubb_Sex(Str,PostType)
If InStr(UbbString,",37,")>0 Then Str=YxBBs_Ubb_Name(Str,PostType)
If InStr(UbbString,",38,")>0 Then Str=YxBBs_Ubb_Date(Str,PostType)
If InStr(UbbString,",39,")>0 Then Str=YxBBs_Ubb_Reply(Str,PostType)
If InStr(UbbString,",40,")>0 Then Str=YxBBs_Ubb_Buy(Str,PostType)
If InStr(UbbString,",24,")>0 Then Str=YxBBs_Ubb2(Str,"\[img\]","\[\/img\]","<img src=$1>","",YxBBs.BBSSetting(22))
If InStr(UbbString,",25,")>0 Then
If YxBBs.BBSSetting(22)="0" Then
If Not YxBBs.FoundUser and YxBBs.BBSSetting(55)="0" Then
Str=YxBBs_Ubb3(Str,"\[upload=(txt|zip|rar|mdb|swf),*(#*[0-9\.]*),*(#*[0-9\.]*),*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]","<fieldset><legend>上传的附件</legend><br> <font color=gray>抱歉,您所在的组无权下载附件,请<a href=register.asp>注册</a>或<a href=login.asp>登陆</a>.</font><br><br></fieldset>")
Str=YxBBs_Ubb2(Str,"\[upload=(gif|jpg|jpeg|bmp|png),*(#*[0-9\.]*),([0-9]{1,3}),*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]","<fieldset><legend>上传的图片</legend><br> <font color=gray>抱歉,您所在的组无权下载附件,请<a href=register.asp>注册</a>或<a href=login.asp>登陆</a></font></fieldset>","",YxBBs.BBSSetting(22))
Else
Str=YxBBs_Ubb3(Str,"\[upload=(txt|zip|rar|mdb|swf),*(#*[0-9\.]*),*(#*[0-9\.]*),*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]","<fieldset><legend>上传的附件</legend><br> <IMG SRC=INc/Editor/images/common.gif align=absmiddle> <a href=""ViewFile.Asp?FileName=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB ]<br><br></fieldset>")
Str=YxBBs_Ubb2(Str,"\[upload=(gif|jpg|jpeg|bmp|png),*(#*[0-9\.]*),([0-9]{1,3}),*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]","<fieldset><legend>上传的图片</legend><br> <img src=INc/Editor/images/image.gif align=absmiddle> <A HREF=""ViewFile.Asp?FileName=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB <font color=blue>$4</font>×<font color=blue>$5</font> ] <font color=#999999>(缩略时请点击查看原图)</font><br><br> <IMG SRC=""ViewFile.Asp?FileName=$6"" border=0><br><br></fieldset>","<A HREF=""ViewFile.Asp?FileName=$6"" TARGET=_blank>$6</a>",YxBBs.BBSSetting(22))
End If
End If
End If
If InStr(UbbString,",31,")>0 Then Str=UbbCode_Q(Str)
If InStr(UbbString,",32,")>0 Then Str=YxBBs_GetUBB(Str,"\[coin=*([0-9]*)\]","\[\/coin\]","$1<hr noshade size=1><font color=gray>以下内容需要金钱数达到<B>$3</B>才可以浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要金钱数达到<B>$3</B>才可以浏览</font><hr noshade size=1>$6",PostType,YxBBs.MyCoin)
If InStr(UbbString,",33,")>0 Then Str=YxBBs_GetUBB(Str,"\[mark=*([0-9]*)\]","\[\/mark\]","$1<hr noshade size=1><font color=gray>以下内容需要积分数达到<B>$3</B>才可以浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要积分数达到<B>$3</B>才可以浏览</font><hr noshade size=1>$6",PostType,YxBBs.MyMark)
If InStr(UbbString,",34,")>0 Then Str=YxBBs_GetUBB(Str,"\[grade=*([0-9]*)\]","\[\/grade\]","$1<hr noshade size=1><font color=gray>以下内容需要等级为 <b>$3</b> 或更高的等级以及作者才能浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要等级为<B>$3</B>或更高的等级以及作者才可以浏览</font><hr noshade size=1>$6",PostType,YxBBs.MyGradeNum)
re.Pattern="\[cc\](.*?)\[\/cc\]"
str= re.Replace(str,"<embed src=""http://union.bokecc.com/$1"" width=""438"" height=""387"" type=""application/x-shockwave-flash""></embed>")
re.Pattern="<img(.[^>]*)>"
str=re.replace(str,"<img$1 onmousewheel=""return bbimg(this)"" onload=""javascript:if(this.width>screen.width-500) this.style.width=screen.width-500;"" border=0>")
Set re=Nothing
YxBBs_UBB=Str
End function
Private Function Html_Code(byval Str)
If IsNull(Str) then
Html_code=""
Else
Str=replace(Str,chr(39),"'")
Str=replace(Str,chr(36),"$")
str = Replace(str, "SCRIPT", "script")
Str = Replace(Str, chr(10) &chr(10), "<br><br> ")
Html_Code = Replace(Str, chr(10), "<p></p>")
End if
End Function
Public Function Sign_Code(byval Str)
If IsNull(Str) or Str="" Then
Sign_Code=""
Exit Function
End If
Str=Html_Code(Str)
Set re=new regExp
re.IgnoreCase=true
re.Global=true
re.pattern="((javascript:)|(jscript:)|(object)|(js:)|(location.)|(vbscript:)|(vbs:)|(\.value)|(about:)|(file:)|(document.cookie)|(on(mouse|exit|error|click|key|load)))"
str=re.replace(str,"<font color=#000000>$1</font>")
If InStr(Lcase(Str),"[/b]")>0 Then Str=YxBBs_Ubb1(Str,"\[b\]","\[\/b\]","<b>$1</b>")
If InStr(Lcase(Str),"[/i]")>0 Then Str=YxBBs_Ubb1(Str,"\[i\]","\[\/i\]","<i>$1</i>")
If InStr(Lcase(Str),"[/u]")>0 Then Str=YxBBs_Ubb1(Str,"\[u\]","\[\/u\]","<u>$1</u>")
If InStr(Lcase(Str),"[/fly]")>0 Then Str=YxBBs_Ubb1(Str,"\[fly\]","\[\/fly\]","<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
If InStr(Lcase(Str),"[/url]")>0 Then Str=YxBBs_Ubb1(Str,"\[url=(.{5,}?)\]","\[\/url\]","<a href=""$1"" target='_blank'>$2</a>")
If InStr(Lcase(Str),"[/color]")>0 Then Str=YxBBs_Ubb1(Str,"\[color=((#.{6})|.{3,6})\]","\[\/color\]","<font color=#$1>$3</font>")
If InStr(Lcase(Str),"[/img]")>0 Then Str=YxBBs_Ubb2(Str,"\[img\]","\[\/img\]","<img src=$1 border=0 onload=""javascript:if(this.width>screen.width-333)this.width=screen.width-333"" >","",YxBBs.BBSSetting(22))
Set re=nothing
Sign_Code=Str
End Function
Private Function UbbCode_Q(strText)
Dim s
Dim Test
Dim LoopCount
LoopCount=0
s=strText
re.Pattern="\[QUOTE\]"
Test=re.Test(s)
If Test Then
re.Pattern="\[\/QUOTE\]"
Test=re.Test(s)
If Test Then
re.Pattern="\[QUOTE\]"
s=re.replace(s, chr(1) & "QUOTE" & chr(2))
re.Pattern="\[\/QUOTE\]"
s=re.replace(s, chr(1) & "/QUOTE" & chr(2))
Do
re.Pattern="\x01QUOTE\x02\x01\/QUOTE\x02"
s=re.Replace(s,"")
re.Pattern="\x01QUOTE\x02(.[^\x01]*)\x01\/QUOTE\x02"
s=re.Replace(s,"<table cellpadding=0 cellspacing=0 border=1 WIDTH='90%' style='border-collapse: collapse' bordercolor=#CCCCCC align=center><tr><td bgcolor='#f2f8ff'><p style='margin:15'>$1</p></td></tr></table><br>")
Test=re.Test(s)
LoopCount=LoopCount+1
If LoopCount>MaxLoopCount Then Exit Do
Loop While(Test)
re.Pattern="\x02"
s=re.replace(s, "]")
re.Pattern="\x01"
s=re.replace(s, "[")
End If
End If
UbbCode_Q=s
End Function
Private Function YxBBs_Ubb1(Str,uCodeL,uCodeR,tCode)
Dim s
s=str
re.Pattern=uCodeL&uCodeR
s=re.Replace(s,"")
re.Pattern=uCodeL&"(.+?)"&uCodeR
s=re.Replace(s,tCode)
re.Pattern=uCodeL
s=re.Replace(s,"")
re.Pattern=uCodeR
s=re.Replace(s,"")
YxBBs_Ubb1=s
End Function
Private Function YxBBs_Ubb2(Str,uCodeL,uCodeR,tCode1,tCode2,BBSCheck)
Dim s
s=str
re.Pattern=uCodeL&uCodeR
s=re.Replace(s,"")
re.Pattern=uCodeL&"(.+?)"&uCodeR
If BBScheck="0" Then
s=re.Replace(s,tCode1)
Else
s=re.Replace(s,tCode2)
End If
re.Pattern=uCodeL
s=re.Replace(s,"")
re.Pattern=uCodeR
s=re.Replace(s,"")
YxBBs_Ubb2=s
End Function
Private Function YxBBs_Ubb3(Str,uCodeL,uCodeR,tCode)
Dim s
s=str
re.Pattern=uCodeL&uCodeR
s=re.Replace(s,"")
re.Pattern=uCodeL&"(.+?)"&uCodeR
s=re.Replace(s,tCode)
YxBBs_Ubb3=s
End Function
Private Function YxBBs_Code(Str,PostType)
dim ary_String,i,n,n_pos
ary_String=split(Str,"[code]")
n=ubound(ary_String)
If n<1 then
YxBBs_Code=YxBBs_UBB(Str,PostType)
Exit function
End If
ary_String(0)=YxBBs_UBB(ary_String(0),postType)
for i=1 to n
n_pos=inStr(ary_String(i),"[/code]")
If n_pos>0 then
ary_String(i)="<table cellpadding=0 cellspacing=0 border=1 WIDTH='98%' style='border-collapse: collapse' bordercolor=#CCCCCC align=center><tr><td bgcolor='#f2f8ff'><p style='margin:15'><b>本贴相关代码：</b><br>" & left(ary_String(i),n_pos-1) & "</p></td></tr></table><br>" & YXBBS_UBB(right(ary_String(i),len(ary_String(i))-n_pos-6),PostType)
Else
ary_String(i)="[code]" & YxBBs_UBB(ary_String(i),PostType)
End if
next
YxBBs_Code=join(ary_String,"")
End Function
Rem 入口（内容,开始的UBB，结束的UBB，显示允许，显示不允许，标记：1=帖子/2=留言公告，用户的信息）
Rem (Str,"\[grade=*([0-9]*)\]","\[\/grade\]","$1<hr noshade size=1><font color=gray>以下内容需要等级为 <b>$3</b> 或更高的等级以及作者才能浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要等级为<B>$3</B>或更高的等级以及作者才可以浏览</font><hr noshade size=1>$6",PostType,YxBBs.MyGrade)
Private Function YxBBs_GetUBB(Str,uCodeL,uCodeR,tCode1,tCode2,postType,MyInfo)
Dim Test
Dim po,ii
Dim LoopCount
LoopCount=0
Do While True
re.Pattern=uCodeL
Test=re.Test(Str)
If Test Then
re.Pattern=uCodeR
Test=re.Test(Str)
If Test Then
If PostType=1 Then
re.Pattern="(^.*)("&uCodeL&")(.+?)("&uCodeR&")(.*)"
po=re.Replace(Str,"$3")
If IsNumeric(po) Then
ii=int(po)
Else
ii=0
End If
If YxBBs.Founduser and (Lcase(YxBBs.MyName)=Lcase(UserName) or int(MyInfo)>=int(ii) or YxBBs.ClassID<=2 or YxBBs.IsBoardAdmin) Then
Str=re.Replace(str,tCode1)
Else
Str=re.Replace(str,tCode2)
End If
Else
re.Pattern="("&uCodeL&")(.+?)("&uCodeR&")"
s=re.Replace(s,"$3")
End If
Else
Exit Do
End If
Else
Exit Do
End If
LoopCount=LoopCount + 1
If LoopCount>MaxLoopCount Then Exit Do
Loop
YxBBs_GetUBB=Str
End Function
Private Function YxBBs_Ubb_Login(Str,PostType)
Dim Test
Dim LoopCount
LoopCount=0
Do While True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -