class_sys.asp

电子备课系统

		If Err Then Err.clear:isopen=0
		Randomize
		OBASN=CStr(Int(900000*Rnd)+100000)
		CodeUrl = blogurl & IncCodePath & "?s="&OBASN
		ist= Not(Int(Right(OBASN,1)) = 0  Or Int(Right(OBASN,1)) = 6 ) And oblog.CacheConfig(85)=2
		If  isopen=0 Or right(split(LCase(Trim(Request.ServerVariables("SCRIPT_NAME"))),".asp")(0),5)="login" Or ist Then 
		If Err Then Err.clear 
			getcode = "<img id=""ob_codeimg"" src="""&CodeUrl&""" style=""cursor:hand;border:1px solid #ccc;vertical-align:top;"" onclick=""this.src='"&CodeUrl&"&t='+ Math.random();"" alt=""如果看不清数字或字母?请点一下换一个!"" title=""如果看不清数字或字母?请点一下换一个!"" /><input type=""hidden"" name=""ob_codename"" value="""&OBASN&""" /> " &vbcrlf
	

		ElseIf  isopen=1 Or isopen=2 Then 
			getcode=getcode2(OBASN )

		End If 
	End Function
'------(F)--------------生成并输出新的验证方式的验证
	Public Function GetCode2(OBASN)
		Dim CodeUrl
		Session("Ob_Ask_Shake_hands"&OBASN)=OBASN&"|" & "1"
		CodeUrl = blogurl & IncCodePath & "?s="&OBASN
		Rndcode(OBASN)
		GetCode2 = "<span id=""ob_codeimg"" onclick=""obaddjs('"&CodeUrl&"')"" alt=""如果看懂问题或不知道怎么回答?请点一下换一个!"" title=""如果看懂问题或不知道怎么回答?请点一下换一个!"" style=""cursor:hand;"">"&Session("OblogGetCode2_ask_"&OBASN)&"<br/>(请将答案填入验证码输入框.)</span><input type=""hidden"" name=""ob_codename"" value="""&OBASN&""" />"
	End Function 

	Public Function Rndcode(OBASN)
	Dim sSql,rs
		sSql="select top 1 * From Oblog_Verifiydata "
		If Is_Sqldata = 1 Then
			sSql= sSql & " Order By Newid()"
		Else
			Randomize
			sSql= sSql & " Order By Rnd(-(ID+"&Rnd()&"))"
		End If
		Set rs=oblog.Execute (sSql)
		If Not (rs.eof Or rs.bof) Then 
		session("OblogGetCode2_ask_"&OBASN)=rs("ask")
		Session("GetCode"&OBASN)=rs("answer")
		Else
		session("OblogGetCode2_ask_"&OBASN)="随记问题数据库内没有随记问题数据!"
		Session("GetCode"&OBASN)=Empty
		End If 
	End Function 
'-------------------------------------------

	'检查验证码是否正确
	Public Function codepass()
		Dim CodeStr,codename,i,a
		CodeStr = Trim(Request("CodeStr"))
		codename = Trim(Request("ob_codename"))
		If LCase(CStr(Session("GetCode"&codename))) = LCase(CStr(CodeStr)) And CodeStr <> "" Then
			codepass = True
			Session("GetCode"&codename) = Empty
			Session("OblogGetCode2_ask_"&codename) = Empty
			Session("Ob_Ask_Shake_hands"&codename) = Empty
		ElseIf InStr(LCase(CStr(Session("GetCode"&codename))),"|")  And CodeStr <> ""  Then
			a=Split(LCase(CStr(Session("GetCode"&codename))),"|")
			For i=0 To UBound(a)
			If a(i) = LCase(CStr(CodeStr)) Then codepass = True
			Next 
			Set a=Nothing 
			Set i=Nothing 
			Session("GetCode"&codename) = Empty
			Session("OblogGetCode2_ask_"&codename) = Empty
			Session("Ob_Ask_Shake_hands"&codename) = Empty
		Else 
			codepass = False
			Session("GetCode"&codename) = Empty
			Session("OblogGetCode2_ask_"&codename) = Empty
		End If
		End Function

	Public Function type_domainroot(Str,sType)
		Dim domainroot, i
		If sType = 0 Then
			domainroot = Trim(cacheConfig(4))
		ElseIf sType = 1 Then
			domainroot = Trim(cacheConfig(75))
		End if
		If InStr(domainroot, "|") > 0 Then
			domainroot = Split(domainroot, "|")
			For i = 0 To UBound(domainroot)
				If Trim(domainroot(i)) <> "" Then
					If domainroot(i) = Str Then
					type_domainroot = type_domainroot & "<option value='" & Trim(domainroot(i)) & "' selected>" & "." & domainroot(i) & "</option>"
					Else
					type_domainroot = type_domainroot & "<option value='" & Trim(domainroot(i)) & "'>" & "." & domainroot(i) & "</option>"
					End If
				End If
			Next
		Else
			type_domainroot = "<option value='" & domainroot & "'>" & "." & domainroot & "</option>"
		End If
	End Function

	Public Function show_class(kind, CurrentID, kindType)
		If kind = "user" Then
			kind = 1
		Else
			kind = 2
		End if
		show_class=SelectedClassString(kind,kindType,CurrentID)
	End Function

	'取用户分类
	Public Function show_Postclass(CurrentID)
		show_Postclass=UserPostClass(2,0,CurrentID)
	End Function

	Public Sub AddErrStr(message)
		If errstr = "" Then
			errstr = message
		Else
			errstr = errstr & "_" & message
		End If
	End Sub

	Public Sub ShowErr()
		If errstr <> "" Then Response.Redirect blogurl & "err.asp?message=" & errstr
	End Sub

	Public Sub ShowUserErr()
		If errstr <> "" Then Response.Redirect blogurl & "user_prompt.asp?message=" & errstr
	End Sub

	Public Sub SaveCookie(username, password, CookieDate)
		Dim rs,userurl
		Set rs = oblog.Execute ("SELECT user_domain,user_domainroot,user_dir,user_folder FROM oblog_user WHERE username = '"&username&"' AND TruePassWord = '"&password&"' ")
		If rs.Eof Then Set rs = Nothing : Exit Sub
		If CacheConfig(4) <> "" And CacheConfig(5) = "1" Then
			'启用二级域名
			userurl = Trim(rs("user_domain")) & "." & Trim(rs("user_domainroot"))
		Else
			'未启用二级域名则从根目录开始访问，不包含域名
			userurl = blogdir & Trim(rs("user_dir")) & "/" & Trim(rs("user_folder")) & "/index." & f_ext
		End If
		select Case CookieDate
			Case 0
				'not save
			Case 1
				Response.Cookies(cookies_name).Expires = Date + 1
			Case 2
				Response.Cookies(cookies_name).Expires = Date + 31
			Case 3
				Response.Cookies(cookies_name).Expires = Date + 365
			Case Else
		End select
		If cookies_domain <> "" Then
			Response.Cookies(cookies_name).domain = cookies_domain
		End If
		Response.Cookies(cookies_name).Path   =   blogdir
		'不加密用户名,使登录的时候直接返回用户名.减少用户输入.
		Response.Cookies(cookies_name)("username") = username
		Response.Cookies(cookies_name)("password") = CodeCookie(password)
		Response.Cookies(cookies_name)("userurl") = CodeCookie(userurl)
	End Sub

	Public Sub ob_chklogin(username, password, CookieDate)
		Dim rs, sql ,TruePassWord,user_group,rsLogin,rsGroup
		TruePassWord = RndPassword(16)
		If Not IsObject(conn) Then link_database
		Set rs = Server.CreateObject("adodb.recordset")
		sql = "select lockuser,userid,user_group,scores,		TruePassWord,LastLoginIP,LastLoginTime,LoginTimes,user_domain,user_domainroot,user_dir,user_folder,"
		sql = sql & " user_upfiles_size"
		sql = sql & " FROM oblog_user "
		sql = sql & " WHERE username='" & username & "' AND password ='" & password & "' AND isdel=0 "
'		OB_Debug sql,1
		rs.open sql, conn, 1, 3
		If rs.EOF Then
			rs.Close: Set rs = Nothing
			adderrstr ("用户名或密码错误，请重新输入！")
			Exit Sub
		Else
			If rs("lockuser") = 1 Then
				rs.Close: Set rs = Nothing
				adderrstr ("对不起！你的ID已被锁定，不能登录！")
				Exit Sub
			Else
				'判断用户是否达到升级积分
				user_group = rs ("user_group")
				If IsNumeric(user_group) Then
					'获得组信息
					Set rsGroup = Execute ("select g_level FROM oblog_groups WHERE  groupid = "&user_group)
					If rsGroup.EOF Then
						ShowMsg "用户组信息不存在，请联系管理员",""
						Exit Sub
					End if
					'判断
					Set rsLogin=Execute("select top 1 groupid,g_points,g_autoupdate From oblog_groups Where g_level>" & Int(rsGroup(0)) & " Order By g_level")
					If Not rsLogin.Eof Then
						If rsLogin(2)=1 Then
						'判断是否需要升级
							If rs("scores")>=Int(rsLogin(1)) Then
								Execute ("update oblog_groups set g_members=g_members-1 WHERE groupid = " &user_group)
								Execute ("Update oblog_user Set user_group=" & rsLogin(0) & " Where userid=" & rs("userid"))
								Execute ("update oblog_groups set g_members=g_members+1 WHERE groupid = " &rsLogin(0))
							End If
						End If
					End If
				End If
				'基础防护，防止开启二级域名之后，之前的用户二级域名为空
				If oblog.CacheConfig(4)<>"" And oblog.CacheConfig(5) = "1" Then
					Dim user_domainroot,Arr_domainroot,TEMP_domainroot
					TEMP_domainroot=Trim(oblog.CacheConfig(4))
					If InStr(TEMP_domainroot,"|")>0 Then
						Arr_domainroot=Split(TEMP_domainroot,"|")
						user_domainroot=Arr_domainroot(0)
					Else
						user_domainroot=TEMP_domainroot
					End If
					rs("user_domain") = OB_IIF (rs("user_domain"),rs("userid"))
					rs("user_domainroot") = OB_IIF (rs("user_domainroot"),user_domainroot)
				End if
				'基础保护，登录时验证用户目录字段是否为空
				rs("user_dir") = OB_IIF (rs("user_dir"),setup(8,0))
				If CacheConfig (6) = "1" Then
					rs("user_folder") = OB_IIF (rs("user_folder"),username)
				Else
					rs("user_folder") = OB_IIF (rs("user_folder"),rs("userid"))
				End If
				rs("scores") = OB_IIF (rs("scores"),0)
				rs("user_upfiles_size") = OB_IIF (rs("user_upfiles_size"),0)
				rs("TruePassWord") = TruePassWord
				rs("LastLoginIP") = UserIp
				rs("LastLoginTime") = ServerDate(Now())
				rs("LoginTimes") = rs("LoginTimes") + 1
				rs.Update
				SaveCookie username, TruePassWord, CookieDate
				rsGroup.Close: Set rsGroup = Nothing
				rs.Close: Set rs = Nothing
			End If
		End If
	End Sub

	Public Function CheckUserLogined()
		'On Error Resume Next
		Dim Logined, rsLogin, sqlLogin, sSql, user_info ,tLogined ,i
		Logined = True
		'不加密用户名,使登录的时候直接返回用户名.减少用户输入.
		l_uName = filt_badstr(Request.Cookies(cookies_name)("username"))
		l_uPass = filt_badstr(DecodeCookie(Request.Cookies(cookies_name)("password")))
		If l_uName = "" Then
			Logined = False
		End If
		If l_uPass = "" Then
			Logined = False
		End If
		sSql = "userid,user_level,user_showlogword_num,user_upfiles_max,user_upfiles_size,user_dir,isubbedit,user_domain,"
		sSql = sSql &"user_domainroot,lockuser,user_folder,adddate,user_info,user_Icon1,user_Icon2,user_group,lastcomment,"
		sSql = sSql &"lastmessage,scores,Nickname,comment_count,message_count,newbie,lastlogintime,log_count,user_siterefu_num,passport_userid,is_log_default_hidden" & str_domain
		If Logined = True Then
			If Session ("CheckUserLogined_"&l_uName) = "" Then
				'除了str_domain，0-27列
				sqlLogin = "select " & sSql & " from oblog_user where Username='" & l_uName & "' and TruePassword='" & l_uPass & "' "
				Set rsLogin = Execute(sqlLogin)
				
				If rsLogin.EOF Then
					CheckUserLogined = false
					Exit Function
				Else
					If rsLogin(9) = 1 Or IsNull( rsLogin(9)) Then
						Set rsLogin = Nothing
						adderrstr ("当前用户已被系统锁定，无法进行操作，请联系管理员！")
						showerr
						Exit Function
					End If
					For i = 0 To 27
						tLogined = tLogined & "$$$" & rsLogin(i)
					Next
					tLogined = Right (tLogined,Len(tLogined)-3)
					If str_domain <> "" Then tLogined = tLogined & "$$$" &rsLogin("custom_domain")
					Session ("CheckUserLogined_"&l_uName) = tLogined
				End If
			End If
			tLogined = Session ("CheckUserLogined_"&l_uName)
			tLogined = Split (tLogined,"$$$")
'			Response.Write tLogined(18)
'			Response.Write tLogined(19)
'			Response.Write tLogined(20)
'			Response.Write UBound(tLogined)
			If UBound(tLogined) > 28 Or UBound(tLogined) = 0 Or UBound(tLogined) = -1 Then
				Session ("CheckUserLogined_"&l_uName) = ""
				Response.Redirect (blogurl & "login.asp")
				Exit Function
			End if
			l_uId = Int(tLogined(0))
			l_ulevel = Int(tLogined(1))
			l_uShowlogWord = Int(tLogined(2))
			l_uDir = tLogined(5)
			l_isUbb = OB_IIF(Int(tLogined(6)),2)
			l_uDomain = tLogined(7) & "." & tLogined(8)
			l_uFolder = tLogined(10)
			l_uGroupId=Int(tLogined(15))
			l_uUpUsed=Int(tLogined(4))
			l_uLastComment=tLogined(16)
			l_uLastMessage=tLogined(17)
			l_uScores=Int(tLogined(18))
			l_uNickname=tLogined(19)
			l_uCommentCount=Int(tLogined(20))
			l_uMessageCount=Int(tLogined(21))
			l_uNickname = ob_IIF(l_uNickname,l_uName)
			If InStr(tLogined(11), "$") Then
				user_info = Split(tLogined(11), "$")
				l_uFrame = user_info(1)
			Else
				l_uFrame = 1
			End If
			If true_domain = 1 Then
				'判断用户绑定的顶级域名
				l_ucustomdomain = tLogined(28)
				If l_ucustomdomain <> "" Then
					l_uDomain = l_ucustomdomain
				End If
			End If
			l_is_log_default_hidden=OB_IIF(tLogined(27),0)
			l_passport_userid=OB_IIF(tLogined(26),0)
			l_uNewBie=OB_IIF(Int(tLogined(22)),0)
			l_uIco=ProIco(tLogined(13), 1)
			l_uLastLogin=tLogined(23)
			l_ulogcount=Int(tLogined(24))
			l_uvisitcount=Int(tLogined(25))
			l_uAddtime=tLogined(11)
			Call GetGroupInfo
			Set rsLogin = Nothing
		End If

		If l_isUbb > 0 Then C_Editor_Type = l_isUbb
		Select Case C_Editor_Type
			Case 1
				C_Editor=blogdir&"editor"
				C_Editor_LoadIcon="yes"
			Case 2
				C_Editor=blogdir&"editor2"
				C_Editor_LoadIcon="none"
		End Select
		C_Editor_UBB=blogurl&"editor"
		If Err Then
			Err.Clear
			Session ("CheckUserLogined_"&l_uName) = ""
			Logined = False
			Response.Redirect (blogurl & "index.asp")
		End If
		CheckUserLogined = Logined
	End Function
	'组信息
	Public Sub GetGroupInfo()
		Dim rst
		Set rst=Execute("select * From oblog_groups Where groupid=" & Int(l_uGroupId) )
		If Not rst.Eof Then
			l_Group=rst.GetRows(1)
		Else
			ShowMsg "用户组信息不存在，请联系管理员","index.asp"
		End If
		Set rst=Nothing
	End Sub

	Public Sub CreateUserDir(ustr, action)
		Dim fso, sql, rs, udir, uid, upath, loginstr, searchstr, bname, ufolder, utruepath,uname
		sql = "select userid,user_dir,blogname,user_folder,username,user_domain,user_domainroot" & str_domain & " from oblog_user where "
		If action = 0 Then sql = sql & "userid=" & Int(ustr) Else sql = sql & "username='" & filt_badstr(ustr) & "'"
		Set rs = Execute(sql)
		If Not rs.EOF Then
			udir = rs(1)
			uid = rs(0)
			bname = rs(2)
			ufolder = rs(3)
			uname = rs(4)
			'基础保护，防止无法生成用户页面
			If udir = "" Or IsNull(udir) Then
				udir = setup(8,0)
				Execute ("UPDATE oblog_user SET user_dir = "&udir&" WHERE userid = " &uid)
			End If
			If ufolder = "" Or IsNull(ufolder) Then
				If CacheConfig (6) = "1" Then
					ufolder = uid
				Else
					ufolder = uname
				End If
				Execute ("UPDATE oblog_user SET user_folder = "&ufolder&" WHERE userid = " &uid)
			End If
			If true_domain = 1 Then