📄 dv_ubbcode.asp
字号:
'下载信息------------------------------------------
If Dvbbs.BoardID>0 Then
Dim TempStr,RowStr,UploadAddr,PromptInfo
Dim BoardUserLimited
TempStr = "<table border=""0"" cellspacing=""2"" class=""tableborder4"" style=""width:550px;"">"
TempStr = TempStr & "<tr><td colspan=""2"" height=""20"" class=""tablebody2""> <B>下载信息</B></td></tr>"
TempStr = TempStr & "{$uploadaddr}"
TempStr = TempStr & "{$row}"
TempStr = TempStr & "</table>"
BoardUserLimited = Split(Dvbbs.Board_Setting(55),"|")
RowStr=""
PromptInfo = "confirm('下载将扣除："
If UBound(BoardUserLimited)=12 Then
If BoardUserLimited(9)>0 Then
RowStr = RowStr & "<tr class=""tablebody1""><td style=""width:50%;height:20px;text-align:center"">扣除金币数</td><td>"&BoardUserLimited(9)&"</td></tr>"
PromptInfo = PromptInfo&"\n"&BoardUserLimited(9)&"金币"
End If
If BoardUserLimited(10)>0 Then
RowStr = RowStr & "<tr class=""tablebody1""><td style=""width:50%;height:20px;text-align:center"">扣除金钱数</td><td>"&BoardUserLimited(10)&"</td></tr>"
PromptInfo = PromptInfo&"\n"&BoardUserLimited(10)&"金钱"
End If
If BoardUserLimited(11)>0 Then
RowStr = RowStr & "<tr class=""tablebody1""><td style=""width:50%;height:20px;text-align:center"">扣除积分数</td><td>"&BoardUserLimited(11)&"</td></tr>"
PromptInfo = PromptInfo&"\n"&BoardUserLimited(11)&"积分"
End If
End If
PromptInfo = PromptInfo&"')"
If RowStr<>"" Then
TempStr = Replace(TempStr,"{$row}",RowStr)
Else
TempStr = Replace(TempStr,"{$row}","")
End If
If UserFlashGet=1 Then
If re.Test(s) Then
Set match = re.Execute(s)
downUrl = ServerHttp&"viewFile.asp?BoardID="&Dvbbs.Boardid&"&ID="&re.Replace(match.item(0),"$4")
downUrl = FlashgetEncode(downUrl,FlashGetID)
Set match = Nothing
If RowStr="" Then
UploadAddr = "<tr><td colspan=""2"" height=""20"" class=""tablebody1""><img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href=""viewFile.asp?BoardID="&Dvbbs.Boardid&"&ID=$4"" target=""_blank"">[点击浏览该文件:$3]</a> | <img "& DV_UBB_TITLE &" src=""skins/default/fgdown.gif"" border=""0"" /><a href=""#"" onClick=""ConvertURL2FG('"&downUrl&"','"&ServerHttp&"viewFile.asp?BoardID="&Dvbbs.Boardid&"&ID=$4',"&FlashGetID&");return false;"" fg="""&downUrl&""" oncontextmenu=""Flashget_SetHref(this)"">[快车下载]</a></td></tr>"
Else
UploadAddr = "<tr><td colspan=""2"" height=""20"" class=""tablebody1""><img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href=""viewFile.asp?BoardID="&Dvbbs.Boardid&"&ID=$4"" target=""_blank"" onClick=""return "&PromptInfo&";"">[点击浏览该文件:$3]</a> | <img "& DV_UBB_TITLE &" src=""skins/default/fgdown.gif"" border=""0"" /><a href=""#"" onClick=""if("&PromptInfo&") {ConvertURL2FG('"&downUrl&"','"&ServerHttp&"viewFile.asp?BoardID="&Dvbbs.Boardid&"&ID=$4',"&FlashGetID&");} return false;"" fg="""&downUrl&""" oncontextmenu=""Flashget_SetHref(this)"">[快车下载]</a></td></tr>"
End If
End If
Else
If RowStr="" Then
UploadAddr = "<tr><td colspan=""2"" height=""20"" class=""tablebody1""><img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href=""viewFile.asp?BoardID="&Dvbbs.Boardid&"&ID=$4"" target=""_blank"">点击浏览该文件:$3</a></td></tr>"
Else
UploadAddr = "<tr><td colspan=""2"" height=""20"" class=""tablebody1""><img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href=""viewFile.asp?BoardID="&Dvbbs.Boardid&"&ID=$4"" target=""_blank"" onClick=""return "&PromptInfo&";"">点击浏览该文件:$3</a></td></tr>"
End If
End If
TempStr = Replace(TempStr,"{$uploadaddr}",UploadAddr)
s = re.Replace(s,TempStr)
End If
re.Pattern="\x01\/upload]"
re.Pattern="\[upload=(\w+)(,|)([^\]]*)\]([^\x01]*)\x01\/UPLOAD\]"
If UserFlashGet=1 Then
If re.Test(s) Then
Set match = re.Execute(s)
downUrl = ServerHttp&re.Replace(match.item(0),"$4")
downUrl = FlashgetEncode(downUrl,FlashGetID)
Set match = Nothing
s= re.Replace(s,"<img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href=""$4"" target=""_blank"">[点击浏览该文件]</a> | <img "& DV_UBB_TITLE &" src=""skins/default/fgdown.gif"" border=""0"" /><a href=""#"" onClick=""ConvertURL2FG('"&downUrl&"','"&ServerHttp&"$4',"&FlashGetID&");return false;"" fg="""&downUrl&""" oncontextmenu=""Flashget_SetHref(this)"">[快车下载]</a>")
End If
Else
s= re.Replace(s,"<img "& DV_UBB_TITLE &" src=""skins/default/filetype/$1.gif"" border=""0"" /><a href=""$4"" target=""_blank"">点击浏览该文件</a>")
End If
re.Pattern="\x01\/upload]"
s=re.replace(s,"[/upload]")
Dv_UbbCode_U=s
End Function
Private Function Dv_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
Dv_UbbCode_Q=s
End Function
Private Function Dv_UbbCode_name(strText)
Dim s
Dim po,match
s=strText
re.Pattern="\[\/username\]"
s=re.Replace(s,Chr(1)&"/username]")
re.Pattern="\[username=([^\]]+)]([^\x01]*)\x01\/username\]"
If Cint(Board_Setting(56))=1 Then
Set match = re.Execute(s)
If match.count>0 Then
po=re.Replace(match.item(0),",$1,")
If Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or InStr(po,","&Dvbbs.Membername&",")>0 or Dvbbs.master) Then
s=re.Replace(s,"<hr /><font color=""red"">以下内容是专门发给<b>$1</b>浏览</font><br/>$2<hr />")
Else
s=re.Replace(s,"<hr /><font color=""gray"">以下内容是专门发给<b>$1</b>浏览</font><br/><hr />")
End If
End If
Else
s=re.Replace(s,"$2")
End If
re.Pattern="\x01\/username\]"
s=re.Replace(s,"[/username]")
Set match=Nothing
Dv_UbbCode_name=s
End Function
Private Function Dv_UbbCode_Get(strText,PostUserGroup,PostType,uCodeC,tCode1,tCode2,UsePoint,Flag)'帖子内容,发帖人组别,发帖类型,,,,,,用户积分,是否开放ubb标签
Dim s,ii,match
Dim LoopCount
s=strText
UsePoint=CLng(UsePoint)
re.Pattern="\["&uCodeC&"= *[0-9]*\][\s\n]*\[\/"&uCodeC&"\]"
s=re.replace(s,"")
re.Pattern="\[\/"&uCodeC&"\]"
s=re.replace(s,Chr(1)&"/"&uCodeC&"]")
re.Pattern="\["&uCodeC&"= *([0-9]+)\]([^\x01]*)\x01\/"&uCodeC&"\]"
If Issupport=1 Then
Dim matches
Set matches = re.Execute(s)
re.Global=False
For Each match In matches
If (Flag=1 or PostUserGroup<4) and PostType=1 Then
ii=int(match.SubMatches(0))
If Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or UsePoint>=ii or Dvbbs.master) Then
s=re.Replace(s,tCode1)
Else
s=re.Replace(s,tCode2)
End If
Else
s=re.Replace(s,"$2")
End If
LoopCount=LoopCount+1
If LoopCount>MaxLoopCount Then Exit For
Next
Set matches=Nothing
Else
Dim Test
re.Global=False
Test=re.Test(s)
Do While Test
If (Flag=1 or PostUserGroup<4) and PostType=1 Then
Set match = re.Execute(s)
ii=int(re.Replace(match.item(0),"$1"))
If Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or UsePoint>=ii or Dvbbs.master) Then
s=re.Replace(s,tCode1)
Else
s=re.Replace(s,tCode2)
End If
Else
s=re.Replace(s,"$2")
End If
LoopCount=LoopCount+1
If LoopCount>MaxLoopCount Then Exit Do
Test=re.Test(s)
Loop
Set match=Nothing
End If
re.Global=true
re.Pattern="\x01\/"&uCodeC&"\]"
s=re.replace(s,"[/"&uCodeC&"]")
Dv_UbbCode_Get=s
End Function
Private Function UBB_REPLYVIEW(strText,PostUserGroup,PostType)
Dim s
Dim vrs
s=strText
re.Pattern="\[replyview\][\s\n]*\[\/replyview\]"
s=re.Replace(s,"")
re.Pattern="\[\/replyview\]"
s=re.replace(s, chr(1)&"/replyview]")
re.Pattern="\[replyview\]([^\x01]*)\x01\/replyview\]"
If (Board_Setting(15)="1" or PostUserGroup<4) and PostType=1 Then
If isgetreed<>1 Then
Set vrs=dvbbs.execute("select AnnounceID from "&TotalUsetable&" where rootid="&Announceid&" and PostUserID="&Dvbbs.UserID)
isgetreed=1
If Not vRs.eof Then
reed=1
Else
reed=0
End If
Set vrs=Nothing
End If
If Dvbbs.Membername<>"" and (reed=1 or Dvbbs.master) Then
s=re.Replace(s,"<hr noshade=""noshade"" size=""1"" /><font color=""gray"">以下内容只有<b>回复</b>后才可以浏览</font><br/>$1<hr noshade=""noshade"" size=""1"" />")
Else
s=re.Replace(s,"<hr noshade=""noshade"" size=""1"" /><font color="""&Dvbbs.Mainsetting(1)&""">以下内容只有<b>回复</b>后才可以浏览</font><hr noshade=""noshade"" size=""1"" />")
End If
Else
s=re.Replace(s,"$1")
End If
re.Pattern="\x01\/replyview\]"
s=re.replace(s, "[/replyview]")
UBB_REPLYVIEW=s
End Function
Private Function UBB_USEMONEY(strText,PostUserGroup,PostType)
Dim s
Dim Test
Dim ii,iii,match,buied
Dim SplitBuyUser,iPostBuyUser
Dim LoopCount
s=strText
re.Global=False
re.Pattern="\[USEMONEY=*([0-9]+)\]((.|\n)*)\[\/USEMONEY\]"
Test=re.Test(s)
If Test Then
If T_GetMoneyType >0 Then
s=re.Replace(s,"<hr size=""1"" /><font color=""gray"">由于使用了金币帖子设置，因此出售帖UBB模式失效，以下是帖子内容：</font> <br />$2<hr size=""1"" />")
Else
If (Cint(Board_Setting(23))=1 or PostUserGroup<4) and PostType=1 Then
Set match = re.Execute(s)
ii=int(re.Replace(match.item(0),"$1"))
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,"<hr noshade=""noshade"" size=""1"" /><font color=""gray"">以下内容需要花费现金<b>$1</b>才可以浏览</font> <select size=""1"" name=""buyuser"">"&iPostBuyUser&"</select><br/>$2<hr noshade=""noshade"" size=""1"" />")
re.Global=true
re.Pattern="\[\/?USEMONEY=*[0-9]*\]"
s=re.Replace(s,"")
Else
buied=0
If (Not IsNull(PostBuyUser)) and PostBuyUser<>"" Then
If Instr("|"&PostBuyUser&"|","|"&Dvbbs.Membername&"|")>0 Then buied=1
End If
If buied=1 Then
s=re.Replace(s,"<hr noshade=""noshade"" size=""1"" /><font color=""gray"">以下内容需要花费现金<b>$1</b>才可以浏览，您已经购买本帖</font><br/>$2<hr noshade=""noshade"" size=""1"" />")
re.Global=true
re.Pattern="\[\/?USEMONEY=*[0-9]*\]"
s=re.Replace(s,"")
Else
If Clng(UserPointInfo(0))>=ii Then
s=re.Replace(s,"<form action=""BuyPost.asp"" mothod=""post""><font color="""&Dvbbs.Mainsetting(1)&""">以下内容需要花费现金<b>$1</b>才可以浏览，您目前有现金<b>"&UserPointInfo(0)&"</b>。<br/><br/> <input type=""hidden"" name=""boardid"" value="""&Dvbbs.boardid&""" /><input type=""hidden"" value="""&replyid_a&""" name=""replyid"" /><input type=""hidden"" value="""&AnnounceID_a&""" name=""id"" /><input type=""hidden"" value="""&RootID_a&""" name=""rootid""/><input type=""hidden"" value="""&totalusetable&""" name=""posttable"" /><input type=""submit"" name=""submit"" value=""好黑啊…我…我买了！"" /> </font></form>")
Else
s=re.Replace(s,"<hr noshade=""noshade"" size=""1"" /><font color="""&Dvbbs.Mainsetting(1)&""">以下内容需要花费现金<b>$1</b>才可以浏览，您只有现金<b>"&UserPointInfo(0)&"</b>，无法购买。</font><hr noshade=""noshade"" size=""1"" />")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -