cls_main.asp

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

<%
'Product DvBoke version 1.00
'Copyright (C) 2004,2005 AspSky.Net. All rights reserved.
'Written By Dvbbs.net Fssunwin
'Web: http://www.aspsky.net/ , http://www.dvbbs.net/
'Email: [e-mail] [e-mail]

Class Cls_DvBoke
	Public UserID,UserName,UserIP,UserSex
	Public BokeUserID,BokeUserName,BokeName,BokeDOM,BokeNode,BokeSetting,BokeCat,BokeCatNode,BokeStype
	Public SystemDoc,System_Node,System_Setting,System_UpSetting,SysCat,SysChatCat
	Public SqlQueryNum,ArchiveLink,ModHtmlLinked,mArchiveLink
	Public Page_File,Skins_Path,Cache_Path,Page_Strings,Main_Strings
	Public Stats,ScriptName,RefreshID
	Public IsBokeOwner,IsMaster,InputShowMsg
	Private SystemPath,ErrCode,bokeurl_r
	Private Sub Class_Initialize()
		BokeStype = "文章,收藏,链接,交易,相册"
		BokeStype = Split(BokeStype,",")
		SqlQueryNum = 0
		IsBokeOwner = False
		IsMaster = False
		If Dvbbs.Master Then
			IsMaster = True
		End If
		'Skins_Path = "Boke/Skins/default/"
		Cache_Path = "Boke/CacheFile/"
		Dim Tmpstr
		Tmpstr = Request.ServerVariables("PATH_INFO")
		Tmpstr = Split(Tmpstr,"/")
		ScriptName = Lcase(Tmpstr(UBound(Tmpstr)))
		UserSex = 1
		If Is_Isapi_Rewrite = 0 Then ModHtmlLinked = "?"
		ArchiveLink = Lcase(Request.ServerVariables("QUERY_STRING"))
		If ArchiveLink <> "" Then
			ArchiveLink = Split(ArchiveLink,".")
			If Instr(Lcase(ArchiveLink(0)),"show_")=0 Then BokeName = Replace(ArchiveLink(0),".html","")
		Else
			ReDim ArchiveLink(5)
		End If
		If Lcase(InStr(Request.ServerVariables("QUERY_STRING"),".html")) = 0 And Lcase(InStr(Request.ServerVariables("QUERY_STRING"),".xml")) = 0 Then BokeName = Request("User")
		Set MyBoardOnline=new Cls_UserOnlne 
		Dvbbs.GetForum_Setting
		Dvbbs.CheckUserLogin
		If Request.QueryString("UserID")<>"" And IsNumeric(Request.QueryString("UserID")) Then
			BokeUserID = cCur(Request.QueryString("UserID"))
			UserID = Dvbbs.UserID
			UserName = ""
		ElseIf Dvbbs.UserID>0 Then
			UserID = Dvbbs.UserID
			BokeUserID = Dvbbs.UserID
			UserName = Dvbbs.MemberName
			UserSex = Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usersex").text
		Else
			BokeUserID = 0
			UserID = 0
			UserName = ""
		End If
		If Instr(Lcase(ArchiveLink(0)),"userid_") and IsNumeric(Replace(Lcase(ArchiveLink(0)),"userid_","")) Then
			BokeUserID = cCur(Replace(Lcase(ArchiveLink(0)),"userid_",""))
			BokeName = ""
		End If
		UserIP = Dvbbs.UserTrueIP
		LoadSetup(0)
		Skins_Path = System_Node.getAttribute("s_path")
		GetUBokeInfo()
		If Not IsObject(BokeNode) Then
			Setup_SysBokeNode
		End If
	End Sub

	Private Sub class_terminate()
		Set SystemDoc = Nothing
		If IsObject(BokeDOM) Then Set BokeDOM = Nothing
		If IsObject(Boke_Conn) Then Boke_Conn.Close : Set Boke_Conn = Nothing
	End Sub

	Public Property Get Version()
		Version = "<a href=""http://www.cndw.com"" target=""_blank""><u>iBoker V1.0.0</u></a>"
	End Property

	Public Function Execute(Command)
		'Response.Write Command
		'Response.Write "<br/>"
		If Dv_Boke_InDvbbsData = 1 Then
			If Not IsObject(Boke_Conn) Then Boke_ConnectionDatabase()
			Set Execute = Boke_Conn.Execute(Command)
		Else
		
			If Not IsObject(Conn) Then ConnectionDatabase()
			Set Execute = Conn.Execute(Command)
		End If
		SqlQueryNum = SqlQueryNum + 1
	End Function

	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 Function CheckNumeric(Byval CHECK_ID)
		If CHECK_ID<>"" and IsNumeric(CHECK_ID) Then _
			CHECK_ID = cCur(CHECK_ID) _
		Else _
			CHECK_ID = 0
		CheckNumeric = CHECK_ID
	End Function

	Public Function Checkstr(Str)
		If Isnull(Str) Then
			CheckStr = ""
			Exit Function 
		End If
		Str = Replace(Str,Chr(0),"")
		CheckStr = Replace(Str,"'","''")
	End Function

	Public Function getUrlEncodel(byVal  Url)  
		Dim  i,code  
		getUrlEncodel=""  
		If Trim(Url)="" Then Exit Function  
		For  i=1  To  Len(Url)  
			code=Asc(Mid(Url,i,1))  
			If code<0  Then code = code + 65536  
			If code>255  Then  
				getUrlEncodel=getUrlEncodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2)  
			Else  
				getUrlEncodel=getUrlEncodel&Mid(Url,i,1)  
			End If 
		Next  
	End Function

	Public Function Furl(url)
		Furl=Replace(url," ","%20",1,-1,1)
		Furl=getUrlEncodel(Furl)
	End Function
	
	Function HTMLEncode(reString) '转换HTML代码
		Dim Str:Str=reString
		IF Not isnull(Str) Then
			Str = replace(Str, ">", "&gt;")
			Str = replace(Str, "<", "&lt;")
			Str = Replace(Str, CHR(32), "&nbsp;")
			Str = Replace(Str, CHR(9), "&nbsp;")
			Str = Replace(Str, CHR(9), "&#160;&#160;&#160;&#160;")
			Str = Replace(Str, CHR(34), "&quot;")
			Str = Replace(Str, CHR(39), "&#39;")
			Str = Replace(Str, CHR(13), "")
			Str = Replace(Str, CHR(10), "<br>")
			HTMLEncode = Str
		End IF
	End Function

	Function ClearHtmlTages(reString)
		Dim Re
		Dim Str:Str=reString
		IF Not isnull(Str) Then
			Set Re=New RegExp
			Re.IgnoreCase =True
			Re.Global=True
			Re.Pattern="<(.[^>]*)>"
			Str=Re.Replace(Str, "")
			Set Re=Nothing
			Str = replace(Str, ">", "&gt;")
			Str = replace(Str, "<", "&lt;")
			Str = Replace(Str, CHR(32), "&nbsp;")
			Str = Replace(Str, CHR(9), "&nbsp;")
			Str = Replace(Str, CHR(9), "&#160;&#160;&#160;&#160;")
			Str = Replace(Str, CHR(34), "&quot;")
			Str = Replace(Str, CHR(39), "&#39;")
			Str = Replace(Str, CHR(13), "")
			'Str = Server.Htmlencode(Str)
		End IF
		ClearHtmlTages = Str
	End Function

	'初始化默认数据
	Private Sub Setup_SysBokeNode()
		Dim XslDoc
		Page_File = Server.MapPath(Cache_Path &"default.config")
		Set XslDoc=Server.CreateObject("Msxml2.FreeThreadedDOMDocument")
		If Not XslDoc.Load(Page_File) Then
			Response.Write "初始数据不存在！"
			Response.End
		Else
			Set BokeNode=XslDoc.documentElement.selectSingleNode("rs:data/z:row")
			BokeNode.attributes.getNamedItem("joinboketime").text = Now()
			BokeNode.attributes.getNamedItem("lastuptime").text = Now()
			BokeSetting = Split(BokeNode.getAttribute("bokesetting"),",")
			Set BokeCat=Server.CreateObject("Msxml2.FreeThreadedDOMDocument")
			BokeCat.Load(Server.MapPath(Cache_Path &"usercat.config"))
		End If
		Set XslDoc = Nothing
	End Sub

	'UserID=0 ,UserName=1 ,NickName=2 ,BokeName=3 ,PassWord=4 ,BokeTitle=5 ,BokeChildTitle=6 ,BokeNote=7 ,JoinBokeTime=8 ,PageView=9 ,TopicNum=10 ,FavNum=11 ,PhotoNum=12 ,PostNum=13 ,TodayNum=14 ,Trackbacks=15 ,SpaceSize=16 ,XmlData=17 ,SysCatID=18 ,BokeSetting=19 ,LastUpTime=20 ,SkinID=21,Stats=22
	Public Sub GetUBokeInfo()
		Dim Sql,Rs
		Sql = "Select UserID,UserName,NickName,BokeName,PassWord,BokeTitle,BokeChildTitle,BokeNote,JoinBokeTime,PageView,TopicNum,FavNum,PhotoNum,PostNum,TodayNum,Trackbacks,SpaceSize,XmlData,SysCatID,BokeSetting,LastUpTime,SkinID,Stats,S.S_SkinName,S.S_Path,S.S_ViewPic,S.S_Info,S.S_Builder From [Dv_Boke_User] U Inner Join [Dv_Boke_Skins] S On U.SkinID = S.S_ID"
		Sql = Lcase(Sql)
		If BokeName<>"" Then
			Sql = Sql & " where BokeName = '"&Dvbbs.Checkstr(BokeName)&"'"
		ElseIf BokeUserID>0 Then
			Sql = Sql & " where UserID = "&BokeUserID
		Else
			'请选取相关的DVBOKE，返回综合列表
			Exit Sub
		End If
		Set Rs = Execute(SQL)
		If Rs.EOF And Rs.BOF Then
			'申请页面
			BokeUserID = 0
			If Dvbbs.UserID = 0 Then
				'Response.Write "<script>alert(""您访问的博客用户不存在，系统将会自动转向到系统博客首页面！"");</script>"
				'Response.Redirect "BokeIndex.asp"
			Else
				'Response.Write "<script>alert(""您访问的博客用户不存在，系统将会自动转向到个人博客申请页面！"");</script>"
				'Response.Redirect "BokeApply.asp"
			End If
			Exit Sub
		End If
		BokeUserID = Rs(0)
		BokeUserName = Rs(2)
		BokeName = Rs(3)
		BokeSetting = Split(Rs(19)&"",",")
		
		If BokeUserID = UserID and UserID>0 Then
			IsBokeOwner = True
		End If
		If Not IsMaster Then
			If Rs(22)=2 Then
				ShowCode(52)
				ShowMsg(0)
			ElseIf Rs(22)=1 and Not IsBokeOwner Then
				ShowCode(53)
				ShowMsg(0)
			End If
			If BokeSetting(0) <> "1" And Not IsBokeOwner Then
				ShowCode(41)
				ShowMsg(0)
			End If
		End If
		Set BokeDOM=Server.CreateObject("Msxml2.FreeThreadedDOMDocument")
		Rs.Save BokeDOM,1
		BokeDOM.documentElement.RemoveChild(BokeDOM.documentElement.selectSingleNode("s:Schema"))
		Set BokeNode=BokeDOM.documentElement.selectSingleNode("rs:data/z:row")
		If DateDiff("d",Rs(20),now())<>0 and BokeNode.getAttribute("todaynum")>0 Then
			BokeNode.attributes.getNamedItem("todaynum").text = 0
			Execute("Update [Dv_Boke_User] set TodayNum=0 where UserID="&BokeUserID)
		End If
		BokeNode.attributes.getNamedItem("lastuptime").text = Rs(20)
		BokeNode.attributes.getNamedItem("joinboketime").text = Rs(8)
		'If ScriptName<>"bokeindex.asp" Then
		Skins_Path = BokeNode.getAttribute("s_path")
		'End If
		Set BokeCat=Server.CreateObject("Msxml2.FreeThreadedDOMDocument")
		If Rs(16)="" Or IsNull(Rs(17)) Then
			BokeCat.Load(Server.MapPath(Cache_Path &"usercat.config"))
		Else
			If Not BokeCat.LoadXml(Rs(17)) Then
				'Response.Write "用户栏目数据出错！"
				BokeCat.Load(Server.MapPath(Cache_Path &"usercat.config"))
			End If
		End If
		'Response.Write BokeCat.documentElement.xml
		Set BokeCatNode = BokeCat.documentElement.selectNodes("rs:data/z:row")
		Rs.Close : Set Rs = Nothing

	End Sub

	'重置系统表数据 ACT=1强制更新
	Public Sub LoadSetup(Act)
		Page_File = Server.MapPath(Cache_Path &"System.config")
		Set SystemDoc = Server.CreateObject("Msxml2.FreeThreadedDOMDocument")
		If Not SystemDoc.Load(Page_File) Then
			SystemDoc.LoadXml("<?xml version=""1.0"" encoding=""Gb2312""?><bokesystem/>")
			ReLoadBoke_System()
			ReLoadBoke_SysCat()
			SaveSystemCache()
		ElseIf Act=1 Then
			ReLoadBoke_System()
			ReLoadBoke_SysCat()
			SaveSystemCache()
		End If
		Set System_Node = SystemDoc.documentElement.selectSingleNode("/bokesystem/system/rs:data/z:row")
		Set SysCat = SystemDoc.documentElement.selectSingleNode("/bokesystem/syscat")
		Set SysChatCat = SystemDoc.documentElement.selectSingleNode("/bokesystem/syschatcat")