dv_clsmain.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

			Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@simplenesscount").text=Board_setting(41)
			Rs.MoveNext
		Loop
		''Set Application(CacheName&"_sboardlist")=Application(CacheName&"_boardlist").cloneNode(True)
		'For each node in Application(CacheName&"_sboardlist").documentElement.selectNodes("board")
			'node.attributes.removeNamedItem("readme")
			'node.attributes.removeNamedItem("simplenesscount")
			'node.attributes.removeNamedItem("mode")
			'node.attributes.removeNamedItem("checklock")
			'node.attributes.removeNamedItem("checkout")
			'node.attributes.removeNamedItem("parentstr")
			'node.attributes.removeNamedItem("indeximg")
		'Next
		'MakBoardNav 0 ,""
		Application.unLock
		Rs.Close
		Set Rs= Nothing
	End Sub
	Public Sub MakBoardNav(parentid,Node1)
		Dim Node,Dom
		'If parentid=0 Then 	
			'Set Application(CacheName&"_ssboardlist")=Server.CreateObject("Msxml2.FreeThreadedDOMDocument" & MsxmlVersion )
			'Set Node1=Application(CacheName&"_boardlist").appendChild(Application(CacheName&"_boardlist").createElement("BoardList"))
		'End If
		'For Each Node in Application(CacheName&"_boardlist").documentElement.selectNodes("board[@parentid="&parentid&"]")
			'MakBoardNav Node.selectSingleNode("@boardid").text,Node1.appendChild(Node.cloneNode(True))
		'Next
	End Sub
	Public Sub LoadPlusMenu()
		Name = "ForumPlusMenu"
		Dim Rs,XMLDom,Node,plus_setting,stylesheet,XMLStyle,proc
		Set Rs=Execute("Select id,plus_type,plus_name,mainpage,plus_copyright,plus_setting,isshowmenu as width,isshowmenu as height From Dv_Plus Where  Isuse=1 Order By ID")
		Set XMLDom=RecordsetToxml(rs,"plus","")
		Set Rs=Nothing
		For Each Node In XMLDom.documentElement.selectNodes("plus")
			plus_setting=Split(Split(node.selectSingleNode("@plus_setting").text,"|||")(0),"|")
			node.selectSingleNode("@plus_setting").text=plus_setting(0)
			node.selectSingleNode("@width").text=plus_setting(1)
			node.selectSingleNode("@height").text=plus_setting(2)
		Next
		Set XMLStyle=Server.CreateObject("msxml2.XSLTemplate" & MsxmlVersion)

		Set stylesheet=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		
		stylesheet.load Server.MapPath(MyDbPath &"inc\Templates\plusmenu.xslt")
		'DvXmlDom.createDocumentFragment()
		'Response.Write DvXmlDom.xml
		'Response.End
		XMLStyle.stylesheet=stylesheet
		Set proc=XMLStyle.createProcessor()
		proc.input = XMLDom
  	proc.transform()
  	value=proc.output
	End Sub
	Public Sub LoadBoardData(bid)
		Dim Rs
		Set Rs=Execute("select boardid,boarduser,board_ads,board_user,isgroupsetting,rootid,board_setting,sid,cid,Rules From Dv_board Where Boardid="&bid)
		Set Application(CacheName &"_boarddata_" & bid)=RecordsetToxml(rs,"boarddata","")
		Rs.Close
		Set Rs= Nothing
	End Sub

	Public Sub LoadBoardinformation(bid)'加载动态板面信息数据
		Dim Rs,lastpost,i
		Set Rs=Execute("select boardid,boardtopstr,postnum,topicnum,todaynum,lastpost as lastpost_0 From Dv_board Where Boardid="&bid)
		Set Application(CacheName &"_information_" & bid)=RecordsetToxml(rs,"information","")
		lastpost=Split(Application(CacheName &"_information_" & bid).documentElement.selectSingleNode("information/@lastpost_0").text,"$")
		For i=0 to UBound(lastpost)
			Application(CacheName &"_information_" & bid).documentElement.firstChild.setAttribute "lastpost_"& i,lastpost(i)
			If i = 7 Then Exit For
		Next
		Rs.Close
		Set Rs= Nothing
	End Sub

	Public Sub LoadAllBoardinformation()'加载所有板面信息数据
		Dim Rs,lastpost,i
		Dim TempXmlDom,Node,TempNode,TempXmlDom1
		Set Rs=Execute("select boardid,boardtopstr,postnum,topicnum,todaynum,lastpost as lastpost_0 From Dv_board Order by Orders")
		Set TempXmlDom = RecordsetToxml(rs,"information","")
		Rs.Close
		Set Rs = Nothing
		For Each Node In TempXmlDom.documentElement.selectNodes("information")
			lastpost=Split(Node.getAttribute("lastpost_0"),"$")
			For i=0 to UBound(lastpost)
				Node.setAttribute "lastpost_"& i,lastpost(i)
				If i = 7 Then Exit For
			Next
			Set TempXmlDom1=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
			Set TempNode = TempXmlDom1.appendChild(TempXmlDom1.createNode(1,"xml",""))
			TempNode.appendChild(Node)
			Application.Lock
			Set Application(CacheName &"_information_" & Node.getAttribute("boardid")) = TempXmlDom1
			Application.UnLock
		Next
		If IsObject(TempXmlDom1) Then Set TempXmlDom1 = Nothing
	End Sub

	Public Sub LoadGroupSetting()
		Dim Rs
		Set Rs=Dvbbs.Execute("Select GroupSetting,UserGroupID,ParentGID,IsSetting,UserTitle From Dv_UserGroups")
		Set Application(CacheName &"_groupsetting")=RecordsetToxml(rs,"usergroup","")
		Set Rs=Dvbbs.Execute("Select UserGroupID,usertitle,titlepic,orders From Dv_UserGroups order by orders")
		Set Application(CacheName &"_grouppic")=RecordsetToxml(rs,"usergroup","grouppic")
		Set Rs=Nothing
	End Sub
	Public Sub Loadstyle()
		Dim Rs
		Set Rs=Dvbbs.Execute("Select *  From Dv_style")
		Set Application(CacheName &"_style")=RecordsetToxml(rs,"style","")
		Set Rs=Nothing
		LoadStyleMenu()
	End Sub
	Public Sub LoadStyleMenu()'生成风格选单数据
		Name="style_list"
		Dim XMLDom,stylesheet,XMLStyle,proc
		Set XMLDom=Application(CacheName &"_style").cloneNode(True)
		XMLDom.documentElement.appendChild(Application(CacheName & "_csslist").documentElement.cloneNode(True))
		Set XMLStyle=Server.CreateObject("msxml2.XSLTemplate" & MsxmlVersion)
		Set stylesheet=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		stylesheet.load Server.MapPath(MyDbPath &"inc\Templates\stylemenu.xslt")
		XMLStyle.stylesheet=stylesheet
		Set proc=XMLStyle.createProcessor()
		proc.input = XMLDom
  	proc.transform()
  	value=proc.output
	End Sub
	Public Sub UpdateForum_Info(act)'act=0 不处理缓存,act=1 处理缓存
		If value <> "1900-1-1" Then 
			value="1900-1-1"
			Dim Rs,LastPostInfo,TempStr,i,Board
			Dim Forum_YesterdayNum,Forum_TodayNum,Forum_LastPost,Forum_MaxPostNum,Forum_MaxPostDate
			Set Rs=Execute("Select Top 1 Forum_YesterdayNum,Forum_TodayNum,Forum_LastPost,Forum_MaxPostNum From Dv_Setup")
			Forum_YesterdayNum=Rs(0)
			Forum_TodayNum=Rs(1)
			Forum_LastPost=Rs(2)
			Forum_MaxPostNum=Rs(3)
			Set Rs=Nothing
			LastPostInfo = Split(Forum_LastPost,"$")
			If Not IsDate(LastPostInfo(2)) Then LastPostInfo(2)=Now()	
			If DateDiff("d",CDate(LastPostInfo(2)),Now())<>0 Then'最后发帖时间不是今天，	
				TempStr=LastPostInfo(0)&"$"&LastPostInfo(1)&"$"&Now()&"$"&LastPostInfo(3)&"$"&LastPostInfo(4)&"$"&LastPostInfo(5)&"$"&LastPostInfo(6)&"$"&LastPostInfo(7)
				Execute("Update Dv_Setup Set Forum_YesterdayNum="&Forum_TodayNum&",Forum_LastPost='"&TempStr&"',Forum_TodayNum=0")
				Execute("update Dv_board Set TodayNum=0")
				If act=1 Then
					If not IsObject(Application(CacheName&"_boardlist")) Then LoadBoardList()
					For Each board in Application(CacheName&"_boardlist").documentElement.selectNodes("board/@boardid")
						LoadBoardinformation board.text
					Next
				End If
			End If
			If Forum_TodayNum >Forum_MaxPostNum Then
				Execute("Update Dv_Setup Set Forum_MaxPostNum=Forum_TodayNum,Forum_MaxPostDate="&SqlNowString)
			End If
			If act=1 Then loadSetup()
			Dim xmlhttp
			If IsSqlDataBase =0 Then
				On Error Resume Next
				Set xmlhttp = Server.CreateObject("msxml2.ServerXMLHTTP")
				xmlhttp.setTimeouts 65000, 65000, 65000, 65000
		  	xmlhttp.Open "POST",Get_ScriptNameUrl& "Loadservoces.asp",false
		  	xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
		  	xmlhttp.send()
		  	Set xmlhttp = Nothing
			End If
		End If
		Name="Date"
		value=Date()
	End Sub
	Public Sub GetForum_Setting()
		Name="Date"
		If ObjIsEmpty() Then
			UpdateForum_Info(0)
		ElseIf  Cstr(value) <> Cstr(Date()) Then 
			UpdateForum_Info(1)
		End If
		Name="setup"
		If ObjIsEmpty Then loadSetup()
		If Not IsObject(Application(CacheName&"_boardlist")) Then
				LoadBoardList()
		End If
		If Not IsObject(Application(CacheName &"_style")) Then
				Loadstyle()
		End If
		Name="setup"
		CacheData=value
		Dim Setting,OpenTime,ischeck:Setting= Split(CacheData(1,0),"|||"):Forum_Info =  Split (Setting(0),",")
		Forum_Setting = Split (Setting(1),","):Forum_UploadSetting = Split(Forum_Setting(7),"|")
		Forum_user = Setting(2):Forum_user = Split (Forum_user,","):Forum_Copyright = Setting(3)
		Forum_ChanSetting = Split(CacheData(24,0),","):	Forum_Version = CacheData(18,0):BadWords = Split(CacheData(3,0),"|")
		rBadWord = Split(CacheData(4,0),"|"):	Main_Sid=CacheData(17,0):Maxonline = CacheData(5,0):NowUseBBS = CacheData(19,0):Cookiepath = CacheData(26,0)
		If ScriptFolder = Lcase(CacheData(33,0)) Then Page_Admin = True
		Rem 禁止代理服务器访问开始,如需要允许访问，请屏蔽此段代码。
		If Forum_Setting(100)="1" Then
			If actforip <> "" Then
				Session(CacheName & "UserID")=empty
				Set Dvbbs=Nothing
				Response.Status = "302 Object Moved" 
				Response.End 
			End If
			If UBound(Forum_Setting)> 101 Then
				IP_MAX=CLng(Forum_Setting(101))
			Else
				IP_MAX=0
			End If
		End If
		Rem 禁止代理服务器访问结束
		If Forum_Setting(21)="1" And Not Page_Admin Then Set Dvbbs=Nothing:Response.redirect "showerr.asp?action=stop"	
		If BoardID <>0 Then
			If Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&BoardID&"']") Is Nothing Then
				Set Dvbbs=Nothing
				Response.Write "错误的版面参数"
  			Response.End
			End If
		End If
		If BoardID > 0 Then
			If Not IsObject(Application(CacheName &"_boarddata_" & Boardid)) Then LoadBoardData boardid
			If Not IsObject (Application(CacheName &"_information_" & boardid)) Then LoadBoardinformation BoardID
			Dim Nodelist,node
			Forum_ads = Split(Application(CacheName &"_boarddata_" & Boardid).documentElement.selectSingleNode("boarddata/@board_ads").text,"$")
			
			Forum_user = Split(Application(CacheName &"_boarddata_" & Boardid).documentElement.selectSingleNode("boarddata/@board_user").text,",")
			board_Setting = Split(Application(CacheName &"_boarddata_" & Boardid).documentElement.selectSingleNode("boarddata/@board_setting").text,",")
			BoardType = Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&BoardID&"']/@boardtype").text
			BoardRootID = Application(CacheName &"_boarddata_" & Boardid).documentElement.selectSingleNode("boarddata/@rootid").text
			BoardParentID=CLng(Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&BoardID&"']/@parentid").text)	
			Sid = Application(CacheName &"_boarddata_" & Boardid).documentElement.selectSingleNode("boarddata/@sid").text
			Boardreadme=Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&BoardID&"']/@readme").text
			If Len(Board_Setting(22))< 24 Then Board_Setting(22)="1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1"
			OpenTime=Split(Board_Setting(22),"|")
			setting=Board_Setting(21)
			ischeck=Clng(Board_Setting(18))
			If Board_Setting(50)<>"0" And Board_Setting(50)<>"" Then Set Dvbbs=Nothing:Response.Redirect Board_Setting(50)
		Else
			Forum_ads = Split(CacheData(2,0),"$")
			If Len(Forum_Setting(70))< 24 Then Forum_Setting(70)="1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1"
			OpenTime=Split(Forum_Setting(70),"|")
			setting=Forum_Setting(69)
			ischeck=Forum_Setting(26)
			If Not IsNumeric(ischeck) Then ischeck=0
			ischeck=CLng(ischeck)		
		End If
		If Ubound(Forum_ads)<=18 Then
			Forum_ads = Split(Join(Forum_ads,"$")&"$$$$$$$$$0","$")
		End If
		'定时开放判断
		If Not Page_Admin And Cint(setting)=1 Then
			If OpenTime(Hour(Now))="1" Then Set Dvbbs=Nothing:Response.redirect "showerr.asp?action=stop&boardid="&Dvbbs.BoardID&""
		End If
		'在线人数限制
		If ischeck > 0 And Not Page_Admin Then
			If MyBoardOnline.Forum_Online > ischeck And BoardID=0 Then
				If Not IsONline(Membername,1) Then Set Dvbbs=Nothing:Response.Redirect "showerr.asp?action=limitedonline&lnum="&ischeck
			End If
			If BoardID > 0 Then
				If (Not IsONline(Membername,1)) And MyBoardOnline.Board_Online > ischeck Then Set Dvbbs=Nothing:Response.Redirect "showerr.asp?action=limitedonline&lnum="&ischeck
			End If
		End If
		Dim CookiesSid
		CookiesSid = Request.Cookies("skin")("skinid_"&BoardID)
		If InStr(CookiesSid,"_")=0  Or CookiesSid = "" Then
			If BoardID = 0 Then 
				SkinID = Main_Sid
				CssID=CacheData(30,0)
			Else
				SkinID = Sid
				CssID=Application(CacheName &"_boarddata_" & Boardid).documentElement.selectSingleNode("boarddata/@cid").text
			End If