dv_clsmain.asp

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

		Else
			CookiesSid=Split(CookiesSid,"_")
			CssID=CookiesSid(1)
			SkinID=CookiesSid(0)
		End If
		Setting=empty
	End Sub
	Public Function IsReadonly()
		IsReadonly=False
		Dim TimeSetting
		If Forum_Setting(69)="2" Then
			TimeSetting=split(Forum_Setting(70),"|")
			If TimeSetting(Hour(Now))="1" Then
				IsReadonly=True
				Exit Function
			End If
		End If
		If BoardID>0 Then 
			If Board_Setting(21)="2" Then
				TimeSetting=split(Board_Setting(22),"|")
				If TimeSetting(Hour(Now))="1" Then IsReadonly=True
			End If
		End If 
	End Function
	Public Function IsONline(UserName,action)
		IsONline=False
		If Trim(UserName)="" Then Exit Function
		If IsObject(Session(CacheName & "UserID")) And action=1 Then
				IsONline=True:Exit Function 
		End If
		Dim Rs
		Set Rs =Execute("Select UserID From Dv_Online Where Username='"&UserName&"'")
		If Not Rs.EOF  Then IsONline=True
		Set rs=Nothing  
	End Function  
	Public Sub LoadTemplates(Page_Fields)
		Dim Style_Pic,Main_Style,TempStyle,cssfilepath
		If Application(CacheName &"_style").documentElement.selectSingleNode("style[@id='"& SkinID &"']") Is Nothing Then
			If Not Application(CacheName &"_style").documentElement.selectSingleNode("style/@id") Is Nothing Then
				SkinID=Application(CacheName &"_style").documentElement.selectSingleNode("style/@id").text 
			Else
				Set Dvbbs=Nothing
				Response.Write "模板数据无法提取,请检查模板数据"
				Response.End
			End If
		End If
		Dim hascss
		If Application(CacheName & "_csslist").documentElement.selectSingleNode("css[@id='"& CssID &"' and tid='"& SkinID &"']") Is Nothing Then
			If Not Application(CacheName & "_csslist").documentElement.selectSingleNode("css[tid='"& SkinID &"']/@id") Is Nothing Then
				CssID=Application(CacheName & "_csslist").documentElement.selectSingleNode("css[tid='"& SkinID &"']/@id").text
				hascss=true
			ElseIf Not Application(CacheName & "_csslist").documentElement.selectSingleNode("css/@id") Is Nothing Then
				CssID=Application(CacheName & "_csslist").documentElement.selectSingleNode("css/@id").text
				cssfilepath=Application(CacheName & "_csslist").documentElement.selectSingleNode("@cssfilepath").text
				Forum_PicUrl=cssfilepath & Application(CacheName & "_csslist").documentElement.selectSingleNode("css[@id='"& CssID &"']/@picurl").text
			Else
				SkinID=Application(CacheName &"_style").documentElement.selectSingleNode("style/@id").text
				If Not Application(CacheName & "_csslist").documentElement.selectSingleNode("css[tid='"& SkinID &"']/@id") Is Nothing Then
					CssID=Application(CacheName & "_csslist").documentElement.selectSingleNode("css[tid='"& SkinID &"']/@id").text
					hascss=true
				Else
				CssID=Application(CacheName & "_csslist").documentElement.selectSingleNode("css/@id").text
				hascss=true
				End If
			End If
		Else
			hascss=true
		End If
		If hascss Then
			cssfilepath=Application(CacheName & "_csslist").documentElement.selectSingleNode("@cssfilepath").text
			Forum_PicUrl=cssfilepath & Application(CacheName & "_csslist").documentElement.selectSingleNode("css[@id='"& CssID &"' and tid='"& SkinID &"']/@picurl").text
			StyleName=Application(CacheName &"_style").documentElement.selectSingleNode("style[@id='"& SkinID &"']/@stylename").text
		End If
		Main_Style = Replace(Application(CacheName &"_style").documentElement.selectSingleNode("style[@id='"& SkinID &"']/@main_style").text,"{$PicUrl}",Forum_PicUrl)		'风格图片路径替换
		If Not (Instr(ScriptName,"index")>0 Or Page_Admin) Then
			Style_Pic = Replace(Application(CacheName &"_style").documentElement.selectSingleNode("style[@id='"& SkinID &"']/@style_pic").text,"{$PicUrl}",Forum_PicUrl)		'风格图片路径替换
			Style_Pic = Split(Style_Pic,"@@@")
			Forum_UserFace = Style_Pic(0)
			Forum_PostFace = Style_Pic(1)
			Forum_Emot = Style_Pic(2)
		End If
		If Page_Fields<>"" Then
			Template.value =Application(CacheName &"_style").documentElement.selectSingleNode("style[@id='"& SkinID &"']/@page_"& LCase(Page_Fields)).text
		End If
		Main_Style = Split(Main_Style,"@@@")
		mainhtml = Split(Main_Style(0),"|||")
		lanstr = Split(Main_Style(1),"|||")
		mainpic = Split(Main_Style(2),"|||")
		mainsetting = Split(mainhtml(0),"||")
		If hascss Then
			If Application(CacheName & "_csslist").documentElement.selectSingleNode("css[@id='"& CssID &"' and tid='"& SkinID &"']/@filename").text = "" Then
				Forum_CSS="<style type=""text/css"">" & Application(CacheName & "_csslist").documentElement.selectSingleNode("css[@id='"& CssID &"' and tid='"& SkinID &"']/cssdata").text &"</style>"
				Forum_CSS = Replace(Forum_CSS,"{$width}",mainsetting(0))
				Forum_CSS = Replace(Forum_CSS,"{$PicUrl}",Forum_PicUrl)
			Else
				Forum_CSS="<link rel=""stylesheet"" type=""text/css"" href="""& cssfilepath & Application(CacheName & "_csslist").documentElement.selectSingleNode("css[@id='"& CssID &"' and tid='"& SkinID &"']/@filename").text &".css"" />"
			End If
		Else
			Forum_CSS="<link rel=""stylesheet"" type=""text/css"" href="""& cssfilepath & Application(CacheName & "_csslist").documentElement.selectSingleNode("css[@id='"& CssID &"']/@filename").text &".css"" />"	
		End If
	End Sub
	Rem 判断发言是否来自外部
	Public Function ChkPost()
		Dim server_v1,server_v2
		Chkpost=False 
		server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
		server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
		If Mid(server_v1,8,len(server_v2))=server_v2 Then Chkpost=True 
	End Function
	Public Sub ReloadSetupCache(MyValue,N)'更新总设置表部分缓存数组，入口：更新内容、数组位置
		CacheData(N,0) = MyValue
		Name="setup"
		value=CacheData
	End Sub
	Public Sub NeedUpdateList(username,act)'更新用户资料缓存(缓存用户名,是否需要添加)[0=不添加,只作清理,1=需要添加]
		Dim Tmpstr,TmpUsername
		Name="NeedToUpdate"
		If ObjIsEmpty() Then Value=""
		Tmpstr=Value
		TmpUsername=","&username&","
		Tmpstr=Replace(Tmpstr,TmpUsername,",")
		Tmpstr=Replace(Tmpstr,",,",",")
		If act=1 Then 
			If IsONline(username,0) Then
				If Tmpstr="" Then
					Tmpstr=TmpUsername
				Else
					Tmpstr=Tmpstr&TmpUsername
				End If
			End If
		End If
		Tmpstr=Replace(Tmpstr,",,",",")
		Value=Tmpstr
	End Sub
	Public Sub LetGuestSession()'写入客人session
		Dim StatUserID,UserSessionID
		StatUserID = checkStr(Trim(Request.Cookies(Forum_sn)("StatUserID")))
		If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
			StatUserID = Replace(UserTrueIP,".","")
			UserSessionID = Replace(Startime,".","")
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
			StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
		End If
		StatUserID = Ccur(StatUserID)
		Response.Cookies(Forum_sn).Expires=DateAdd("s",3600,Now())
		Response.Cookies(Forum_sn).path=cookiepath
		Response.Cookies(Forum_sn)("StatUserID") = StatUserID
		Set UserSession=Application(Dvbbs.CacheName&"_info_guest").cloneNode(True)
		UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text=StatUserID
		UserSession.documentElement.selectSingleNode("userinfo/@cometime").text=Now()
		UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=DateAdd("s",-3600,Now())
		UserSession.documentElement.selectSingleNode("userinfo/@boardid").text=boardid
		Dim BS
		Set Bs=GetBrowser()
		UserSession.documentElement.appendChild(Bs.documentElement)
		If EnabledSession Then
			Session(CacheName & "UserID")=UserSession.xml
		End If
	End Sub 
	'根据页面来判断是否需要执行TrueCheckUserLogin
	Public Function NeedChecklongin()
		NeedChecklongin=True
		If UserID > 0 Then
			If InStr(ScriptName,"admin_")>0 Then Exit Function
			Dim pagelist
			pagelist=",post.asp,usermanager.asp,mymodify.asp,modifypsw.asp,modifyadd.asp,usersms.asp,"
			pagelist=pagelist & "friendlist.asp,favlist.asp,myfile.asp,friendlist.asp,recycle.asp,"
			pagelist=pagelist & "fileshow.asp,bbseven.asp,dispuser.asp,savepost.asp,plus_tools_pay.asp,joinvipgroup.asp,plus_tools_center.asp"
			If InStr(pagelist,","&ScriptName&",")>0 Then Exit Function
		End If
		NeedChecklongin=False
	End Function 
	'验证用户登陆
	Public Sub CheckUserLogin()
		If EnabledSession Then
			Set UserSession=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
			If Not UserSession.loadxml(Session(CacheName & "UserID")&"") Then
				If UserID > 0 Then 
					TrueCheckUserLogin
				Else
					Call LetGuestSession()
				End If
			Else
				If UserID >0 Or UserSession.documentElement.selectSingleNode("userinfo/@userid").text<>"0"  Then
				
					Dim NeedToUpdate,toupdate
					toupdate=False
					Name="NeedToUpdate"
					If Not ObjIsEmpty() Then 
						NeedToUpdate=","&Value&","
						If InStr(NeedToUpdate,","&MemberName&",")>0 Then
							Call NeedUpdateList(MemberName,0)
							toupdate=True
						End If
					End If
					
					If NeedChecklongin Or  toupdate Then TrueCheckUserLogin
				Else
		
				End If
			End If
		Else
			If UserID > 0 Then 
					TrueCheckUserLogin
				Else
					Call LetGuestSession()
			End If	
		End If
		If UserID=0 Then
			UserToday = Split("0|0|0|0|0","|")
		End If
		UserID=CLng(UserSession.documentElement.selectSingleNode("userinfo/@userid").text)
		UserGroupID=CLng(UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text)
		If UserID > 0 Then
			GetCacheUserInfo
		Else
			UserGroupID = 7
			Lastlogin = Now()
		End If
		Browser=Checkstr(UserSession.documentElement.selectSingleNode("agent/@browser").text)
		version=replace(Checkstr(UserSession.documentElement.selectSingleNode("agent/@version").text),"--","")
		platform=Checkstr(UserSession.documentElement.selectSingleNode("agent/@platform").text)
		If (Browser="unknown" And version="unknown" And platform="unknown") Or Request("IsSearch")="1" Then
			If IsWebSearch Then
				IsSearch = True
			Else
				IsSearch = False
			End If
			If Request("IsSearch") = "1" Then IsSearch = True
			Cls_IsSearch = True
		End If
		'IP锁定
		If UserSession.documentElement.selectSingleNode("agent/@lockip").text="1"  Then
			If Not Page_Admin Then Set Dvbbs=Nothing:Response.Redirect "showerr.asp?action=iplock"
			'If Not Page_Admin Then Session(CacheName & "UserID")=empty:Response.Status = "302 Object Moved" 
		End If	
		GetGroupSetting
		
		'是否跳转到个性首页
		'If Request.ServerVariables("HTTP_REFERER")="" Then
		'	If Not (UserSession.documentElement.selectSingleNode("userinfo/@Usersetting") is Nothing) Then
		'		If Split(UserSession.documentElement.selectSingleNode("userinfo/@Usersetting").text,"|||")>=3 Then
		'			If Split(UserSession.documentElement.selectSingleNode("userinfo/@Usersetting").text,"|||")(3)="1" Then
		'				
		'			End If
		'		End If
		'	End If
		'End If
	End Sub
	Rem xmlroot跟节点名称 row记录行节点名称
	Public Function RecordsetToxml(Recordset,row,xmlroot)
		Dim i,node,rs,j,DataArray
		If xmlroot="" Then xmlroot="xml"
		If row="" Then row="row"
		Set RecordsetToxml=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		RecordsetToxml.appendChild(RecordsetToxml.createElement(xmlroot))
		If Not Recordset.EOF Then
			DataArray=Recordset.GetRows(-1)
			For i=0 To UBound(DataArray,2)
				Set Node=RecordsetToxml.createNode(1,row,"")
				j=0
				For Each rs in Recordset.Fields
						 node.attributes.setNamedItem(RecordsetToxml.createNode(2,LCase(rs.name),"")).text= DataArray(j,i)& ""
						 j=j+1
				Next
				RecordsetToxml.documentElement.appendChild(Node)
			Next
		End If