<%
Rem 除首页外通用函数
'Dvbbs.Board_Setting(40)是否继承上级版主，顺带取出上级论坛版面信息
'最多只取向上的10级版面信息
'输出导航菜单字串
Function CheckBoardInfo()
Dim i,node,nodelist,node1
Dvbbs.Boardmaster =False
If Dvbbs.BoardID>0 and Dvbbs.BoardParentID>0 Then
Dim TempData,NavStr
If Dvbbs.Master Then
Dvbbs.Boardmaster=True
ElseIf Dvbbs.Superboardmaster Then
Dvbbs.Boardmaster=True
ElseIf Dvbbs.UserGroupID =3 And Not Trim(Dvbbs.BoardMasterList) = "" Then
If Instr("|"&Dvbbs.BoardMasterList&"|","|"&Dvbbs.Membername&"|")>0 Then
Dvbbs.Boardmaster=True
End If
End If
ElseIf Dvbbs.BoardID>0 and Dvbbs.UserID>0 Then
If Dvbbs.Master Then
Dvbbs.Boardmaster=True
ElseIf Dvbbs.Superboardmaster Then
Dvbbs.Boardmaster=True
ElseIf Dvbbs.UserGroupID =3 And Not Trim(Dvbbs.BoardMasterList) = "" Then
If Instr("|"&LCase(Dvbbs.BoardMasterList)&"|","|"&LCase(Dvbbs.Membername)&"|")>0 Then
Dvbbs.Boardmaster=True
End If
End If
End If
If Dvbbs.BoardID>0 and Dvbbs.BoardParentID>0 Then
Set Nodelist=Dvbbs.BoardXML.documentElement.getElementsByTagName("board")
TempData=Split(Dvbbs.BoardNode.attributes.getNamedItem("parentstr").text,",")
For i=0 To Ubound(TempData)
If TempData(i)<>0 Then
For Each Node1 in nodelist
If Cstr(TempData(i))=Node1.attributes.getNamedItem("boardid").text Then
Set Node=Node1
Exit For
End If
Next
If i<9 Then
If Node.parentNode.nodeName<>"board" Then
NavStr=" "& Node.attributes.getNamedItem("boardtype").text &" "
Else
NavStr=NavStr& "→ "& Node.attributes.getNamedItem("boardtype").text &" "
End If
End If
'得到用户是否有继承斑竹的权限
If Cint(Dvbbs.Board_Setting(40))=1 And Not Dvbbs.Boardmaster Then
If Dvbbs.UserGroupID =3 Then
If instr("|"&lcase(Node.attributes.getNamedItem("boardmaster").text)&"|","|"&lcase(Dvbbs.MemberName)&"|")>0 Then
Dvbbs.Boardmaster=True
Else
Dvbbs.Boardmaster=False
End If
End If
End If
End If
Next
CheckBoardInfo=NavStr
End If
Call GetBoardPermission()
End Function
Rem 获得版面用户组权限配置
Public Sub GetBoardPermission()
Dim Rs,IsGroupSetting
IsGroupSetting = Dvbbs.IsGroupSetting
If IsGroupSetting<>"" And Not IsNull(IsGroupSetting) Then
IsGroupSetting = "," & IsGroupSetting & ","
If InStr(IsGroupSetting,"," & Dvbbs.UserGroupID & ",")>0 Then
Set Rs=Dvbbs.Execute("Select PSetting From Dv_BoardPermission Where Boardid="&Dvbbs.Boardid&" And GroupID="&Dvbbs.UserGroupID)
If Not (Rs.Eof And Rs.Bof) Then
Dvbbs.GroupSetting = Split(Rs(0),",")
End If
Set Rs=Nothing
End If
If Dvbbs.UserID>0 And InStr(IsGroupSetting,",0_"&Dvbbs.UserID&",")>0 Then
Set Rs=Dvbbs.execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid="&Dvbbs.BoardID&" And uc_UserID="&Dvbbs.Userid)
If Not(Rs.Eof And Rs.Bof) Then
Dvbbs.UserPermission=Split(Rs(0),",")
Dvbbs.GroupSetting = Split(Rs(0),",")
Dvbbs.FoundUserPer=True
End If
Set Rs=Nothing
End If
End If
If Dvbbs.Boardmaster Then Exit Sub
Call Chkboardlogin()
End Sub
Rem 能否进入论坛的判断
Public Sub Chkboardlogin()
If Dvbbs.Board_Setting(1)="1" And Dvbbs.GroupSetting(37)="0" Then Dvbbs.AddErrCode(26)
If Dvbbs.GroupSetting(0)="0" Then Dvbbs.AddErrCode(27)
'访问论坛限制(包括文章、积分、金钱、魅力、威望、精华、被删数、注册时间)
Dim BoardUserLimited
BoardUserLimited = Split(Dvbbs.Board_Setting(54),"|")
If Ubound(BoardUserLimited)=8 Then
'文章
If Trim(BoardUserLimited(0))<>"0" And IsNumeric(BoardUserLimited(0)) Then
If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=
本版面设置了用户发贴最少为 "&BoardUserLimited(0)&" 才能进入&action=OtherErr"
If Clng(Dvbbs.MyUserInfo(8))本版面设置了用户发贴最少为 "&BoardUserLimited(0)&" 才能进入&action=OtherErr"
End If
'积分
If Trim(BoardUserLimited(1))<>"0" And IsNumeric(BoardUserLimited(1)) Then
If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=
本版面设置了用户积分最少为 "&BoardUserLimited(1)&" 才能进入&action=OtherErr"
If Clng(Dvbbs.MyUserInfo(22))本版面设置了用户积分最少为 "&BoardUserLimited(1)&" 才能进入&action=OtherErr"
End If
'金钱
If Trim(BoardUserLimited(2))<>"0" And IsNumeric(BoardUserLimited(2)) Then
If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=
本版面设置了用户金钱最少为 "&BoardUserLimited(2)&" 才能进入&action=OtherErr"
If Clng(Dvbbs.MyUserInfo(21))本版面设置了用户金钱最少为 "&BoardUserLimited(2)&" 才能进入&action=OtherErr"
End If
'魅力
If Trim(BoardUserLimited(3))<>"0" And IsNumeric(BoardUserLimited(3)) Then
If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=
本版面设置了用户魅力最少为 "&BoardUserLimited(3)&" 才能进入&action=OtherErr"
If Clng(Dvbbs.MyUserInfo(23))本版面设置了用户魅力最少为 "&BoardUserLimited(3)&" 才能进入&action=OtherErr"
End If
'威望
If Trim(BoardUserLimited(4))<>"0" And IsNumeric(BoardUserLimited(4)) Then
If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=
本版面设置了用户威望最少为 "&BoardUserLimited(4)&" 才能进入&action=OtherErr"
If Clng(Dvbbs.MyUserInfo(24))本版面设置了用户威望最少为 "&BoardUserLimited(4)&" 才能进入&action=OtherErr"
End If
'精华
If Trim(BoardUserLimited(5))<>"0" And IsNumeric(BoardUserLimited(5)) Then
If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=
本版面设置了用户精华最少为 "&BoardUserLimited(5)&" 才能进入&action=OtherErr"
If Clng(Dvbbs.MyUserInfo(28))本版面设置了用户精华最少为 "&BoardUserLimited(5)&" 才能进入&action=OtherErr"
End If
'删贴
If Trim(BoardUserLimited(6))<>"0" And IsNumeric(BoardUserLimited(6)) Then
If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=
本版面设置了用户被删贴少于 "&BoardUserLimited(6)&" 才能进入&action=OtherErr"
If Clng(Dvbbs.MyUserInfo(27))>Clng(BoardUserLimited(6)) Then Response.redirect "showerr.asp?ErrCodes=
本版面设置了用户被删贴少于 "&BoardUserLimited(6)&" 才能进入&action=OtherErr"
End If
'注册时间
If Trim(BoardUserLimited(7))<>"0" And IsNumeric(BoardUserLimited(7)) Then
If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=
本版面设置了用户注册时间大于 "&BoardUserLimited(7)&" 分钟才能进入&action=OtherErr"
If DateDiff("s",Dvbbs.MyUserInfo(14),Now)本版面设置了用户注册时间大于 "&BoardUserLimited(7)&" 分钟才能进入&action=OtherErr"
End If
End If
'认证版块判断Board_Setting(2)
If Dvbbs.Board_Setting(2)="1" Then
Dim Get_BoardUser_Money,Canlogin
Get_BoardUser_Money = False
If Clng(Dvbbs.Board_Setting(62))>0 Or Clng(Dvbbs.Board_Setting(63))>0 Then Get_BoardUser_Money = True
Canlogin = False
If Dvbbs.UserID=0 Then
Dvbbs.AddErrCode(24)
Dvbbs.showerr()
Else
Dim Boarduser,i,BoardUser_Money
BoardUser = Dvbbs.boarduser
If Ubound(Boarduser)=-1 Then '为空时值等于-1
Canlogin = False
Else
For i = 0 To Ubound(Boarduser)
If Get_BoardUser_Money Then
BoardUser_Money = Split(Boarduser(i),"=")
If Trim(Lcase(BoardUser_Money(0))) = Trim(Lcase(Dvbbs.MemberName)) Then
'修改判断支付金币或点券进入版面的有效期 2004-8-29 Dv.Yz
If Not DateDiff("d",BoardUser_Money(1),Now()) > Cint(Dvbbs.Board_Setting(64))*30 Then
Canlogin = True
Exit For
End If
End If
Else
If Trim(Lcase(Boarduser(i))) = Trim(Lcase(Dvbbs.MemberName)) Then
Canlogin = True
Exit For
End If
End If
Next
End If
End If
If Get_BoardUser_Money And Instr(Lcase(Dvbbs.ScriptName),"pay_boardlimited")=0 And (Not Canlogin) Then Response.Redirect "pay_boardlimited.asp?boardid=" & Dvbbs.BoardID
If Instr(Lcase(Dvbbs.ScriptName),"pay_boardlimited")=0 And (Not Canlogin) Then
Dvbbs.AddErrCode(25)
End If
End If
Dvbbs.showerr()
End Sub
'得到论坛文字广告位部分内容,PageID=0为首页,=1为帖子列表页面,=2为帖子内容页面
Sub GetForumTextAd(PageID)
If Dvbbs.Forum_ads(12) = "1" Then
If PageID = 0 Or ((PageID = 1 And (Dvbbs.Forum_ads(15) = "0" Or Dvbbs.Forum_ads(15) = "2")) Or (PageID = 2 And (Dvbbs.Forum_ads(15) = "1" Or Dvbbs.Forum_ads(15) = "2")) And Not Dvbbs.Forum_ads(15) = "3") Then
Dim FoundCacheAd,CacheAdInfo
FoundCacheAd = False
If PageID = 0 Then
Dvbbs.Name = "Show_Index_TextAd"
If Not Dvbbs.ObjIsEmpty() Then
FoundCacheAd = True
CacheAdInfo = Dvbbs.Value
End If
Else
If Dvbbs.BoardID = 0 Then Exit Sub
If CacheAdInfo = Dvbbs.BoardNode.attributes.getNamedItem("textad").text="" Then
FoundCacheAd = True
CacheAdInfo = Dvbbs.BoardNode.attributes.getNamedItem("textad").text
End If
End If
If Not FoundCacheAd Then
Dim i,ColWidth,IsDvAd,ii,TempStr
Dvbbs.Forum_ads(16) = Split(Dvbbs.Forum_ads(16), Chr(10))
If Cint(Dvbbs.Forum_ads(17)) < 1 Then
ColWidth = 1
Else
ColWidth = Cint(Dvbbs.Forum_ads(17))
End If
ColWidth = 100/ColWidth
IsDvAd = 0
ii = 1
If IsSqlDataBase = 0 Then
IsDvAd = 1
ii = 2
TempStr = TempStr & "
"&vbNewLine&"
"
End If
For i = 0 To Ubound(Dvbbs.Forum_ads(16))
If i = 0 And IsDvAd = 1 Then
If Cint(Dvbbs.Forum_ads(17)) = 1 Then
TempStr = TempStr & vbNewLine & "
" & vbNewLine & "
" & vbNewLine & "
" & Dvbbs.Forum_ads(16)(i) & "
"
Else
TempStr = TempStr & vbNewLine & "
" & Dvbbs.Forum_ads(16)(i) & "
"
End If
ElseIf i = 0 Then
TempStr = TempStr & "
"&vbNewLine&"
"&Dvbbs.Forum_ads(16)(i)&"
"
Else
TempStr = TempStr & vbNewLine & "
"&Dvbbs.Forum_ads(16)(i)&"
"
End If
If Not ii < Cint(Dvbbs.Forum_ads(17)) Then
ii = 1
TempStr = TempStr & vbNewLine & "
"
If i <> Ubound(Dvbbs.Forum_ads(16)) Then TempStr = TempStr & vbNewLine & "
" & vbNewLine
Else
ii = ii + 1
End If
Next
If ii = 1 Then
ElseIf ii <> Cint(Dvbbs.Forum_ads(17)) + 1 Then
For i = 1 To (Cint(Dvbbs.Forum_ads(17)) - ii) + 1
TempStr = TempStr & vbNewLine & "
"
Next
TempStr = TempStr & vbNewLine & "
"
End If
Response.Write vbNewLine & Replace(Dvbbs.MainHtml(17),"{$GetTextAd}",TempStr)
If PageID = 0 Then
Dvbbs.Name = "Show_Index_TextAd"
Dvbbs.Value = vbNewLine & Replace(Dvbbs.MainHtml(17),"{$GetTextAd}",TempStr)
Else
CacheAdInfo = Dvbbs.BoardNode.attributes.getNamedItem("textad").text = vbNewLine & Replace(Dvbbs.MainHtml(17),"{$GetTextAd}",TempStr)
End If
Else
Response.Write CacheAdInfo
End if
End If
End If
End Sub
%>