📄 dv_ubbcode.asp
字号:
Private Function UBB_REPLYVIEW(strText,PostUserGroup,PostType)
Dim s
Dim Test
Dim vrs
s=strText
re.Pattern="\[REPLYVIEW\]"
Test=re.Test(s)
If Test Then
re.Pattern="\[\/REPLYVIEW\]"
Test=re.Test(s)
If Test Then
re.Pattern="\[REPLYVIEW\]"
s=re.replace(s, chr(1) & "REPLYVIEW" & chr(2))
re.Pattern="\[\/REPLYVIEW\]"
s=re.replace(s, chr(1) & "/REPLYVIEW" & chr(2))
re.Pattern="(\x01REPLYVIEW\x02)(\x01\/REPLYVIEW\x02)"
s=re.Replace(s,"")
re.Pattern="(\x01REPLYVIEW\x02)(.[^\x01]*)(\x01\/REPLYVIEW\x02)"
If (Cint(Dvbbs.Board_Setting(15))=1 or PostUserGroup<4) and PostType=1 Then
set vrs=dvbbs.execute("select AnnounceID from "&TotalUseTable&" where rootid="&Announceid&" and PostUserID="&Dvbbs.UserID)
If Dvbbs.Membername<>"" and (not (vrs.eof or vrs.bof) or Dvbbs.master) Then
s=re.Replace(s,"<hr noshade size=1><font color=gray>以下内容只有<B>回复</B>后才可以浏览</font><BR>$2<hr noshade size=1>")
Else
s=re.Replace(s,"<hr noshade size=1><font color="&Dvbbs.Mainsetting(1)&">以下内容只有<B>回复</B>后才可以浏览</font><hr noshade size=1>")
End If
vrs.close
set vrs=nothing
Else
s=re.Replace(s,"$2")
End If
re.Pattern="\x02"
s=re.replace(s, "]")
re.Pattern="\x01"
s=re.replace(s, "[")
End If
End If
UBB_REPLYVIEW=s
End Function
Private Function UBB_USEMONEY(strText,PostUserGroup,PostType)
Dim s
Dim Test
Dim po,ii,iii
Dim SplitBuyUser,iPostBuyUser
s=strText
Do While True
re.Pattern="\[USEMONEY=*([0-9]*)\]"
Test=re.Test(s)
If Test Then
re.Pattern="\[\/USEMONEY\]"
Test=re.Test(s)
If Test Then
re.Pattern="\[USEMONEY=*([0-9]*)\]"
s=re.replace(s, chr(1) & "USEMONEY=$1" & chr(2))
re.Pattern="\[\/USEMONEY\]"
s=re.replace(s, chr(1) & "/USEMONEY" & chr(2))
re.Pattern="(\x01USEMONEY=*([0-9]*)\x02)(\x01\/USEMONEY\x02)"
s=re.Replace(s,"")
If (Cint(Dvbbs.Board_Setting(23))=1 or PostUserGroup<4) and PostType=1 Then
re.Pattern="(^.*)(\x01USEMONEY=*([0-9]*)\x02)(.[^\x01]*)(\x01\/USEMONEY\x02)(.*)"
po=re.Replace(s,"$3")
If IsNumeric(po) Then
ii=int(po)
Else
ii=0
End If
If Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or Dvbbs.master) Then
If (not isnull(PostBuyUser)) and PostBuyUser<>"" Then
SplitBuyUser=split(PostBuyUser,"|")
iPostBuyUser="<option value=0>已购买用户</option>"
for iii=0 to ubound(SplitBuyUser)
iPostBuyUser=iPostBuyUser & "<option value="&iii&">"&SplitBuyUser(iii)&"</option>"
next
Else
iPostBuyUser="<option value=0>还没有用户购买</option>"
End If
s=re.Replace(s,"$1<hr noshade size=1><font color=gray>以下内容需要花费现金<B>$3</B>才可以浏览</font> <select size=1 name=buyuser>"&iPostBuyUser&"</select><BR>$4<hr noshade size=1>$6")
Else
If (not isnull(PostBuyUser)) and PostBuyUser<>"" Then
If instr("|"&PostBuyUser&"|","|"&Dvbbs.Membername&"|")>0 Then
s=re.Replace(s,"$1<hr noshade size=1><font color=gray>以下内容需要花费现金<B>$3</B>才可以浏览，您已经购买本帖</font><BR>$4<hr noshade size=1>$6")
Else
If UserPointInfo(0)>=ii Then
s=re.Replace(s,"$1<Form action=""BuyPost.asp"" mothod=post><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<B>$3</B>才可以浏览 <input type=hidden name=boardid value="&Dvbbs.boardid&"><input type=hidden value="&replyid&" name=replyid><input type=hidden value="&AnnounceID&" name=id><input type=hidden value="&totalusetable&" name=posttable><input type=submit name=submit value=好黑啊…我…我买了！> </font></form>$6")
Else
s=re.Replace(s,"$1<hr noshade size=1><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<B>$3</B>才可以浏览，您没有这么多现金</font><hr noshade size=1>$6")
End If
End If
Else
If UserPointInfo(0)>=ii Then
s=re.Replace(s,"$1<Form action=""BuyPost.asp"" mothod=post><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<B>$3</B>才可以浏览 <input type=hidden name=boardid value="&Dvbbs.boardid&"><input type=hidden value="&replyid&" name=replyid><input type=hidden value="&AnnounceID&" name=id><input type=hidden value="&totalusetable&" name=posttable><input type=submit name=submit value=好黑啊…我…我买了！> </font></form>$6")
Else
s=re.Replace(s,"$1<hr noshade size=1><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<B>$3</B>才可以浏览，您没有这么多现金</font><hr noshade size=1>$6")
End If
End If
End If
Else
re.Pattern="(\x01USEMONEY=*([0-9]*)\x02)(.[^\x01]*)(\x01\/USEMONEY\x02)"
s=re.Replace(s,"$3")
End If
re.Pattern="\x02"
s=re.replace(s, "]")
re.Pattern="\x01"
s=re.replace(s, "[")
Else
Exit Do
End If
Else
Exit Do
End If
Loop
Do While True
re.Pattern="\[USEMONEY=*([0-9]*),([0|1])\]"
Test=re.Test(s)
If Test Then
re.Pattern="\[\/USEMONEY\]"
Test=re.Test(s)
If Test Then
re.Pattern="\[USEMONEY=*([0-9]*),([0|1])\]"
s=re.replace(s, chr(1) & "USEMONEY=$1,$2" & chr(2))
re.Pattern="\[\/USEMONEY\]"
s=re.replace(s, chr(1) & "/USEMONEY" & chr(2))
re.Pattern="(\x01USEMONEY=*([0-9]*),([0|1])\x02)(\x01\/USEMONEY\x02)"
s=re.Replace(s,"")
If (Cint(Dvbbs.Board_Setting(23))=1 or PostUserGroup<4) and PostType=1 Then
re.Pattern="(^.*)(\x01USEMONEY=*([0-9]*),([0|1])\x02)(.[^\x01]*)(\x01\/USEMONEY\x02)(.*)"
po=re.Replace(s,"$3")
If IsNumeric(po) Then
ii=int(po)
Else
ii=0
End If
If Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or master) Then
If (not isnull(PostBuyUser)) and PostBuyUser<>"" Then
SplitBuyUser=split(PostBuyUser,"|")
iPostBuyUser="<option value=0>已购买用户</option>"
for iii=0 to ubound(SplitBuyUser)
iPostBuyUser=iPostBuyUser & "<option value="&iii&">"&SplitBuyUser(iii)&"</option>"
next
Else
iPostBuyUser="<option value=0>还没有用户购买</option>"
End If
s=re.Replace(s,"$1<hr noshade size=1><font color=gray>以下内容需要花费现金<B>$3</B>才可以浏览</font> <select size=1 name=buyuser>"&iPostBuyUser&"</select><BR>$5<hr noshade size=1>$7")
Else
If (not isnull(PostBuyUser)) and PostBuyUser<>"" Then
If instr("|"&PostBuyUser&"|","|"&Dvbbs.Membername&"|")>0 Then
s=re.Replace(s,"$1<hr noshade size=1><font color=gray>以下内容需要花费现金<B>$3</B>才可以浏览，您已经购买本帖</font><BR>$5<hr noshade size=1>$7")
Else
If UserPointInfo(0)>=ii Then
s=re.Replace(s,"$1<Form action=""BuyPost.asp"" mothod=post><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<B>$3</B>才可以浏览 <input type=hidden name=boardid value="&Dvbbs.boardid&"><input type=hidden value="&replyid&" name=replyid><input type=hidden value="&AnnounceID&" name=id><input type=hidden value="&totalusetable&" name=posttable><input type=submit name=submit value=好黑啊…我…我买了！> </font></form>$7")
Else
s=re.Replace(s,"$1<hr noshade size=1><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<B>$3</B>才可以浏览，您没有这么多现金</font><hr noshade size=1>$7")
End If
End If
Else
If UserPointInfo(0)>=ii Then
s=re.Replace(s,"$1<Form action=""BuyPost.asp"" mothod=post><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<B>$3</B>才可以浏览 <input type=hidden name=boardid value="&Dvbbs.boardid&"><input type=hidden value="&replyid&" name=replyid><input type=hidden value="&AnnounceID&" name=id><input type=hidden value="&totalusetable&" name=posttable><input type=submit name=submit value=好黑啊…我…我买了！> </font></form>$7")
Else
s=re.Replace(s,"$1<hr noshade size=1><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<B>$3</B>才可以浏览，您没有这么多现金</font><hr noshade size=1>$7")
End If
End If
End If
Else
re.Pattern="(\x01USEMONEY=*([0-9]*),([0|1])\x02)(.[^\x01]*)(\x01\/USEMONEY\x02)"
s=re.Replace(s,"$3")
End If
re.Pattern="\x02"
s=re.replace(s, "]")
re.Pattern="\x01"
s=re.replace(s, "[")
Else
Exit Do
End If
Else
Exit Do
End If
Loop
UBB_USEMONEY=s
End Function
Private Function dv_fixHTML(strText)
Dim s
s=strText
If InStr(Ubblists,",40,")>0 And (InStr(Ubblists,",table,")>0 Or InStr(Ubblists,",td,")>0 Or InStr(Ubblists,",th,")>0 Or InStr(Ubblists,",tr,")>0 ) Then
s = server.htmlencode(s)
s="<font color=""#FF3300"" title=""含无效标记"">"&s&"</font>"
End If
dv_fixHTML=s
End Function
Public Function Dv_FilterJS(v)
If Not Isnull(V) Then
Dim t
Dim reContent
re.Pattern="(&#)"
t=re.Replace(v,"<I>&#</I>")
re.Pattern="(var)"
t=re.Replace(t,"<I>var</I>")
re.Pattern="(function)"
t=re.Replace(t,"<I>function</I>")
re.Pattern="(meta)"
t=re.Replace(t,"<I>meta</I>")
're.Pattern="(button)"
't=re.Replace(t,"<I>button</I>")
're.Pattern="(window)"
't=re.Replace(t,"<I>window</I>")
re.Pattern="(script)"
t=re.Replace(t,"<I>script</I>")
re.Pattern="(js:)"
t=re.Replace(t,"<I>js:</I>")
're.Pattern="(value)"
't=re.Replace(t,"<I>value</I>")
re.Pattern="(about:)"
t=re.Replace(t,"<I>about:</I>")
re.Pattern="(file:)"
t=re.Replace(t,"<I>file:</I>")
re.Pattern="(Document.cookie)"
t=re.Replace(t,"<I>Documents.cookie</I>")
re.Pattern="(vbs:)"
t=re.Replace(t,"<I>vbs:</I>")
re.Pattern="((ifr|fr)ame)"
t=re.Replace(t,"<I>$2ame</I>")
re.Pattern="(on(mouse|Exit|error|key|load))"
t=re.Replace(t,"<I>on$2</I>")
Dv_FilterJS=t
End If
End Function
'用于论坛本身的过滤，不带脏话过滤
Public Function DviHTMLEncode(fString)
If Not IsNull(fString) Then
Dim s,re
s = fString
If InStr(Ubblists,",39,")>0 Then
s = Replace(s, CHR(13), "")
s = Replace(s, CHR(10), "</p><p> ")
's = Replace(s, CHR(10) & CHR(10), "</P><P> ")
's = Replace(s, CHR(10), "<BR> ")
's = replace(s, ">", ">")
's = replace(s, "<", "<")
End If
If InStr(Ubblists,",39,")=0 Or UbbLists="" Or IsNull(UbbLists) Then
s = replace(s, ">", ">")
s = replace(s, "<", "<")
s = Replace(s, CHR(32), "<I></I> ")
s = Replace(s, CHR(34), """)
s = Replace(s, CHR(39), "'")
s = Replace(s, CHR(13), "")
s = Replace(s, CHR(10) & CHR(10), "</P><P> ")
s = Replace(s, CHR(10), "<BR> ")
End If
s = Replace(s, CHR(9), " ")
DviHTMLEncode = s
End If
End Function
End Class
</script>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -