class_sys.asp

电子备课系统

<%
Class class_sys
	Public Cache_Name, Cache_Name_Custom, Cache_data ,SqlQueryNum ,SqlQuery
	Public Reloadtime, setup, UserIp, ErrStr, AutoUpdate,CacheScores,CacheConfig,CacheCompont,CacheReport
	Public Userdir, User_CopyRight, ver, Is_password_cookies, defaultGroup
	Public l_uId, l_uName, l_uNickname,l_uPass, l_ulevel, l_uShowlogWord, l_uDir, l_isUbb, l_uDomain
	Public l_uFolder, l_uFrame,l_uGroupId,l_ucustomdomain,l_uUpUsed,l_uIco,l_uScores ,l_uNewBie,l_uAddtime
	Public l_uLastLogin,l_uLastComment,l_uLastMessage,l_uCommentCount,l_uMessageCount,l_uVisitCount,l_ulogcount
	Public l_Group,ShowBadWord,Time_Zone
	Public KeyWords1,KeyWords2,KeyWords3,KeyWords4
	Public NowUrl,Comeurl
	Public l_passport_userid ,l_is_log_default_hidden


	Private Sub Class_initialize()
		Reloadtime = 14400
		Cache_Name = blogdir & Cache_Name_user
		UserIp = GetIP
		Comeurl = LCase(Trim(Request.ServerVariables("HTTP_REFERER")))
		NowUrl = LCase(Trim(Request.ServerVariables("PATH_INFO")))
		ver = "4.50 Final"
		AutoUpdate = True			'更新整站首页开关
		Is_password_cookies = 0		'是否编码cookies,1为开启,0为关闭
		SqlQueryNum = 0
		Call ResetClassCache
	End Sub

	Private Sub class_terminate()
		On Error Resume Next
		If IsObject(conn) Then conn.Close: Set conn = Nothing
	End Sub

	Public Property Let name(ByVal vNewValue)
		Cache_Name_Custom = LCase(vNewValue)
	End Property

	Public Property Let Value(ByVal vNewValue)
		If Cache_Name_Custom <> "" Then
			ReDim Cache_data(2)
			Cache_data(0) = vNewValue
			Cache_data(1) = Now()
			Application.Lock
			Application(Cache_Name & "_" & Cache_Name_Custom) = Cache_data
			Application.unLock
		Else
			Err.Raise vbObjectError + 1, "CacheServer", " please change the CacheName."
		End If
	End Property

	Public Property Get Value()
		If Cache_Name_Custom <> "" Then
			Cache_data = Application(Cache_Name & "_" & Cache_Name_Custom)
			If IsArray(Cache_data) Then
				Value = Cache_data(0)
			Else
				Err.Raise vbObjectError + 1, "CacheServer", " The Cache_Data(" & Cache_Name_Custom & ") Is Empty."
			End If
		Else
			Err.Raise vbObjectError + 1, "CacheServer", " please change the CacheName."
		End If
	End Property

	Public Property Get SysDir()
		sysDir = Array ("admin","api","cam","data","editor","editor2","gg","images","inc","manager","oblogstyle","plus","skin","xmldata","xml-rpc")
	End Property

	Public Function ObjIsEmpty()
		ObjIsEmpty = True
		Cache_data = Application(Cache_Name & "_" & Cache_Name_Custom)
		If Not IsArray(Cache_data) Then Exit Function
		If Not IsDate(Cache_data(1)) Then Exit Function
		If DateDiff("s", CDate(Cache_data(1)), Now()) < (60 * Reloadtime) Then ObjIsEmpty = False
	End Function

	Public Sub DelCahe(MyCaheName)
		Application.Lock
		Application.Contents.Remove (Cache_Name & "_" & MyCaheName)
		Application.unLock
	End Sub

	Public Sub ReloadSetup()
		Dim sql, rs, i
		sql = "select * from [oblog_setup] "
		Set rs = execute(sql)
		If rs.eof Then
			Response.Write "[oblog_setup]表信息不存在，无法正常运行程序！"
			Response.End
		End if
		name = "setup"
		Value = rs.GetRows(1)
		Set rs = Nothing
		Application.Lock
		Application(Cache_Name & "_index_update") = True
		Application(Cache_Name & "_list_update")  = True
		Application(Cache_Name & "_class_update") = False
		Application(Cache_Name & "_group_theme_main")=""
		Application(Cache_Name & "_Class_NeedUpdate")= True
		Application.unLock
	End Sub

	Public Sub ReLoadCache()
		Dim sql, rs, i,arr
		sql = "select * from oblog_config"
		Set rs = Execute(sql)
		If rs.eof Then
			Response.Write "[oblog_config]表信息不存在，无法正常运行程序！"
			Response.End
		End if
		Application.Lock
		rs.Filter="id=1"
		If Not rs.Eof Then
			arr=Split(rs(1),"$$")
		Else
			arr=""
		End If
		Application(Cache_Name & "_Config") = arr
		CacheConfig=Application(Cache_Name & "_Config")
		rs.Filter="id=2"
		If Not rs.Eof Then
			arr=Split(rs(1),"$$")
		Else
			arr=""
		End If
		Application(Cache_Name & "_Compont") = arr
		CacheCompont=Application(Cache_Name & "_Compont")
		rs.Filter="id=3"
		 If Not rs.Eof Then
			arr=Split(rs(1),"$$")
		Else
			arr=""
		End If
		Application(Cache_Name & "_Scores") = arr
		CacheScores=Application(Cache_Name & "_Scores")
		rs.Filter="id=4"
		 If Not rs.Eof Then
			arr=Split(rs(1),"$$")
		Else
			arr=""
		End If
		Application(Cache_Name & "_WhiteIp") = arr
		rs.Filter="id=5"
		 If Not rs.Eof Then
			arr=Split(rs(1),vbcrlf)
		Else
			arr=""
		End If
		Application(Cache_Name & "_BlackIp") = arr
		rs.Filter="id=6"
		If Not rs.Eof Then
			arr=Split(rs(1),vbcrlf)
		Else
			arr=""
		End If
		Application(Cache_Name & "_Keywords1") = arr
		KeyWords1= arr
		rs.Filter="id=7"
		If Not rs.Eof Then
			arr=Split(rs(1),vbcrlf)
		Else
			arr=""
		End If
		Application(Cache_Name & "_Keywords2") = arr
		KeyWords2= arr
		rs.Filter="id=8"
		If Not rs.Eof Then
			arr=Split(rs(1),vbcrlf)
		Else
			arr=""
		End If
		Application(Cache_Name & "_Keywords3") = arr
		KeyWords3= arr
		rs.Filter="id=9"
		 If Not rs.Eof Then
			arr=Split(rs(1),vbcrlf)
		Else
			arr=""
		End If
		Application(Cache_Name & "_Keywords4") = arr
		KeyWords4= arr
		rs.Filter="id=10"
		If Not rs.Eof Then
			arr=Split(rs(1),vbcrlf)
		Else
			arr=""
		End If
		Application(Cache_Name & "_Report") = arr
		CacheReport= arr
		Set rs=Execute("select top 1 Groupid From oblog_groups Order By g_level")
		Application(Cache_Name & "_defaultGroup") =rs(0)
		defaultGroup=Application(Cache_Name & "_defaultGroup")
		rs.Close
		Set rs=Nothing
		Application.unLock

	End Sub

	'读取用户目录及绑定的路径到缓存
	Public Sub ReloadUserdir()
		Dim sql, rs, s
		sql = "select userdir,dirdomain From oblog_userdir "
		Set rs = Execute(sql)
		While Not rs.EOF
			s = s & rs(0) & "!!??((" & rs(1) & "##))=="
			rs.movenext
		Wend
		Application.Lock
		Application(Cache_Name & "dirdomain") = s
		Application.unLock
		Set rs = Nothing
	End Sub

	Public Sub Start()
		CacheConfig=Application(Cache_Name & "_Config")
		CacheCompont=Application(Cache_Name & "_Compont")
		CacheScores=Application(Cache_Name & "_Scores")
		Keywords1=Application(Cache_Name & "_Keywords1")
		Keywords2=Application(Cache_Name & "_Keywords2")
		Keywords3=Application(Cache_Name & "_Keywords3")
		Keywords4=Application(Cache_Name & "_Keywords4")
		CacheReport=Application(Cache_Name & "_Report")
		defaultGroup=Application(Cache_Name & "_defaultGroup")
		name = "setup"
		If ObjIsEmpty() Then ReloadSetup()
		If Not IsArray(CacheConfig) Then ReLoadCache
		setup = Value
		'用户页面版权信息
		User_CopyRight = CacheConfig(7) & "</div>" & "<div id=""powered""><a href=""http://www.oblog.cn"" target=""_blank""><img src=""images\oblog_powered.gif"" border=""0"" alt=""Powered by "" /></a>"
		If DateDiff("s", Application(Cache_Name & "_index_updatetime"), Now()) > Int(CacheConfig(33)) And Application(Cache_Name & "_class_update") = True And AutoUpdate Then ReloadSetup()
		Time_Zone = Site_Time
	End Sub

	Public Sub Sys_Err(errmsg)
		Dim strErr
		strErr = strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
		strErr = strErr & "<link href='images/style.css' rel='stylesheet' type='text/css'></head><body>" & vbCrLf
		strErr = strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
		strErr = strErr & "  <br><tr align='center'><td height='22' class='title'><strong>错误信息</strong></td></tr>" & vbCrLf
		strErr = strErr & "  <tr><td height='100' class='tdbg' valign='top'><b>产生错误的可能原因：</b><br>" & errmsg & "</td></tr>" & vbCrLf
		strErr = strErr & "  <tr align='center'><td class='tdbg'><a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a></td></tr>" & vbCrLf
		strErr = strErr & "</table>" & vbCrLf
		strErr = strErr & "</body></html>" & vbCrLf
		Response.Write strErr
	End Sub

	Public Function Site_bottom()
		Site_bottom = CacheConfig(10) & vbCrLf
		Site_bottom = Site_bottom & "<div style=""display:block;clear: both;text-align: center;width: 100%;padding: 8;""><a href=""http://www.oblog.cn"" target=""_blank""><img src=""images\oblog_powered.gif"" border=""0"" alt=""Powered by "" /></a></div>" & vbCrLf
		site_bottom = site_bottom &vbCrLf&"</body>" & vbCrLf
		Site_bottom = Site_bottom & "</html>" & vbCrLf
	End Function
	'获取服务器时区
	Function Site_Time()
		Dim intHours,ArrHours
		ArrHours=Split(oblog.CacheConfig(68),".")
		If UBound(ArrHours) = 0  Then
			intHours = oblog.CacheConfig(68)
		Else
			If Not IsNumeric(ArrHours(1)) Then
				intHours = ArrHours(0)
			Else
				intHours = oblog.CacheConfig(68)
			End if
		End If
		intHours =Int(FormatNumber(intHours,2))
		Site_Time = intHours
	End Function

	'------------------------------------------------
	'ServerDate(byval strDate)
	'服务器时差设置
	'回复/留言及发表日志
	'接收Trackback
	'------------------------------------------------
	Function ServerDate(byval strDate)
		Dim intHours
		If Not IsDate(strDate) Then
			ServerDate = Now()
			Exit Function
		End If
		'以北京时间为准
		intHours = Time_Zone - 8
		If Not IsNumeric(intHours) Then
			intHours = 0
			ServerDate = strDate
			Exit Function
		End If
		intHours =Int(intHours)
		If intHours > 24 Or intHours < -24 Then
			intHours = 0
			ServerDate=strDate
			Exit Function
		End If
		ServerDate = Dateadd("h",intHours,strDate)
	End Function

	Public Function Execute(SQL)
		If Not IsObject(CONN) Then link_database
		On Error Resume Next
'		Set Execute = conn.Execute(SQL)
		Dim Cmd
		Set Cmd = Server.CreateObject("ADODB.Command")
		Cmd.ActiveConnection = CONN
		Cmd.CommandText = SQL
		Set Execute = Cmd.Execute
		Set Cmd = Nothing
		If Err Then
			If Not Is_Debug Then
				Err.Clear
				Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
			Else
				OB_DEBUG "<strong>ErrorSQL:</strong>"&SQL&"<br /><br /><strong>Description:</strong>"&Err.Description ,0
			End If
			Set CONN = Nothing
			Response.End
		End if
		SqlQueryNum = SqlQueryNum + 1
		SqlQuery = SqlQuery & sql &"<br />"
	End Function


	Public Function chk_badword(Str)
		On Error Resume Next
		Dim badstr, i, n
		'先检查顶级过滤,如果存在则返回0.1
		'对于0.1情况需要特殊处理,0.1首先满足了>0的特点
		'但是对于日志发布时,如果是0.1,则列为可疑对象
		badstr = KeyWords1
		n = 0
		For i = 0 To UBound(badstr)
			If Trim(badstr(i)) <> "" Then
				If InStr(Str, Trim(badstr(i))) > 0 Then
					chk_badword = 0.1
					ShowBadWord = ShowBadWord & "," &Trim(badstr(i))
					Exit Function
				End If
			End If
		Next
		If ShowBadWord <> "" And Left(ShowBadWord,1)="," Then ShowBadWord =  Right (ShowBadWord,Len(ShowBadWord)-1)
		'检查审核过滤
		badstr = KeyWords2
		n = 0
		For i = 0 To UBound(badstr)
			If Trim(badstr(i)) <> "" Then
				If InStr(Str, Trim(badstr(i))) > 0 Then
					n = n + 1
				End If
			End If
		Next
		chk_badword = n
	End Function

	Public Function filt_badword(Str)
		On Error Resume Next
		Dim badstr, i
        badstr = KeyWords3
        For i = 0 To UBound(badstr)
            If Trim(badstr(i)) <> "" Then
                Str = Replace(Str, badstr(i), "***")
            End If
        Next
        filt_badword = Str
'		Dim objRegExp, strOutput,sKey
'		Set objRegExp = New Regexp
'		strOutput=Str
'		objRegExp.IgnoreCase = True
'		objRegExp.Global = True
'		badstr = KeyWords3
'		If UBound(badstr)=-1 Then
'			filt_badword=Str
'			Exit Function
'		End if
'		sKey=Join(badstr,"|")
'		objRegExp.Pattern = "(" & sKey & ")"
'		strOutput = objRegExp.replace(strOutput,"***")
'		filt_badword = strOutput
	End Function

	Public Function GetCode()
		Dim OBASN,CodeUrl ,Ist,isopen
		isopen=oblog.CacheConfig(85)