job_clsmain.asp

嘉缘人才6.0精简 ,很好用的人才系统

		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)&"','系统消息','您跟踪的用户"&FRHRcms.MemberName&"已登录','您使用了论坛道具“狗仔队”，您所跟踪的用户 "&FRHRcms.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=FRHRcms.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()
		'当在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
				FRHRcms.execute("update [Dv_user] set lastlogin=" & SqlNowString & " where userid="&FRHRcms.userid)
			End If
		End If
	End Sub
	Private Sub UserActiveOnline()
		Dim Actcome,SQl,Rs
		Dim uip,StatsStr
			uip = UserTrueIP
        	StatsStr = Stats
        	StatsStr = Replace(StatsStr, "'", "")
        	StatsStr = Replace(StatsStr, Chr(0), "")
        	StatsStr = Replace(StatsStr, "--", "——")
        	StatsStr = Left(StatsStr, 250)
		If UserID = 0 Then
			Dim StatUserID
			StatUserID = UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text
			SQL = "Select ID,Boardid From [Dv_Online] Where ID = " & Ccur(StatUserID)
			Set Rs = Execute(SQL)
			If Rs.EOF  Then
				If IP_MAX>0 Then
					If Onlineip(UserTrueIP) > IP_MAX Then
						Session(CacheName & "UserID")=empty
						Set FRHRcms=Nothing
						Response.Status = "302 Object Moved" 
						Response.End  	
	  			End If
  			End if
				If CInt(Forum_Setting(36)) = 0 Then
					Actcome = ""
				Else
					Actcome = address(uip)
				End If
				If Cls_IsSearch Then Exit Sub  '不记录搜索引擎的客人 2004-8-30 Dv.Yz
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden,actforip) Values (" & StatUserID & ",'客人','客人','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & platform&"|"&Browser&version & "','" & StatsStr & "',7,'" & Actcome & "'," & Userhidden & ",'"& checkstr(actforip)&"')"
				'更新缓存总在线数据
				MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
				Name="Forum_Online"
				value=MyBoardOnline.Forum_Online 
			Else
				SQL = "Update [Dv_Online] Set Lastimebk = " & SqlNowString & ",Boardid = " & Boardid & ",Stats = '" & StatsStr & "' Where ID = " & Ccur(StatUserID)
			End If
			Rs.Close
			Set Rs = Nothing
			Execute(SQL)
		Else
			SQL = "Select ID,Boardid From [DV_Online] Where UserID = " & UserID
			Set Rs = Execute(SQL)
			If Rs.Eof And Rs.Bof Then
				If CInt(forum_setting(36)) = 0 Then
					Actcome = ""
				Else
					Actcome = address(uip)
				End If
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden,UserID,actforip) Values (" & Session.SessionID & ",'" & Membername & "','" & Memberclass & "','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & platform&"|"&Browser&version & "','" & StatsStr & "'," & UserGroupID & ",'" & Actcome & "'," & Userhidden & "," & UserID & ",'"& checkstr(actforip)&"')"
				'更新缓存总在线数据
				MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
				Name="Forum_Online"
				FRHRcms.value=MyBoardOnline.Forum_Online
				'更新缓存总用户在线数据
				MyBoardOnline.Forum_UserOnline=MyBoardOnline.Forum_UserOnline+1
				Name="Forum_UserOnline"
				value=MyBoardOnline.Forum_UserOnline
			Else
				SQL = "Update [Dv_Online] Set Lastimebk = " & SqlNowString & ",Boardid = " & Boardid & ",Stats = '" & StatsStr & "' Where UserID = " & UserID
			End If
			Rs.Close
			Set Rs = Nothing
			Execute(SQL)
		End If	
		'更新在线峰值
		If CLng(MyBoardOnline.Forum_Online) > CLng(Maxonline) Then
			Execute("update [Dv_setup] set Forum_Maxonline="&CLng(MyBoardOnline.Forum_Online)&",Forum_MaxonlineDate="& SqlNowString) 
			CacheData(5,0)=MyBoardOnline.Forum_Online
			CacheData(6,0)=Now()
			Name="setup"
			value=CacheData
		End If
		Rem 删除超时用户
		MyBoardOnline.OnlineQuery
	End Sub
	'去掉HTML标记
	Public Function Replacehtml(Textstr)
		Dim Str,re
		Str=Textstr
		Set re=new RegExp
			re.IgnoreCase =True
			re.Global=True
			re.Pattern="<(.[^>]*)>"
			Str=re.Replace(Str, "")
			Set Re=Nothing
			Replacehtml=Str
	End Function
	Function Onlineip(ip)
		Dim SQl
		SQL="Select Count(*) From Dv_online where ip='"&ip&"'"
		Onlineip=Execute(SQL)(0)
		If IsNull(Onlineip) Then Onlineip=0
	End Function
	Public Sub Nav()
		Head()
		ShowTopTable()
		IsTopTable = 1
	End Sub
	Public Sub head()
		Nowstats=stats
		If ScriptName="index.asp" Then
			If BoardType<>"" Then Stats=BoardType & Left(Replacehtml(boardreadme),20)&"...."
		ElseIf ScriptName <> "dispbbs.asp" Then
			If BoardType<>"" Then Stats=BoardType&"-"&Stats
		End If
		Stats=Replace(Stats,Chr(13),"")
		stats=Replacehtml(stats)
		'搜索引擎优化部分
		If Request("IsSearch_a") <> "" Then stats = stats & "-网站地图"
		Nowstats=Replacehtml(Nowstats)
		If IsSearch Then