dv_clsmain.asp

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

		DataArray=Null
	End Function
	Public Function ArrayToxml(DataArray,Recordset,row,xmlroot)
		Dim i,node,rs,j
		If xmlroot="" Then xmlroot="xml"
		Set ArrayToxml=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		ArrayToxml.appendChild(ArrayToxml.createElement(xmlroot))
		If row="" Then row="row"
		For i=0 To UBound(DataArray,2)
			Set Node=ArrayToxml.createNode(1,row,"")
			j=0
			For Each rs in Recordset.Fields
					 node.attributes.setNamedItem(ArrayToxml.createNode(2,LCase(rs.name),"")).text= DataArray(j,i)& ""
					 j=j+1
			Next
			ArrayToxml.documentElement.appendChild(Node)
		Next
	End Function
	Public Function Createpass()'系统分配随机密码
		Dim Ran,i,LengthNum
		LengthNum=16
		Createpass=""
		For i=1 To LengthNum
			Randomize
			Ran = CInt(Rnd * 2)
			Randomize
			If Ran = 0 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& UCase(Chr(Ran))
			ElseIf Ran = 1 Then
				Ran = CInt(Rnd * 9)
				Createpass = Createpass & Ran
			ElseIf Ran = 2 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& Chr(Ran)
			End If
		Next
	End Function
	Public Sub NewPassword()'更新用户验证密码
		If UserID=0 Then Exit Sub
		Response.Write "<iframe style=""border:0px;width:0px;height:0px;""  src=""newpass.asp"" name=""Dvnewpass""></iframe>"
	End Sub
	Public Sub TrueCheckUserLogin()
		Dim Rs,SQL,FoundMyGroupID
		FoundMyGroupID = 0
		If UserSession.xml<>"" Then
			If Not (UserSession.documentElement.selectSingleNode("userinfo/@usergroupid") is Nothing )  Then
				FoundMyGroupID =  CLng(UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text)
			End If
		End If

		Sql="Select UserID,UserName,UserPassword,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin as cometime ,LastLogin,LastLogin as activetime,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,UserHidden,UserMsg,IsChallenge,UserMobile,TitlePic,UserTitle,TruePassWord,UserToday,UserMoney,UserTicket,FollowMsgID,Vip_StarTime,Vip_EndTime,userid as boardid,Usersetting"
		Sql=Sql & " From [Dv_User] Where UserID = " & UserID
		Set Rs = Execute(Sql)
		If Rs.EOF Then
			UserID = 0:LetGuestSession():Exit Sub
		Else
			If Not (LCase(Rs("UserName"))=LCase(Membername) and Rs("TruePassWord")=Memberword) Then
				If EnabledSession Then
					Set UserSession=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
					If UserSession.loadxml(Session(CacheName & "UserID")&"")  Then
						If UserSession.documentElement.selectSingleNode("userinfo/@username") Is Nothing Or UserSession.documentElement.selectSingleNode("userinfo/@userpassword") Is Nothing Then
							UserID = 0:LetGuestSession():Exit Sub
						Else
							If Not (LCase(Rs("UserName"))=LCase(UserSession.documentElement.selectSingleNode("userinfo/@username").text) and Rs("UserPassword")=UserSession.documentElement.selectSingleNode("userinfo/@userpassword").text) Then
									UserID = 0:LetGuestSession():Exit Sub
							End If
						End If
					Else
						UserID = 0:LetGuestSession():Exit Sub
					End If
				Else
					UserID = 0:LetGuestSession():Exit Sub
				End If
			End If

			If Rs("LockUser")=1 Then
				UserID = 0:LetGuestSession():Exit Sub
			End if
		End If
		Set UserSession = RecordsetToxml(rs,"userinfo","xml")
		UserSession.documentElement.selectSingleNode("userinfo/@cometime").text=Now()
		UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=DateAdd("s",-3600,Now())
		UserSession.documentElement.selectSingleNode("userinfo/@boardid").text=boardid
		UserSession.documentElement.selectSingleNode("userinfo").attributes.setNamedItem(UserSession.createNode(2,"isuserpermissionall","")).text=FoundUserPermission_All()
		UserSession.documentElement.selectSingleNode("userinfo").attributes.setNamedItem(UserSession.createNode(2,"usergroupid2","")).text=UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text

		If FoundMyGroupID > 0 Then
			UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text = FoundMyGroupID
		End If
		Dim BS
		Set Bs=GetBrowser()
		UserSession.documentElement.appendChild(Bs.documentElement)
		If EnabledSession Then
			Session(CacheName & "UserID")= UserSession.xml
		End If
		Set Rs=Nothing
		GetCacheUserInfo()
	End Sub
	Public Sub GetCacheUserInfo()	'用户登录成功后，采用本函数读取用户数组并判断一些常用信息
		UserID = Clng(UserSession.documentElement.selectSingleNode("userinfo/@userid").text)
		MemberName = UserSession.documentElement.selectSingleNode("userinfo/@username").text
		Lastlogin = UserSession.documentElement.selectSingleNode("userinfo/@lastlogin").text
		If Not IsDate(LastLogin) Then LastLogin = Now()
		UserGroupID = CLng(UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text)
		If Trim(UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text)="" Then
			Execute("Update [Dv_User] Set UserToday='0|0|0|0|0' Where UserID = " & UserID)
			UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text="0|0|0|0|0"
			UserToday = Split("0|0|0|0|0","|")
		Else
			UserToday = Split(UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text,"|")
			If Ubound(UserToday) <> 4 Then
				Execute("Update [Dv_User] Set UserToday='0|0|0|0|0' Where UserID = " & UserID)
				UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text="0|0|0|0|0"
				UserToday = Split("0|0|0|0|0","|")
			End If
		End If
		'判断是否VIP组成员
			If IsDate(UserSession.documentElement.selectSingleNode("userinfo/@vip_startime").text) Then
				If DateDiff("d",Now(),UserSession.documentElement.selectSingleNode("userinfo/@vip_endtime").text)>0 Then
					VipGroupUser = True
				Else
					Dim tRs
					'将已过期的VIP用户移回注册组并清空有效时间
					If UserGroupID>8 Then
						Set tRs=Execute("Select Top 1 * From Dv_UserGroups Where ParentGID=3 And MinArticle<="& CCur(UserSession.documentElement.selectSingleNode("userinfo/@userpost").text) &" Order By MinArticle Desc")
							If not tRs.Eof Then
								Execute("Update Dv_User Set UserClass='"&tRs("UserTitle")&"',TitlePic='"&tRs("GroupPic")&"',UserGroupID="&tRs("UserGroupID")&",Vip_StarTime=null,Vip_EndTime=null Where UserID="&UserID)
							End If
						Set tRs=Nothing
					Else
						Execute("Update Dv_User Set Vip_StarTime=null,Vip_EndTime=null Where UserID="&UserID)
					End If
					UserSession.documentElement.selectSingleNode("userinfo/@vip_startime").text = ""
					UserSession.documentElement.selectSingleNode("userinfo/@vip_endtime").text =""
				End If
		End If
		Select Case UserGroupID
		Case 8
			Vipuser = True
		Case 3
			If BoardID=0 Then 	Boardmaster = True
		Case 2
			Superboardmaster = True
			Boardmaster = True
		Case 1
			Master = True
			Boardmaster = True
		End Select
		If UserSession.documentElement.selectSingleNode("userinfo/@ischallenge").text  = "1" Then FoundIsChallenge = True
		If DateDiff("d",LastLogin,Now())<>0 Then
			Execute("Update [Dv_User] Set UserToday='0|0|0|0|0',LastLogin = " & SqlNowString & " Where UserID = " & UserID)
			UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text = "0|0|0|0|0"
			LastLogin = Now()
		End If
		If Userhidden = 2 and DateDiff("s",Lastlogin,Now())>Clng(Forum_Setting(8))*60 Then
			Execute("Update [Dv_User] Set UserLastIP = '" & UserTrueIP & "',LastLogin = " & SqlNowString & " Where UserID = " & UserID)
			Lastlogin = Now()
		End If
		sendmsgnum=0:sendmsgid=0:sendmsguser=""
		If UserSession.documentElement.selectSingleNode("userinfo/@usermsg").text<>"" Then
			Dim Usermsg
			Usermsg=Split(UserSession.documentElement.selectSingleNode("userinfo/@usermsg").text,"||")
			If Ubound(Usermsg)=2 Then
				sendmsgnum=Usermsg(0)
				sendmsgid=Usermsg(1)
				sendmsguser=Usermsg(2)
			End If
		End If
		'跟踪用户处理
		Dim FollowMsgID
		Set FollowMsgID=UserSession.documentElement.selectSingleNode("userinfo/@followmsgid")
		If Not ( FollowMsgID Is Nothing) Then
		If FollowMsgID.text <>"" Then
			Dim ToolsFollowUserID,i,Rs,Tools_inceptid,Tools_newincept,Tools_msginfo
		ToolsFollowUserID = Split( FollowMsgID.text,",")
		For i=0 To Ubound(ToolsFollowUserID)
				If Len(ToolsFollowUserID(i))>0 and Len(ToolsFollowUserID(i))<50 and ToolsFollowUserID(i)<>"" Then
					ToolsFollowUserID(i) = CheckStr(ToolsFollowUserID(i))
						Execute("Insert into Dv_Message (incept,sender,title,content,sendtime,flag,issend) values ('"& ToolsFollowUserID(i)&"','系统消息','您跟踪的用户"&Dvbbs.MemberName&"已登录','您使用了论坛道具“狗仔队”，您所跟踪的用户 "&Dvbbs.Membername&" 于 "&Now()&" 登录了论坛，请您及时和该用户取得联系，感谢您采用我们的服务。',"&SqlNowString&",0,1)")
					Set Rs=Execute("Select top 1 id,sender From Dv_Message Where incept ='"& ToolsFollowUserID(i) &"'")
						Tools_inceptid=Rs(0) &"||"& Rs(1)
						Set Rs=Execute("Select Count(id) From Dv_Message Where Flag=0 and issend=1 and delR=0 And incept='"& ToolsFollowUserID(i) &"'")
						Tools_newincept = Rs(0)
						Set Rs=Nothing
					If IsNull(Tools_newincept) Then Tools_newincept=0
						Tools_msginfo=Tools_newincept & "||" & Tools_inceptid
						Execute("update [dv_user] set UserMsg='"&CheckStr(Tools_msginfo)&"' where username='"&ToolsFollowUserID(i)&"'")
				End If
			Next
			 FollowMsgID.text = ""
			Execute("UpDate Dv_User Set FollowMsgID='' Where UserID="&UserID)
		End If
		End If
		FoundUser=True
		UserSession.documentElement.selectSingleNode("userinfo/@lastlogin").text=Lastlogin
		Dim iUserMagicFace'用户头像处理
		iUserMagicFace = Split(UserSession.documentElement.selectSingleNode("userinfo/@userface").text,"|")
		If Ubound(iUserMagicFace) = 1 Then UserSession.documentElement.selectSingleNode("userinfo/@userface").text = iUserMagicFace(1)
	End Sub
	Private Sub GetGroupSetting()
		If Not IsObject(Application(CacheName &"_groupsetting")) Then LoadGroupSetting()
		If Application(CacheName &"_groupsetting").documentElement.selectSingleNode("usergroup[@usergroupid='"& UserGroupID &"']/@groupsetting") Is nothing Then UserGroupID=7
		GroupSetting = Split(Application(CacheName &"_groupsetting").documentElement.selectSingleNode("usergroup[@usergroupid='"& UserGroupID &"']/@groupsetting").text,",")
		If ScriptName="reg.asp"  or ScriptName ="login.asp" or Page_Admin Then GroupSetting(0)=1
		If Cint(GroupSetting(0))=0  Then AddErrCode "8":Showerr()
		UserGroupParent = Cint(Application(CacheName &"_groupsetting").documentElement.selectSingleNode("usergroup[@usergroupid='"& UserGroupID &"']/@parentgid").text)
		UserGroupParentID=Split(Application(CacheName &"_groupsetting").documentElement.selectSingleNode("usergroup[@usergroupid='"& UserGroupID &"']/@issetting").text,"|")
		If UserID > 0 Then IsUserPermissionAll = CLng(UserSession.documentElement.selectSingleNode("userinfo/@isuserpermissionall").text)
		If BoardID > 0 And Not ScriptName="showerr.asp" Then CheckBoardInfo()
		If UserID > 0 And BoardID=0 Then
			If IsUserPermissionAll="1" Then LoadUserPermission_All()
		End If
		If Not (UserSession.documentElement.selectSingleNode("userinfo/@usergroupid2") is Nothing )  Then
				If  CLng(UserSession.documentElement.selectSingleNode("userinfo/@usergroupid2").text) >0 Then
					IsUserPermissionOnly = 1
				End If
		End If
			'If GroupSetting(70)="1"  Then
			'	Master = True
			'Else
			'	Master = False
			'End If
	End Sub
	'用户是否存在论坛全局自定义权限
	Public Function FoundUserPermission_All()
		Dim PerRs
		FoundUserPermission_All = 0
		Set PerRs=Execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid=0 And uc_UserID= "& UserID )
		If Not (PerRs.Eof And PerRs.Bof) Then FoundUserPermission_All = 1
		PerRs.Close:Set PerRs=Nothing
	End Function
	Public Sub LoadUserPermission_All()
		Dim Rs
		Set Rs=Dvbbs.execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid=0 And uc_UserID="&UserID)
		If Not(Rs.Eof And Rs.Bof) Then
			UserPermission=Split(Rs(0),",")
			GroupSetting = Split(Rs(0),",")
			FoundUserPer=True
		End If
		Set Rs=Nothing
	End Sub
	Public Sub ActiveOnline()
		'Response.Write "<script id=""GetActiveOnline"" language = ""javaScript"" src = ""ActiveOnline.asp?state="&Stats&"&boardid="&Boardid&""" type=""text/javascript""></script>"
		Response.Write "<script language=""JavaScript"">"
		Response.Write "setTimeout('ActiveOnline("&boardid&")',2000);"
		Response.Write "</script>"
	End Sub
	Public Sub ActiveOnline1()
		'当在120秒内刷新同一个页面则不更新online数据
		If Not IsNumeric(UserSession.documentElement.selectSingleNode("userinfo/@boardid").text) Or UserSession.documentElement.selectSingleNode("userinfo/@boardid").text="" Then UserSession.documentElement.selectSingleNode("userinfo/@boardid").text="0"
		If DateDiff("s",UserSession.documentElement.selectSingleNode("userinfo/@activetime").text,Now()) < 120 And CLng(UserSession.documentElement.selectSingleNode("userinfo/@boardid").text) = BoardID  And Not InStr(ScriptName,"showerr")>0 Then Exit Sub
		'更新数组
		UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=Now()
		UserSession.documentElement.selectSingleNode("userinfo/@boardid").text=boardid
		UserActiveOnline
		'新增更新用户最后登录时间，以保证贴子中在线判断的准确性
		If UserSession.documentElement.selectSingleNode("userinfo/@userid").text <> "0" Then
			If UserSession.documentElement.selectSingleNode("userinfo/@userhidden").text="2" Then
				Execute("update [Dv_user] set lastlogin=" & SqlNowString & " where userid="&Dvbbs.userid)
			End If
		End If
	End Sub
	Private Sub UserActiveOnline()
		Dim Actcome,SQl,Rs
		Dim uip,StatsStr
			uip = UserTrueIP
        	StatsStr = Stats