dv_clsother.asp

现在好了

<%
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
			'------------------------------------
			Set node = Dvbbs.BoardXML.selectSingleNode("//*[@boardid='"&TempData(i)&"']")
			If Not (node Is Nothing) 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=" <a href=""index.asp?boardid="&TempData(i)&""" onMouseOver=""showmenu(event,BoardJumpList("&Node.attributes.getNamedItem("boardid").text&"),'',0);"">"& Node.attributes.getNamedItem("boardtype").text &"</a> "
					Else
						NavStr=NavStr& "→ <a href=""index.asp?boardid="&TempData(i)&""">"& Node.attributes.getNamedItem("boardtype").text &"</a> "
					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
			'------------------------------------
		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=<li>本版面设置了用户发贴最少为 <B>"&BoardUserLimited(0)&"</B> 才能进入&action=OtherErr"
			If Clng(Dvbbs.MyUserInfo(8))<Clng(BoardUserLimited(0)) Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户发贴最少为 <B>"&BoardUserLimited(0)&"</B> 才能进入&action=OtherErr"
		End If
		'积分
		If Trim(BoardUserLimited(1))<>"0" And IsNumeric(BoardUserLimited(1)) Then
			If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户积分最少为 <B>"&BoardUserLimited(1)&"</B> 才能进入&action=OtherErr"
			If Clng(Dvbbs.MyUserInfo(22))<Clng(BoardUserLimited(1)) Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户积分最少为 <B>"&BoardUserLimited(1)&"</B> 才能进入&action=OtherErr"
		End If
		'金钱
		If Trim(BoardUserLimited(2))<>"0" And IsNumeric(BoardUserLimited(2)) Then
			If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户金钱最少为 <B>"&BoardUserLimited(2)&"</B> 才能进入&action=OtherErr"
			If Clng(Dvbbs.MyUserInfo(21))<Clng(BoardUserLimited(2)) Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户金钱最少为 <B>"&BoardUserLimited(2)&"</B> 才能进入&action=OtherErr"
		End If
		'魅力
		If Trim(BoardUserLimited(3))<>"0" And IsNumeric(BoardUserLimited(3)) Then
			If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户魅力最少为 <B>"&BoardUserLimited(3)&"</B> 才能进入&action=OtherErr"
			If Clng(Dvbbs.MyUserInfo(23))<Clng(BoardUserLimited(3)) Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户魅力最少为 <B>"&BoardUserLimited(3)&"</B> 才能进入&action=OtherErr"
		End If
		'威望
		If Trim(BoardUserLimited(4))<>"0" And IsNumeric(BoardUserLimited(4)) Then
			If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户威望最少为 <B>"&BoardUserLimited(4)&"</B> 才能进入&action=OtherErr"
			If Clng(Dvbbs.MyUserInfo(24))<Clng(BoardUserLimited(4)) Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户威望最少为 <B>"&BoardUserLimited(4)&"</B> 才能进入&action=OtherErr"
		End If
		'精华
		If Trim(BoardUserLimited(5))<>"0" And IsNumeric(BoardUserLimited(5)) Then
			If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户精华最少为 <B>"&BoardUserLimited(5)&"</B> 才能进入&action=OtherErr"
			If Clng(Dvbbs.MyUserInfo(28))<Clng(BoardUserLimited(5)) Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户精华最少为 <B>"&BoardUserLimited(5)&"</B> 才能进入&action=OtherErr"
		End If
		'删贴
		If Trim(BoardUserLimited(6))<>"0" And IsNumeric(BoardUserLimited(6)) Then
			If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户被删贴少于 <B>"&BoardUserLimited(6)&"</B> 才能进入&action=OtherErr"
			If Clng(Dvbbs.MyUserInfo(27))>Clng(BoardUserLimited(6)) Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户被删贴少于 <B>"&BoardUserLimited(6)&"</B> 才能进入&action=OtherErr"
		End If
		'注册时间
		If Trim(BoardUserLimited(7))<>"0" And IsNumeric(BoardUserLimited(7)) Then
			If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户注册时间大于 <B>"&BoardUserLimited(7)&"</B> 分钟才能进入&action=OtherErr"
			If DateDiff("s",Dvbbs.MyUserInfo(14),Now)<Clng(BoardUserLimited(7))*60 Then Response.redirect "showerr.asp?ErrCodes=<li>本版面设置了用户注册时间大于 <B>"&BoardUserLimited(7)&"</B> 分钟才能进入&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 & "  <tr align=center>"&vbNewLine&"    <td width="""&ColWidth&"%"" class=tablebody1><iframe src="""&Dvbbs_Server_Url&"dvbbs/DvDefaultTextAd.asp"" height=23 width=""100%"" MARGINWIDTH=0 MARGINHEIGHT=0 HSPACE=0 VSPACE=0 FRAMEBORDER=0 SCROLLING=no></iframe></td>"
			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 & "  </tr>" & vbNewLine & "  <tr align=center>" & vbNewLine & "    <td width=""" & ColWidth & "%"" class=tablebody1 height=23>" & Dvbbs.Forum_ads(16)(i) & "</td>"
					Else
						TempStr = TempStr & vbNewLine & "    <td width=""" & ColWidth & "%"" class=tablebody1 height=23>" & Dvbbs.Forum_ads(16)(i) & "</td>"
					End If
				ElseIf i = 0 Then
					TempStr = TempStr & "  <tr align=center>"&vbNewLine&"    <td width="""&ColWidth&"%"" class=tablebody1 height=23>"&Dvbbs.Forum_ads(16)(i)&"</td>"
				Else
					TempStr = TempStr & vbNewLine & "    <td width="""&ColWidth&"%"" class=tablebody1 height=23>"&Dvbbs.Forum_ads(16)(i)&"</td>"
				End If
				If Not ii < Cint(Dvbbs.Forum_ads(17)) Then
					ii = 1
					TempStr = TempStr & vbNewLine & "  </tr>"
					If i <> Ubound(Dvbbs.Forum_ads(16)) Then TempStr = TempStr & vbNewLine & "  <tr align=center>" & 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 & "    <td width="""&ColWidth&"%"" class=tablebody1 height=23>&nbsp;</td>"
				Next
				TempStr = TempStr & vbNewLine & "  </tr>"
			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
%>