<%
Class class_sys
	Public Cache_Name, Cache_Name_Custom, Cache_data
	Public Reloadtime, setup, UserIp, ErrStr, Comeurl, AutoUpdate,CacheScores,CacheConfig,CacheCompont,ShowBadWord
	Public Userdir, User_CopyRight, ver, Is_password_cookies, Is_gb2312,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
	Public KeyWords1,KeyWords2,KeyWords3,KeyWords4
	Private Sub Class_initialize()
		Reloadtime = 14400
		Cache_Name = blogdir & Cache_Name_user
		UserIp = GetIP
		Comeurl = LCase(Trim(request.ServerVariables("HTTP_REFERER")))
		ver = "4.0"
		AutoUpdate = True '更新整站首页开关
		Is_password_cookies = 1 '是否编码cookies,1为开启,0为关闭
		Is_gb2312 = 1   '系统平台，1为简体中文平台，0为其他平台
	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 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
		ReloadCache
		Application.Lock
		Application(Cache_Name & "index_update") = True
		Application(Cache_Name & "list_update") = 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
		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()
		name = "setup"
		If ObjIsEmpty() Then ReloadSetup()
		'If Not IsArray(CacheConfig) Then ReLoadCache()
		'ReloadSetup()
		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")
		defaultGroup=Application(Cache_Name & "_defaultGroup")
		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") = False And AutoUpdate Then
			ReloadSetup()
			Application.Lock
			Application(Cache_Name & "index_update") = True
			Application(Cache_Name & "list_update") = True
			Application(Cache_Name & "class_update") = True
			Application.unLock
			Response.Write ("<script src=""index.asp?re=0""></script>")
		End If
	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 Sub Chk_Comeurl()
		If is_chk_comeurl = 1 Then
			Dim Comeurl, curl
			Comeurl = LCase(Trim(request.ServerVariables("HTTP_REFERER")))
			If Comeurl = "" Then
				Response.Write "<br><p align=center><font color='red'>对不起，为了系统安全，不允许直接输入地址访问本系统的后台管理页面。</font></p>"
				Response.End
			Else
				curl = Trim("http://" & request.ServerVariables("SERVER_NAME"))
				If Mid(Comeurl, Len(curl) + 1, 1) = ":" Then
					curl = curl & ":" & request.ServerVariables("SERVER_PORT")
				End If
				curl = LCase(curl & request.ServerVariables("script_NAME"))
				If LCase(Left(Comeurl, InStrRev(Comeurl, "/"))) <> LCase(Left(curl, InStrRev(curl, "/"))) Then
					Response.Write "<br><p align=center><font color='red'>对不起，为了系统安全，不允许从外部链接地址访问本系统的后台管理页面。</font></p>"
					Response.End
				End If
			End If
		End If
	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

	Public Function Execute(sql)
		If Not IsObject(conn) Then link_database
		If is_debug = 0 Then
			On Error Resume Next
			Set Execute = conn.Execute(sql)
			If Err Then
				Err.Clear
				Set conn = Nothing
				Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
				Response.End
			End If
		Else
			On Error Resume Next
			Set Execute = conn.Execute(sql)
			If Err Then
				Err.Clear
				Set conn = Nothing
				Response.Write sql
				Response.Write Err.Description
				Response.End
			End If
		End If
	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 <> "" 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), "***",1,-1,1)
            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 tmpstr
		Randomize
		tmpstr=cstr(Int(900000*rnd)+100000)
		getcode = "<img id=""ob_codeimg"" src="""&blogurl & "inc/code.asp?s="&tmpstr&""" style=""cursor:hand;border:1px solid #ccc;vertical-align:top;"" onclick=""this.src=this.src+'&t='+ Math.random();""   alt=""看不清?点一下"" /><input type=""hidden"" name=""ob_codename"" value="""&tmpstr&""" /> " &vbcrlf
	End Function
	'检查验证码是否正确
	Public Function codepass()
		Dim CodeStr,codename
		CodeStr = Trim(request("CodeStr"))
		codename = Trim(request("ob_codename"))
		If CStr(Session("GetCode"&codename)) = CStr(CodeStr) And CodeStr <> "" Then
			codepass = True
			Session("GetCode"&codename)=empty
		Else
			codepass = False
			Session("GetCode"&codename)=empty
		End If
	End Function

	Public Function type_domainroot(Str)
		Dim domainroot, i
		domainroot = Trim(cacheConfig(4))
		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)
		Dim rsClass, sqlClass, sTmp, tmpDepth, i
		Dim arrShowLine(20)
		For i = 0 To UBound(arrShowLine)
			arrShowLine(i) = False
		Next
		If kind = "user" Then
			sqlClass = "select * From oblog_userclass order by RootID,OrderID"
		ElseIf kind = "log" Then
			sqlClass = "select * From oblog_logclass  Where idType=" & kindType & " order by RootID,OrderID"
		End If
		Set rsClass = Execute(sqlClass)
		If rsClass.bof And rsClass.EOF Then
			show_class = "<option value='0'>请选择类别</option>"
		Else
			show_class = "<option value='0'>请选择类别</option>"
			Do While Not rsClass.EOF
				tmpDepth = rsClass("Depth")
				If rsClass("NextID") > 0 Then
					arrShowLine(tmpDepth) = True
				Else
					arrShowLine(tmpDepth) = False
				End If
					sTmp = "<option value='" & rsClass("id") & "'"
				If CurrentID > 0 And rsClass("id") = CurrentID Then
					 sTmp = sTmp & " selected"
				End If
				sTmp = sTmp & ">"

				If tmpDepth > 0 Then
					For i = 1 To tmpDepth
						sTmp = sTmp & "&nbsp;&nbsp;"
						If i = tmpDepth Then
							If rsClass("NextID") > 0 Then
								sTmp = sTmp & "├&nbsp;"
							Else
								sTmp = sTmp & "└&nbsp;"
							End If
						Else
							If arrShowLine(i) = True Then
								sTmp = sTmp & "│"
							Else
								sTmp = sTmp & "&nbsp;"
							End If
						End If
					Next
				End If
				sTmp = sTmp & rsClass("classname")
				sTmp = sTmp & "</option>"
				show_class = show_class & sTmp
				rsClass.movenext
			Loop
		End If
		rsClass.Close
		Set rsClass = Nothing
	End Function

	'取用户分类
	Public Function show_Postclass(CurrentID)
		Dim rsClass, sqlClass, sTmp, tmpDepth, i,Sql
		Dim arrShowLine(20)
		For i = 0 To UBound(arrShowLine)
			arrShowLine(i) = False
		Next
		'处理类别
		Dim sClass,sClass1,aClass
		sClass=Trim(l_Group(9,0))
		If sClass="" Or IsNull(sClass) Then
			 sqlClass = "select * From oblog_logclass  Where idType=0 order by RootID,OrderID"
		Else
			'取大类
			Sql="Select * From oblog_logclass Where classid in(" & sClass & ")" &  vbcrlf
			'取各子类
	'			Response.Write sql
			aClass=Split(sClass,",")
			For i=0 To UBound(aClass)
				sClass1=""
				sClass1="0," & aclass(i)
				Sql= Sql & " union " & vbcrlf
				Sql= Sql & " Select * From oblog_logclass Where Left(parentpath,Len('" & sClass1 &"'))='" & sClass1 & "' " & vbcrlf
			Next
			sqlClass="Select * From (" & Sql & ") a order by RootID,OrderID"
	'			Response.Write sqlClass
		End If
		Set rsClass=Server.CreateObject("Adodb.recordset")
		rsClass.Open sqlClass,conn,1,3
		Set rsClass = Execute(sqlClass)
		If rsClass.EOF Then
			show_Postclass = "<option value='0'>请选择类别</option>"
		Else
			show_Postclass = "<option value='0'>请选择类别</option>"
			Do While Not rsClass.EOF
				tmpDepth = rsClass("Depth")
				If rsClass("NextID") > 0 Then
					arrShowLine(tmpDepth) = True
				Else
					arrShowLine(tmpDepth) = False
				End If
					sTmp = "<option value='" & rsClass("id") & "'"
				If CurrentID > 0 And rsClass("id") = CurrentID Then
					 sTmp = sTmp & " selected"
				End If
				sTmp = sTmp & ">"

				If tmpDepth > 0 Then
					For i = 1 To tmpDepth
						sTmp = sTmp & "&nbsp;&nbsp;"
						If i = tmpDepth Then
							If rsClass("NextID") > 0 Then
								sTmp = sTmp & "├&nbsp;"
							Else
								sTmp = sTmp & "└&nbsp;"
							End If
						Else
							If arrShowLine(i) = True Then
								sTmp = sTmp & "│"
							Else
								sTmp = sTmp & "&nbsp;"
							End If
						End If
					Next
				End If
				sTmp = sTmp & rsClass("classname")
				sTmp = sTmp & "</option>"
				show_Postclass = show_Postclass & sTmp
				rsClass.movenext
			Loop
		End If
		rsClass.Close
		Set rsClass = Nothing
	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 "err.asp?message=" & errstr
	End Sub

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

	Public Sub SaveCookie(username, password, CookieDate, userurl)		
		Select Case CInt(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)("username") = CodeCookie(username)
		Response.Cookies(cookies_name)("password") = CodeCookie(password)
		If userurl = "" Or userurl = "." Then userurl = " "
		Response.Cookies(cookies_name)("userurl") = CodeCookie(userurl)
		'Response.End
	End Sub

	Public Sub ob_chklogin(username, password, CookieDate)
		Dim rs, sql, userurl
		If Not IsObject(conn) Then link_database
		Set rs = server.CreateObject("adodb.recordset")
		sql = "Select * from oblog_user Where username='" & username & "' And password ='" & password & "' And isdel=0 "
		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
				rs("LastLoginIP") = UserIp
				rs("LastLoginTime") = ServerDate(Now())
				rs("LoginTimes") = rs("LoginTimes") + 1
				If cacheConfig(4) <> "" And cacheConfig(5) = 1 Then
					'启用二级域名
					userurl = Trim(rs("user_domain")) & "." & Trim(rs("user_domainroot"))
				Else
					'未启用二级域名则从根目录开始访问，不包含域名
					'userurl= trim(setup(3,0)) & trim(rs("user_dir")) & "/" & trim(rs("userid")) & "/index." & f_ext
					userurl = blogdir & Trim(rs("user_dir")) & "/" & Trim(rs("user_folder")) & "/index." & f_ext
				End If
				rs.Update
				SaveCookie username, password, CookieDate, userurl
				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(DecodeCookie(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" & str_domain
		If Logined = True Then
			If Session ("CheckUserLogined") = "" Then
				'除了str_domain，0-25列
				sqlLogin = "select " & sSql & " from oblog_user where lockuser=0 and Username='" & l_uName & "' and Password='" & l_uPass & "' And isdel=0 "
				Set rsLogin = Execute(sqlLogin)
				If rsLogin.EOF Then
					CheckUserLogined = False
					Exit Function
				Else
					If rsLogin(9) = 1 Then
						Set rsLogin = Nothing
						adderrstr ("当前用户已被系统锁定，无法进行操作，请联系管理员！")
						showerr
					End If
					For i = 0 To 25
						tLogined = tLogined & "$$$" & rsLogin(i)
					Next
					tLogined = Replace (tLogined,"$$$","",1,1,0)
'					tLogined = Right (tLogined,Len(tLogined)-3)
					If str_domain <> "" Then tLogined = tLogined & "$$$" &rsLogin("custom_domain")
					Session ("CheckUserLogined") = tLogined
				End If
			End If
			tLogined = Session ("CheckUserLogined")
			tLogined = Split (tLogined,"$$$")
'			Response.Write tLogined(18)
'			Response.Write tLogined(19)
'			Response.Write tLogined(20)
'			Response.Write UBound(tLogined)
			If UBound(tLogined) > 26 Or UBound(tLogined) = -1 Then 
				Session ("CheckUserLogined") = ""
				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 = Int(tLogined(6))
			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))
			If l_uNickname="" Then 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(26)
				If l_ucustomdomain <> "" Then
					l_uDomain = l_ucustomdomain
				End If
			End If
			l_uNewBie=Int(tLogined(22))
			l_uIco=ProIco(tLogined(13), 1)
			l_uLastLogin=tLogined(23)
			l_ulogcount=Int(tLogined(24))
			l_uvisitcount=Int(tLogined(25))
			l_uAddtime=tLogined(11)
			If IsNumeric(l_uGroupId) Then
				'获得组信息
				GetGroupInfo
				'判断
				Set rsLogin=Execute("Select top 1 groupid,g_points,g_autoupdate From oblog_groups Where g_level>" & l_Group(2,0) & " Order By g_level")
				If Not rsLogin.Eof Then
					If rsLogin("g_autoupdate")=1 Then
					'判断是否需要升级
						If l_uScores>=Int(rsLogin(1)) Then
							Execute ("update oblog_groups set g_members=g_members-1 WHERE groupid = " &l_uGroupId)
							Execute ("Update oblog_user Set user_group=" & rsLogin(0) & " Where userid=" & l_uid)
							Execute ("update oblog_groups set g_members=g_members+1 WHERE groupid = " &rsLogin(0))
							Call GetGroupInfo
							'用户升级后需重新载入Session
							Session ("CheckUserLogined") = ""
						End If
					End If
				End If
			End If
			Set rsLogin = Nothing
		End If
		If Err Then 
			Err.Clear
			Session ("CheckUserLogined") = ""
			Logined = False
			Response.Redirect (blogurl & "login.asp")
		End if
		CheckUserLogined = Logined
	End Function
	'组信息
	Public Sub GetGroupInfo()
		Dim rst
		Set rst=Execute("Select * From oblog_groups Where groupid=" & l_uGroupId)
		If Not rst.Eof Then
			l_Group=rst.GetRows(1)		
		End If
		Set rst=Nothing
	End Sub

	Public Sub CreateUserDir(ustr, action)
		Dim fso, sql, rs, udir, uid, upath, loginstr, searchstr, bname, ufolder, utruepath
		sql = "select userid,user_dir,blogname,user_folder,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)
			If true_domain = 1 Then
				If rs("custom_domain") <> "" And Not IsNull(rs("custom_domain")) Then
					utruepath = "http://" & rs("custom_domain") & "/"
				Else
					utruepath = "http://" & rs("user_domain") & "." & rs("user_domainroot") & "/"
				End If
			Else
				utruepath = blogdir & udir & "/" & ufolder & "/"
			End If
			If bname = "" Or IsNull(bname) Then bname = " "
			searchstr = "<form name='search' method='post' action='" & blogurl & "list.asp?userid=" & uid & "' target=""_blank"">"
			searchstr = searchstr & "<select name='selecttype' id='selecttype'>"
			searchstr = searchstr & "<option value='topic' selected>日志标题</option>"
			searchstr = searchstr & "<option value='logtext'>日志内容</option></select><br />"
			searchstr = searchstr & "<input name='keyword' type='text' id='keyword' size='16' maxlength='40'>"
			searchstr = searchstr & " <input type='submit' name='Submit' value='搜索'></form>"
			'ATAI防止admin/manager下生成用户目录
			'upath = server.MapPath(udir)
			upath = server.MapPath(blogdir & udir)
			Set fso = server.CreateObject(CacheCompont(1))
			If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			upath = server.MapPath(blogdir & udir & "/" & ufolder)
			If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			Call BuildFile(upath & "/index." & f_ext, "暂无日志,请发表日志或者更新首页!")
			Call BuildFile(upath & "/message." & f_ext, "暂无留言,请更新发布留言板!")
			Call BuildFile(upath & "/photo." & f_ext, "暂无相册,请添加相片或更新发布相册首页!")
			upath = server.MapPath(blogdir & udir & "/" & ufolder & "/calendar")
			If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			If f_ext = "htm" Or f_ext = "html" Then
				Call BuildFile(upath & "/0.htm", htm2js_div(" ", "calendar"))
			Else
				Call BuildFile(upath & "/0.htm", " ")
			End If
			upath = server.MapPath(blogdir & udir & "/" & ufolder & "/inc")
			If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			If f_ext = "htm" Or f_ext = "html" Then
				Call BuildFile(upath & "/show_blogname.htm", htm2js_div(filt_html(bname), "blogname"))
				Call BuildFile(upath & "/show_placard.htm", htm2js_div(" ", "placard"))
				Call BuildFile(upath & "/show_subject.htm", htm2js_div(" ", "subject"))
				Call BuildFile(upath & "/show_newblog.htm", htm2js_div(" ", "newblog"))
				Call BuildFile(upath & "/show_comment.htm", htm2js_div(" ", "comment"))
				Call BuildFile(upath & "/show_links.htm", htm2js_div(" ", "links"))
				Call BuildFile(upath & "/show_info.htm", htm2js_div(" ", "info"))
				Call BuildFile(upath & "/show_mygroups.htm", htm2js_div(" ", "mygroups"))
				Call BuildFile(upath & "/show_myfriend.htm", htm2js_div(" ", "myfriend"))
				Call BuildFile(upath & "/show_search.htm", htm2js_div(searchstr, "search"))
				Call BuildFile(upath & "/show_newmessage.htm", htm2js_div("<a href=""" & utruepath & "message." & f_ext & "#cmt""><strong>签写留言</strong></a> ", "newmessage"))
			Else
				Call BuildFile(upath & "/show_blogname.htm", filt_html(bname))
				Call BuildFile(upath & "/show_placard.htm", " ")
				Call BuildFile(upath & "/show_subject.htm", " ")
				Call BuildFile(upath & "/show_newblog.htm", " ")
				Call BuildFile(upath & "/show_comment.htm", " ")
				Call BuildFile(upath & "/show_links.htm", " ")
				Call BuildFile(upath & "/show_info.htm", " ")
				Call BuildFile(upath & "/show_mygroups.htm", " ")
				Call BuildFile(upath & "/show_myfriend.htm", " ")
				Call BuildFile(upath & "/show_search.htm", searchstr)
				Call BuildFile(upath & "/show_newmessage.htm", "<a href=""" & utruepath & "message." & f_ext & "#cmt""><strong>签写留言</strong></a> ")
			End If
			If logfilepath = 1 Then
				upath = server.MapPath(blogdir & udir & "/" & ufolder & "/archives")
				If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			End If
			Set fso = Nothing
			Set rs = Nothing
		Else
			Set rs = Nothing
			Response.Write ("没找到该用户，无法建立目录。")
			Exit Sub
		End If
	End Sub

	Public Sub ShowOk(Str, url)
		url = Trim(url)
		If url <> "" and url<>"back" Then
			Response.Write "<script language=Javascript>alert(""" & Str & """);window.location='" & url & "'</script>"
		Else
			If Comeurl = "" or url="back" Then
				Response.Write "<script language=Javascript>alert(""" & Str & """);history.go(-1)</script>"
			Else
				Response.Write "<script language=Javascript>alert(""" & Str & """);window.location='" & Comeurl & "'</script>"
			End If
		End If
	End Sub

	Public Function type_city(province, city)
		Dim tmpstr
		tmpstr = "<select onchange=setcity(); name='province' >"
		tmpstr = tmpstr & "<option value=''>----请选择省份----</option>"
		tmpstr = tmpstr & "<option "
		tmpstr = tmpstr & "value=安徽>安徽</option> <option value=北京>北京</option> "
		tmpstr = tmpstr & "<option value=重庆>重庆</option> <option "
		tmpstr = tmpstr & "value=福建>福建</option> <option value=甘肃>甘肃</option> "
		tmpstr = tmpstr & "<option value=广东>广东</option> <option "
		tmpstr = tmpstr & "value=广西>广西</option> <option value=贵州>贵州</option> "
		tmpstr = tmpstr & "<option value=海南>海南</option> <option "
		tmpstr = tmpstr & "value=河北>河北</option> <option value=黑龙江>黑龙江</option> "
		tmpstr = tmpstr & "<option value=河南>河南</option> <option "
		tmpstr = tmpstr & "value=香港>香港</option> <option value=湖北>湖北</option> "
		tmpstr = tmpstr & "<option value=湖南>湖南</option> <option "
		tmpstr = tmpstr & "value=江苏>江苏</option> <option value=江西>江西</option> "
		tmpstr = tmpstr & "<option value=吉林>吉林</option> <option "
		tmpstr = tmpstr & "value=辽宁>辽宁</option> <option value=澳门>澳门</option>"
		tmpstr = tmpstr & "<option value=内蒙古>内蒙古</option> <option "
		tmpstr = tmpstr & "value=宁夏>宁夏</option> <option value=青海>青海</option> "
		tmpstr = tmpstr & "<option value=山东>山东</option> <option "
		tmpstr = tmpstr & "value=上海>上海</option> <option value=山西>山西</option> "
		tmpstr = tmpstr & "<option value=陕西>陕西</option> <option "
		tmpstr = tmpstr & "value=四川>四川</option> <option value=台湾>台湾</option> "
		tmpstr = tmpstr & "<option value=天津>天津</option> <option "
		tmpstr = tmpstr & "value=新疆>新疆</option> <option value=西藏>西藏</option> "
		tmpstr = tmpstr & "<option value=云南>云南</option> <option "
		tmpstr = tmpstr & "value=浙江>浙江</option> <option "
		tmpstr = tmpstr & "value=海外>海外</option></select>"
		tmpstr = tmpstr & " <select name='city' >"
		tmpstr = tmpstr & "</select>"
		tmpstr = tmpstr & "<script src=""inc/getcity.js""></script>"
		tmpstr = tmpstr & "<script>initprovcity('" & province & "','" & city & "');</script>"
		type_city = tmpstr
	End Function
	Public Sub type_job(job)
		Dim tmpstr
		tmpstr = "<select name='job' id='job'><option value=''>----请选择职业----<option value='财会/金融'> 财会/金融<option value='工程师'  > 工程师<option value='顾问'  > 顾问<option value='计算机相关行业(Internet)'  > 计算机相关行业 (Internet)<option value='计算机相关行业（其他）'  > 计算机相关行业（其他）<option value='家庭主妇'  > 家庭主妇<option value='教育/培训'  > 教育/培训<option value='客户服务/支持'  > 客户服务/支持<option value='零售商/手工工人'  > 零售商/手工工人<option value='退休'  > 退休<option value='无职业'  > 无职业<option value='销售/市场/广告'  > 销售/市场/广告<option value='学生'  > 学生<option value='研究和开发'  > 研究和开发<option value='一般管理'  > 一般管理<option value='政府/军队'  > 政府/军队<option value='执行官/高级管理'  > 执行官/高级管理<option value='制造/生产/操作'  > 制造/生产/操作<option value='专业人员（医药、法律等）'  > 专业人员（医药、法律等）<option value='自雇/业主'  > 自雇/业主<option value='其他'  > 其他</select>"
		Response.Write (tmpstr)
	%>
	<script language=javascript>
	var jobObject = document.oblogform["job"];
	for(var i = 0; i < document.oblogform["job"].options.length; i++) {
		if (document.oblogform["job"].options[i].value=="<%=trim(job)%>")
		{
			document.oblogform["job"].selectedIndex = i;
		}
	}
	</script>
	<%
	End Sub

	Public Sub type_dateselect(addtime, n)
		Dim y, m, d, ttime
		If addtime = "" Then ttime = ServerDate(Now()) Else ttime = addtime
		Response.Write("<select name=selecty"&n&">")&vbcrlf
		For y = 2000 To 2010
			If Year(ttime) = y Then
				Response.Write "<option value="&y&" selected>"&y&"年</option>"&vbcrlf
			Else
				Response.Write "<option value="&y&">"&y&"年</option>"&vbcrlf
			End If
		Next
		Response.Write "</select><select name=selectm"&n&">"&vbcrlf
		For m = 1 To 12
			If Month(ttime) = m Then
				Response.Write "<option value="&m&" selected>"&m&"月</option>"&vbcrlf
			Else
				Response.Write "<option value="&m&">"&m&"月</option>"&vbcrlf
			End If
		Next
		Response.Write("</select><select name=selectd"&n&">")&vbcrlf
		For d = 1 To 31
			If Day(ttime) = d Then
				Response.Write "<option value="&d&" selected>"&d&"日</option>"&vbcrlf
			Else
				Response.Write "<option value="&d&">"&d&"日</option>"&vbcrlf
			End If
		Next
		Response.Write ("</select>") & vbCrLf
	End Sub

	Public Sub chk_commenttime()
		Dim lasttime
		'检查服务器端
		lasttime = Session("chk_commenttime")
		If IsDate(lasttime) Then
			If DateDiff("s", lasttime, ServerDate(Now())) < Int(cacheConfig(32)) Then
				Response.Write ("<script language=javascript>alert('" & cacheConfig(32) & "秒后才能回复或评论。');window.history.back(-1);</script>")
				Response.End
			End If
		End If
		'检查客户端
		lasttime = request.Cookies(cookies_name)("LastComment")
		If IsDate(lasttime) Then
			If DateDiff("s", lasttime, ServerDate(Now())) < Int(cacheConfig(32)) Then
				Response.Write ("<script language=javascript>alert('" & cacheConfig(32) & "秒后才能回复或评论。');window.history.back(-1);</script>")
				Response.End
			End If
		End If        
	End Sub

	Public Function filtpath(Str)
		Dim s1
		If is_relativepath = 1 Then
			Dim nurl
			nurl = Trim("http://" & request.ServerVariables("HTTP_HOST"))
			nurl = nurl & request.ServerVariables("script_NAME")
			nurl = Left(nurl, InStrRev(nurl, "/"))
			s1 = Replace(Str, nurl, "")
		Else
			s1 = Str
		End If
		'ATAI20061213:编辑器保护
		filtpath=Replace(s1,"over--flow","overflow")
	End Function


	Public Function showpage(bTotal, bAllPages, sUnit)
		Dim n, i, sTmp, strUrl
		If G_P_PerMax=0 Then G_P_PerMax=1
		If G_P_AllRecords Mod G_P_PerMax = 0 Then
			n = G_P_AllRecords \ G_P_PerMax
		Else
			n = G_P_AllRecords \ G_P_PerMax + 1
		End If
		sTmp = "<div id=""showpage"">"
		If bTotal = True Then
			sTmp = sTmp & "共" & G_P_AllRecords & sUnit & "&nbsp;&nbsp;"
		End If
		strUrl = JoinChar(G_P_FileName)
		If G_P_This < 2 Then
				sTmp = sTmp & "首页 上一页&nbsp;"
		Else
				sTmp = sTmp & "<a href='" & strUrl & "page=1'>首页</a>&nbsp;"
				sTmp = sTmp & "<a href='" & strUrl & "page=" & (G_P_This - 1) & "'>上一页</a>&nbsp;"
		End If

		If n - G_P_This < 1 Then
				sTmp = sTmp & "下一页 尾页"
		Else
				sTmp = sTmp & "<a href='" & strUrl & "page=" & (G_P_This + 1) & "'>下一页</a>&nbsp;"
				sTmp = sTmp & "<a href='" & strUrl & "page=" & n & "'>尾页</a>"
		End If
		sTmp = sTmp & "&nbsp;页次：" & G_P_This & "/" & n & "页 "
		sTmp = sTmp & "&nbsp;" & G_P_PerMax & "" & sUnit & "/页"
		If bAllPages = True Then
			sTmp = sTmp & "&nbsp;转到：<select name='page' size='1' onchange=""javascript:window.location='" & strUrl & "page=" & "'+this.options[this.selectedIndex].value;"">"
			For i = 1 To n
				sTmp = sTmp & "<option value='" & i & "'"
				If CInt(G_P_This) = CInt(i) Then sTmp = sTmp & " selected "
				sTmp = sTmp & ">" & i & "</option>"
			Next
			sTmp = sTmp & "</select>"
		End If
		sTmp = sTmp & "</div>"
		showpage = sTmp
	End Function

	Function MakePageBar(rs,sUnit)
		if request("page")<>"" then
			G_P_This=cint(request("page"))
		else
			G_P_This=1
		end if
		If rs.EOF Then
			G_P_Guide = G_P_Guide & " (共有0"&sUnit&")"
			response.write "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" & G_P_Guide
		Else
			G_P_AllRecords = rs.recordcount
			G_P_Guide = G_P_Guide & " (共有" & G_P_AllRecords & sUnit & ")"
			If G_P_This < 1 Then
				G_currentPage = 1
			End If
			If (G_P_This - 1) * G_P_PerMax > G_P_AllRecords Then
				If (G_P_AllRecords Mod G_P_PerMax) = 0 Then
					G_P_This = G_P_AllRecords \ G_P_PerMax
				Else
					G_P_This = G_P_AllRecords \ G_P_PerMax + 1
				End If
			End If
			If G_P_This = 1 Then
				showContent
				response.write oblog.showpage(True, True, sUnit)
			Else
				If (G_P_This - 1) * G_P_PerMax < G_P_AllRecords Then
					rs.Move (G_P_This - 1) * G_P_PerMax
					Dim bookmark
					bookmark = rs.bookmark
					showContent
					response.write oblog.showpage(True, True, sUnit)
				Else
					G_currentPage = 1
					showContent
					response.write oblog.showpage(True, True, sUnit)
				End If
			End If
		End If
	End Function
	Public Function JoinChar(strUrl)
		If strUrl = "" Then
			JoinChar = ""
			Exit Function
		End If
		If InStr(strUrl, "?") < Len(strUrl) Then
			If InStr(strUrl, "?") > 1 Then
				If InStr(strUrl, "&") < Len(strUrl) Then
					JoinChar = strUrl & "&"
				Else
					JoinChar = strUrl
				End If
			Else
				JoinChar = strUrl & "?"
			End If
		Else
			JoinChar = strUrl
		End If
	End Function

	Public Function htm2js(Str)
		If Str = "" Or IsNull(Str) Then Str = " "
		htm2js = "document.write('" & Replace(Replace(Replace(Replace(Str, "\", "\\"), "'", "\'"), vbCrLf, "\n"), Chr(13), "") & "');"
	End Function

	'将htm代码插入div
	Public Function htm2js_div(Str, divid)
		divid = Trim(divid)
		If Str = "" Or IsNull(Str) Then Str = " "
		htm2js_div = "if (chkdiv('" & divid & "')) {"
		htm2js_div = htm2js_div & "document.getElementById('" & divid & "')" & ".innerHTML='" & Replace(Replace(Replace(Replace(Str, "\", "\\"), "'", "\'"), vbCrLf, "\n"), Chr(13), "") & "';}"
		If divid = "subject" Then htm2js_div = htm2js_div & vbCrLf & "if (chkdiv('subject_l')) {document.getElementById('subject_l').innerHTML='" & Replace(Replace(Replace(Replace(Str, "\", "\\"), "'", "\'"), vbCrLf, "\n"), Chr(13), "") & "';}"
	End Function

	Public Function readfile(mPath, fName)
		On Error Resume Next
		Dim fs2, f2, fpath
		Set fs2 = server.CreateObject(CacheCompont(1))
		fpath = server.MapPath(mPath) & "\"
		fpath = fpath & fName
		Set f2 = fs2.OpenTextFile(fpath, 1, True)
		readfile = f2.ReadAll
		Set fs2 = Nothing
		Set f2 = Nothing
	End Function

	Public Function showsize(size)
		On Error Resume Next
		If size = "" Or IsNull(size) Then
			showsize = "0Byte"
			Exit Function
		End If
		showsize = size & "Byte"
		If size < 0 Then
			showsize = "0KB"
			Exit Function
		End If
		If size > 1024 Then
		   size = (size \ 1024)
		   showsize = size & "KB"
		End If
		If size > 1024 Then
		   size = (size / 1024)
		   showsize = FormatNumber(size, 2) & "MB"
		End If
		If size > 1024 Then
		   size = (size / 1024)
		   showsize = FormatNumber(size, 2) & "GB"
		End If
		If size > 1024 Then
		   size = (size / 1024)
		   showsize = FormatNumber(size, 2) & "TB"
		End If
		If size > 1024 Then
		   size = (size / 1024)
		   showsize = FormatNumber(size, 2) & "PB"
		End If
		If size > 1024 Then
		   size = (size / 1024)
		   showsize = FormatNumber(size, 2) & "EB"
		End If
	End Function

	Public Function ChkPost()
		Dim server_v1, server_v2
		ChkPost = False
		If true_domain = 1 Then
			ChkPost = True
			Exit Function
		End If
		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 filt_badstr(sSql)
		 If IsNull(sSql) Then Exit Function
		 sSql = Trim(sSql)
		 If sSql = "" Then Exit Function
		 sSql = Replace(sSql, Chr(0), "")
		 sSql = Replace(sSql, "'", "''")
		 'sSql=Replace(sSql,"%","％")
		 'sSql=Replace(sSql,"-","－")
		 filt_badstr = sSql
	End Function

	Public Function filt_astr(Str, n)
		If IsNull(Str) Then
			filt_astr = ""
			Exit Function
		End If
		filt_astr = filt_badword(Str)
		filt_astr = InterceptStr(filt_astr, n)
	End Function

	Public Function filt_html(Str)
		On Error Resume Next
		If Str = "" Then
			filt_html = ""
		Else
			Str = Replace(Str, ">", "&gt;")
			Str = Replace(Str, "<", "&lt;")
			Str = Replace(Str, Chr(32), "&nbsp;")
			Str = Replace(Str, Chr(9), "&nbsp;")
			Str = Replace(Str, Chr(34), "&quot;")
			Str = Replace(Str, Chr(39), "&#39;")
			Str = Replace(Str, Chr(13), "")
			Str = Replace(Str, Chr(10) & Chr(10), "&nbsp; ")
			Str = Replace(Str, Chr(10), "&nbsp; ")
			filt_html = Str
		End If
	End Function

	Public Function filt_html_b(fString)
		On Error Resume Next
		If Not IsNull(fString) And fString<>"" Then
			fString = Replace(fString, ">", "&gt;")
			fString = Replace(fString, "<", "&lt;")
			fString = Replace(fString, Chr(32), " ")
			fString = Replace(fString, Chr(9), " ")
			fString = Replace(fString, Chr(34), "&quot;")
			'fString = Replace(fString, CHR(39), "&#39;")
			fString = Replace(fString, Chr(13), "")
			fString = Replace(fString, Chr(10) & Chr(10), "</p><p> ")
			fString = Replace(fString, Chr(10), "<br> ")
			filt_html_b = fString
		Else 
			filt_html_b=""
		End If
	End Function

	Public Function strLength(Str)
		On Error Resume Next
		Dim WINNT_CHINESE
		WINNT_CHINESE = (Len("中国") = 2)
		If WINNT_CHINESE Then
			Dim l, t, c
			Dim i
			l = Len(Str)
			t = l
			For i = 1 To l
				c = Asc(Mid(Str, i, 1))
				If c < 0 Then c = c + 65536
				If c > 255 Then
					t = t + 1
				End If
			Next
			strLength = t
		Else
		strLength = Len(Str)
		End If
		If Err.Number <> 0 Then Err.Clear
	End Function

	Public Function InterceptStr(txt, length)
		Dim x, y, ii
		txt = Trim(txt)
		x = Len(txt)
		y = 0
		If x >= 1 Then
			For ii = 1 To x
				If Asc(Mid(txt, ii, 1)) < 0 Or Asc(Mid(txt, ii, 1)) > 255 Then '如果是汉字
					y = y + 2
				Else
					y = y + 1
				End If
				If y >= length Then
					txt = Left(Trim(txt), ii) '字符串限长
					Exit For
				End If
			Next
			InterceptStr = txt
		Else
			InterceptStr = ""
		End If
	End Function

	'读取用户目录对应绑定的路径，未绑定返回空
	Public Function getdirdomain(udir)
		Dim tmp1, tmp2, Str
		Str = Application(Cache_Name & "dirdomain")
		udir = Trim(udir)
		tmp1 = InStr(Str, udir & "!!??((")
		tmp2 = Len(udir & "!!??((") + tmp1
		If tmp1 > 0 Then
			getdirdomain = Mid(Str, tmp2, InStr(tmp1, Str, "##))==") - tmp2)
		Else
			getdirdomain = ""
		End If
	End Function

	Public Function GetUrl()
		On Error Resume Next
		Dim sTmp
		If LCase(request.ServerVariables("HTTPS")) = "off" Then
		sTmp = "http://"
		Else
		sTmp = "https://"
		End If
		sTmp = sTmp & request.ServerVariables("SERVER_NAME")
		If request.ServerVariables("SERVER_PORT") <> 80 Then sTmp = sTmp & ":" & request.ServerVariables("SERVER_PORT")
		sTmp = sTmp & request.ServerVariables("URL")
		If Trim(request.QueryString) <> "" Then sTmp = sTmp & "?" & Trim(request.QueryString)
		GetUrl = sTmp
	End Function

	Public Function trueurl(strContent)
		On Error Resume Next
		Dim tempReg, url
		url = Trim("http://" & request.ServerVariables("HTTP_HOST"))
		url = LCase(url & request.ServerVariables("script_NAME"))
		url = Left(url, InStrRev(url, "/"))
		Set tempReg = New RegExp
		tempReg.IgnoreCase = True
		tempReg.Global = True
		tempReg.Pattern = "(^.*\/).*$" '含文件名的标准路径
		url = tempReg.Replace(url, "$1")
		tempReg.Pattern = "((?:src|href).*?=[\'\u0022](?!ftp|http|https|mailto))"
		trueurl = tempReg.Replace(strContent, "$1" + url)
		Set tempReg = Nothing
	End Function

	Public Function IsValidEmail(email)
		Dim names, name, i, c
		IsValidEmail = True
		names = Split(email, "@")
		If UBound(names) <> 1 Then
		   IsValidEmail = False
		   Exit Function
		End If
		For Each name In names
		   If Len(name) <= 0 Then
			 IsValidEmail = False
			 Exit Function
		   End If
		   For i = 1 To Len(name)
			 c = LCase(Mid(name, i, 1))
			 If InStr("abcdefghijklmnopqrstuvwxyz-_.", c) <= 0 And Not IsNumeric(c) Then
			   IsValidEmail = False
			   Exit Function
			 End If
		   Next
		   If Left(name, 1) = "." Or Right(name, 1) = "." Then
			  IsValidEmail = False
			  Exit Function
		   End If
		Next
		If InStr(names(1), ".") <= 0 Then
		   IsValidEmail = False
		   Exit Function
		End If
		i = Len(names(1)) - InStrRev(names(1), ".")
		If i <> 2 And i <> 3 Then
		   IsValidEmail = False
		   Exit Function
		End If
		If InStr(email, "..") > 0 Then
		   IsValidEmail = False
		End If
	End Function

	Public Function chkDomain(domain)
		Dim name, i, c
		name = domain
		chkdomain = True
		If Len(name) <= 0 Then
			chkdomain = False
			Exit Function
		End If
		For i = 1 To Len(name)
		   c = LCase(Mid(name, i, 1))
			If InStr("abcdefghijklmnopqrstuvwxyz-", c) <= 0 And Not IsNumeric(c) Then
			   chkdomain = False
			Exit Function
		   End If
	   Next
	End Function

	Public Function CodeCookie(Str)
		If Is_password_cookies = 1 Then
			Dim i
			Dim StrRtn
			For i = Len(Str) To 1 Step -1
				StrRtn = StrRtn & AscW(Mid(Str, i, 1))
				If (i <> 1) Then StrRtn = StrRtn & "a"
			Next
			CodeCookie = StrRtn
		Else
			CodeCookie = Str
		End If
	End Function

	Public Function DecodeCookie(Str)
		If Is_password_cookies = 1 Then
			Dim i
			Dim StrArr, StrRtn
			StrArr = Split(Str, "a")
			For i = 0 To UBound(StrArr)
				If IsNumeric(StrArr(i)) = True Then
					StrRtn = ChrW(StrArr(i)) & StrRtn
				Else
					StrRtn = Str
					Exit Function
				End If
			Next
			DecodeCookie = StrRtn
		Else
			DecodeCookie = Str
		End If
	End Function

	Public Function BuildFile(ByVal sFile, ByVal sContent)
	On Error Resume Next
		Dim oFSO, oStream
		If CacheConfig(24) = 1 Then
			Set oFSO = server.CreateObject(CacheCompont(1))
	'			If Is_Debug=1 Then Response.Write sFile
	'			If Is_Debug=1 Then Response.Write sContent
			Set oStream = oFSO.CreateTextFile(sFile,True)
			oStream.Write sContent
			oStream.Close
			'增加对特殊字符的保护
			If Err.Number<>0 Then
				Set oStream = server.CreateObject(CacheCompont(2))
				With oStream
					.Type = 2
					.Mode = 3
					.open
					'.Charset = "utf-8"
					.Charset = "gb2312"
					.Position = oStream.size
					.WriteText = sContent
					.SaveToFile sFile, 2
					.Close
				End With
				Err.Clear
			End If
			Set oStream = Nothing
			Set oFSO = Nothing
		Else
			Set oStream = server.CreateObject(CacheCompont(2))
			With oStream
				.Type = 2
				.Mode = 3
				.open
				'.Charset = "utf-8"
				.Charset = "gb2312"
				.Position = oStream.size
				.WriteText = sContent
				.SaveToFile sFile, 2
				.Close
			End With
			Set oStream = Nothing
		End If
	End Function
	'-----------Oblog4----------
	'sType:1-邀请码
	Public Function CheckOBCode(sCode, sType)
		Dim i, iAsc, rst,Sql
		sCode = UCase(Trim(sCode))
		CheckOBCode = False
		If Len(sCode)<>32 Then Exit FUnction
		For i = 1 To Len(sCode)
			iAsc = Asc(Mid(sCode, i, 1))
			'48~57,65~90
			If iAsc < 48 Or (iAsc > 57 And iAsc < 65) Or iAsc > 90 Then Exit Function
		Next
		If sType<>"" Then sType = CInt(sType)
		Sql="Select iState From oblog_obcodes Where iState=0 And obcode='" & LCase(sCode) & "' "
		Sql =Sql & " "
		Set rst = Execute("Select iState From oblog_obcodes Where iState=0 And obcode='" & LCase(sCode) & "' And iType=" & sType)
		If Not rst.EOF Then
			CheckOBCode = True
		End If
		rst.Close
		Set rst = Nothing
	End Function

	'检测用户发贴的许可
	Public Function CheckPostAccess()
		Dim rst
		CheckPostAccess=""
		'首先进行新用户注册检验

		If CacheConfig(19)>0 Then
			If Int(datediff("n",l_uAddtime,Now))<Int(CacheConfig(19)) Then    			
				CheckPostAccess="系统设定您在注册后 " & CacheConfig(19) & " 分钟后才可以发布日志或者相册"
				Exit Function
			End If
		End If
		'检查每天最大的发帖数目
		If l_Group(10,0)<=0 Or l_Group(10,0)="" Then
			CheckPostAccess=""
		Else
			Set rst=Execute("Select Count(logid) From oblog_log Where userid=" & l_uid & " And Datediff("& G_Sql_d &",truetime," & G_Sql_Now &")<1")
			If rst(0)<l_Group(10,0) Then
				CheckPostAccess=""
			Else
				CheckPostAccess="您目前所属的组限制您一天内只允许发布 " & l_Group(10,0) & " 篇(日志+相册)<br/>您目前已经达到了该限额"
			End If    			
			Set rst=Nothing
		End If    	
	End Function

	'积分检查
	Public Function CheckScore(iScore)
		Dim rst
		CheckScore = False
		If iScore >= 0 Then CheckScore = True: Exit Function
		Set rst = Execute("Select scores From oblog_user Where userid=" & l_uId)
		If rst.EOF Then
			Set rst = Nothing
			Exit Function
		Else
			If rst(0) + iScore > 0 Then
				CheckScore = True
			End If
		End If
		Set rst = Nothing
	End Function

	'给分,删分
	Public Function GiveScore(blogid, Score ,userid)
		Dim uid
		If userid<>"" Then 
			uid = CLng(userid)
		Else 
			uid = l_uId
		End if
		Score=Int(Score)
		Execute ("Update oblog_user Set scores=scores+" & Score & " Where  userid=" & uid)
		If Score<0 Then Execute ("Update oblog_user Set scores=0 Where  userid=" & uid & " And  scores<0")			
		If blogid <> "" Then
			Execute ("Update oblog_log Set scores=scores+" & Score & " Where logid=" & Int(blogid) & "' And userid=" & uid)
		End If
	End Function

	'-------------------------------------------------------
	'内容保护模块!
	'-------------------------------------------------------
	'接管所有安全防护/内容过滤
	'内容类过滤,整合安全性过滤
	'关键字已经被分割成数组
	'此处的Content为返回参数
	Function CheckContent(byval Content, byval sType)
		Dim i,iCount,iLen,sKeep
		iCount=0
		Content=LCase(Content)
		'顶级过滤,直接封杀,系统对该用户进行计数,达到一定数目后,将该用户封禁
		For i=0 to Ubound(oblog.Keywords1)
			If Instr(Content,LCase(oblog.Keywords1(i)))>0 Then
	'				CheckContent=1 & "," & oblog.Keywords1(i)
				CheckContent=1
				Exit Function
			End If
		Next
		'次级过滤,提示审核
		For i=0 to Ubound(oblog.Keywords2)
			If Instr(Content,LCase(oblog.Keywords2(i)))>0 Then
				iCount=iCount+1		
				sKeep= sKeep & "," & oblog.Keywords2(i)
				'If iCount>oblog.Setup(21) Then
				'	'此处借用了一个,
	'					CheckContent="2"& sKeep
					CheckContent=2
					Exit Function
				'End If
			End If			
		Next
		'如果通过了第二次审核，则进入下一环节
		'一般过滤,全局字符替换
		For i=0 to Ubound(oblog.Keywords3)
			'如果是注册时存在，则直接跳出
			If sType="1" Then
				If Instr(Content,LCase(oblog.Keywords3(i)))>0 Then
					CheckContent=3
					Exit Function
				End If
			Else
			'如果是内容检测，则直接替换，不必执行查找过程						
				Content=Replace(Content,oblog.Keywords3(i),"xxxx")
				CheckContent=3
			End If
		Next
		If CheckContent<>3 Then CheckContent=0
	End Function


	'注册时重复的用户名
	'注册禁止使用的用户名
	Function chk_regname(sUserName)
		Dim i
		chk_regname=0
		sUserName=Lcase(sUserName)
		'用户名不能为非英文字符
		If CacheConfig(6) <> "1" Then 
			If CheckValidEnName(sUserName)=false Then
					chk_regname=1
					Exit Function
			End If
		End if
		'用户名不能为系统禁止的关键字/审核字/过滤字
		If CheckContent(sUserName,1)<>0 Then
				chk_regname=2
				Exit Function
		End If
		'处理单独的注册关键字
		For i=0 to Ubound(oblog.Keywords4)
			If Trim (oblog.Keywords4(i))<>"" Then
				If Instr(sUserName,LCase(oblog.Keywords4(i)))>0 Then
					chk_regname=3
					Exit Function
				End If
			End if
		Next
		'如果不允许数字ID
		If en_nameisnum=0 Then
			If IsNumeric(sUserName) Then
				chk_regname=4
				Exit Function
			End if
		End if
		'判断是否存在重复
		'Dim rs
	'		Set rs=Execute("select userid from oblog_user where username='"&ProtectSql(sUserName)&"'")
	'		If Not rs.EOF Then
	'			chk_regname=4
	'			Set rs=Nothing
	'			Exit Function
	'		End If	
	'		Set rs=Nothing
		chk_regname=0
	End Function


	'进行IP控制	
	Public Function ChkIpLock()
		Dim IPlock,i, sUserIP, sIP,BalckList,WhiteList,iCheck
		IPlock = False
		WhiteList = Application(Cache_Name & "_WhiteIp")
		BalckList = Application(Cache_Name & "_BlackIp")
		'如果无黑名单,则直接跳出
		If UBound(BalckList) < 0 Then 
			ChkIpLock=False
			Exit Function
		End if
		'获取用户IP	
		sUserIP = oblog.UserIp
		If sUserIP = "" Then Exit Function
		sUserIP = Split(UserIp, ".")

		If UBound(sUserIP) <> 3 Then Exit Function        	
		'检测白名单,白名单支持XXX.*.*.*,如果位于白名单内直接跳出检测流程
		For i = 0 To UBound(WhiteList)
			If WhiteList(i) <> "" Then
			  sIP = Split(WhiteList(i), ".")
			  If UBound(sIP) <> 3 Then Exit For
			  IPlock = false
			  If sUserIP(0) = sIP(0) Then
				If sUserIP(1) = sIP(1) Or  sIP(1)= "*" Then
					If sUserIP(2) = sIP(2) Or sIP(2)= "*" Then
						If sUserIP(3) = sIP(3) Or sIP(3)="*" Then
							ChkIpLock=false
							Exit Function
						End If
					End If
				End If
				End If
			End If                			
			Next
		'检测黑名单
		For i = 0 To UBound(BalckList)
			If BalckList(i) <> "" Then
				sIP = Split(BalckList(i), ".")
				If UBound(sIP) = 3  Then	
					IPlock = True
					If (sUserIP(0) <> sIP(0)) And InStr(sIP(0), "*") = 0 Then IPlock = False
					If (sUserIP(1) <> sIP(1)) And InStr(sIP(1), "*") = 0 Then IPlock = False
					If (sUserIP(2) <> sIP(2)) And InStr(sIP(2), "*") = 0 Then IPlock = False
					If (sUserIP(3) <> sIP(3)) And InStr(sIP(3), "*") = 0 Then IPlock = False
					If IPlock Then Exit For
				End If
			End If
		Next
		ChkIpLock = IPlock
	End Function

	'进行白名单控制	
	Public Function ChkWhiteIP()
		Dim IPlock,i, sUserIP, sIP,BalckList,WhiteList,iCheck
		ChkWhiteIP = False
		WhiteList = Application(Cache_Name & "_WhiteIp")
		'如果无黑名单,则直接跳出
		If UBound(WhiteList) < 0 Then 
			Exit Function
		End if
		'获取用户IP	
		sUserIP = oblog.UserIp
		If sUserIP = "" Then Exit Function
		sUserIP = Split(UserIp, ".")
		If UBound(sUserIP) <> 3 Then Exit Function        	
		'检测白名单,白名单支持XXX.*.*.*,如果位于白名单内直接跳出检测流程
		For i = 0 To UBound(WhiteList)
			If WhiteList(i) <> "" Then
			  sIP = Split(WhiteList(i), ".")
			  If UBound(sIP) <> 3 Then Exit For
			  IPlock = false
			  If sUserIP(0) = sIP(0) Then
				If sUserIP(1) = sIP(1) Or  sIP(1)= "*" Then
					If sUserIP(2) = sIP(2) Or sIP(2)= "*" Then
						If sUserIP(3) = sIP(3) Or sIP(3)="*" Then
							ChkWhiteIP=True
							Exit Function
						End If
					End If
				End If
				End If
			End If                			
		Next
	End Function


	'进行脚本过滤
	Function CheckScript(Content)
		Dim oRegExp,oMatch,spamCount
		Set oRegExp = New Regexp
		oRegExp.IgnoreCase = True
		oRegExp.Global = True
		oRegExp.pattern ="<script.+?/script>"
		Content=oRegExp.Replace(Content,"")
		Set oRegExp=Nothing
	End Function

	'进行多媒体对象检测
	'提取媒体文件,清理播放器
	Function CheckMedia(Content)
		Dim oRegExp,oRegExp1,oMatch,Matches,oMatch1,Matches1
		Dim sFiles1,sFiles2,sFile
		sFiles="swf,mp3,rm,ram,rmvb,mp4,wma,wav,avi"
		Set oRegExp = New Regexp
		oRegExp.IgnoreCase = True
		oRegExp.Global = True
		Set oRegExp1 = New Regexp
		oRegExp1.IgnoreCase = True
		oRegExp1.Global = True
		
		'媒体文件
		oRegExp.pattern ="<object.+?>"
		Set Matches=oRegExp.Execute(Content)
		For Each oMatch In Matches			
			oRegExp1.pattern="http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?"
			Set Matches1=oRegExp.Execute(oMatch.Value)
			For Each oMathch1 In Matches1
				'只取媒体文件
				sFile=Split(oMathch1.value,".")
				If InStr(sFiles1,sFile(UBound(sFile)))>0 Then
					strFiles2="<a href=""" &  oMathch1.value & """ target=_blank>" & oMathch1.value & "</a><br>"
				End If
			Next			
		Next
		'清空
		oRegExp.pattern ="<object.+?/object>"		
		Content=oRegExp1.Replace(Content,"")
		oRegExp.pattern ="<em.+?>"
		Set Matches=oRegExp.Execute(Content)
		For Each oMatch In Matches			
			oRegExp1.pattern="http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?"
			Set Matches1=oRegExp.Execute(oMatch.Value)
			For Each oMathch1 In Matches1
				'只取媒体文件
				sFile=Split(oMathch1.value,".")
				If InStr(sFiles1,sFile(UBound(sFile)))>0 Then
					strFiles2="<a href=""" &  oMathch1.value & """ target=_blank>" & oMathch1.value & "</a><br>"
				End If
			Next			
		Next		
		oRegExp.pattern ="<em.+?/em>"
		Content=oRegExp1.Replace(Content,"")
		Set oRegExp1=othing
		Set oRegExp2=othing
	End Function

	Function ubb_comment(strContent)
		Dim re
		
		If IsNull(strContent) THen 
			ubb_comment=""
			Exit Function
		End If
		
		Set re=new RegExp
		re.IgnoreCase =true
		re.Global=True
		'以下过滤html代码
		strContent = Replace(strContent, "<br />", "[br]")
		strContent = Replace(strContent, ">", "&gt;")
		strContent = Replace(strContent, "<", "&lt;")
		strContent = Replace(strContent, Chr(32), " ")
		strContent = Replace(strContent, Chr(9), " ")
		strContent = Replace(strContent, Chr(34), "&quot;")
		'strContent = Replace(strContent, CHR(39), "&#39;")
		strContent = Replace(strContent, Chr(13), "")
		strContent = Replace(strContent, Chr(10), "<br /> ")
		strContent = Replace(strContent, "[br]", "<br />")
		'以下过滤ubb标签
		re.Pattern="(\[EMOT\])(.[^\[]*)(\[\/EMOT\])"
		strContent= re.Replace(strContent,"<img src="""&blogurl&"editor/images/emot/face"&"$2"&".gif"&""" />")	
		re.Pattern="\[i\](.[^\[]*)(\[\/i\])"
		strContent=re.Replace(strContent,"<em>$1</em>")
		re.Pattern="\[u\](.[^\[]*)(\[\/u\])"
		strContent=re.Replace(strContent,"<u>$1</u>")
		re.Pattern="\[b\](.[^\[]*)(\[\/b\])"
		strContent=re.Replace(strContent,"<strong>$1</strong>")
'		re.Pattern="\[QUOTE\](.[^\[]*)(\[\/QUOTE\])"
'		strContent=re.Replace(strContent,"<div class='quote'>$1</div><br>")
		re.Pattern="\[QUOTE\]"
		strContent=re.Replace(strContent,"<div class='quote'>")
		re.Pattern="\[\/QUOTE\]"
		strContent=re.Replace(strContent,"</div><br>")
		Set re=Nothing
		ubb_comment=strContent
	End Function

	Sub MakeEditorJs()
	%>

	<%
	End Sub
	'载入编辑器，stype值为1可上传,0不可上传
	Sub MakeEditorText(sInput,stype,width,height)
		If sInput = "" Then sInput = "edit"
	%>
	<script language=JavaScript src='<%=C_Editor%>/scripts/language/schi/editor_lang.js'></script>
	<script language=JavaScript src='<%=C_Editor%>/scripts/innovaeditor.js'></script>
	<script language="JavaScript">
	var oEdit1 = new InnovaEditor("oEdit1");

	//STEP 2: Asset Manager Localization: Add querystring lang=english/danish/dutch...
	//oEdit1.css="/editor/scripts/style/editor.css"
	<%if oblog.cacheconfig(53) = "1" Then%>
	oEdit1.mode="XHTMLBody";
	<%end if%>
	oEdit1.width=<%=width%>;
	oEdit1.height=<%=height%>;
	oEdit1.cmdCustomObject = "modelessDialogShow('<%=blogdir%>editor/scripts/emot.htm',280,200)"; 
	<%if stype = 1 Then %>
	oEdit1.cmdAssetManager="modalDialogShow('<%=blogdir%>editupload.asp',640,465)";
	<%End If%>
	<%if oblog.cacheconfig(53) = "1" Then%>
	oEdit1.btnHTMLSource=false;
	oEdit1.btnXHTMLSource=true;
	<%end if%>
	oEdit1.REPLACE("<%=sInput%>");
	oEdit1.focus();
	</script>
	<%
	End Sub
	 '发送系统信息
	Sub SendSysMsg(fromId,toId,toName,toContent)
		
	End Sub
	 
	'CheckAdmin系统管理员1,内容管理员2,任意管理员0
	Public Function CheckAdmin(sType)
		Dim admin_name,admin_password,sql,rs	
		CheckAdmin=False
		admin_name=filt_badstr(session("adminname"))
		admin_password=filt_badstr(session("adminpassword"))
		If admin_name = "" Or admin_password = "" Then 
			If sType <> 1 Then 
				admin_name=filt_badstr(session("m_name"))
				admin_password=filt_badstr(session("m_pwd"))
			End If
		End if
		If IsEmpty(admin_name) Or admin_name="" Then Exit Function
		sql="select id,password,roleid from oblog_admin where username='" & admin_name & "' and password='"&admin_password&"'"
		If Not IsObject(conn) Then link_database
		Set rs=conn.execute(sql)
		if Not rs.eof Then
			If sType = 1 Then 
				If rs(2) <> 0 Then Exit Function
			ElseIf sType = 2 Then 
				If rs(2) = -1 Then Exit Function
			End if
			If rs(1)=admin_password Then
				rs.close
				set rs=nothing
				CheckAdmin=True
				Exit Function				
			End If
		End if
		rs.close
		Set rs=Nothing	
	End Function	

	'验证用户提交的域名根是否合法
	Public Function CheckDomainRoot(R_DomainRoot)
		CheckDomainRoot=False
		Dim DomainRoot,i
		DomainRoot=Trim(CacheConfig(4))
		R_DomainRoot=Trim (R_DomainRoot)
		If DomainRoot="" Or CacheConfig(5) = 0 Then Exit Function
		If InStr(DomainRoot,"|")<0 Then
			If R_DomainRoot=DomainRoot Then 
				CheckDomainRoot=True 
				Exit Function
			End If
		Else 
			DomainRoot=Split(DomainRoot,"|")
			For i=0 To UBound(DomainRoot)
				If R_DomainRoot = DomainRoot(i) Then
					CheckDomainRoot=True 
					Exit Function	
				End If
			Next
		End if
	End Function

	'过滤掉flash UBB标记
	Function FilterUBBFlash(byval strFlash)
		Dim strFlash1,t
		t=0
		strFlash1=LCase(strFlash)
		If InStr(strFlash1,"[/flash]")>0 Then
			strFlash1 = Replace(strFlash1,"[/flash]","[ /flash ]")
			strFlash1 = Replace(strFlash1,"[flash","[ flash ")
			t=1
		end if
		if InStr(strFlash1,"[/mp]")>0 Then
			strFlash1 = Replace(strFlash1,"[/mp]","[ /mp ]")
			strFlash1 = Replace(strFlash1,"[mp","[ mp ")
			t=1
		end if
		if InStr(strFlash1,"[/rm]")>0 Then
			strFlash1 = Replace(strFlash1,"[/rm]","[ /rm ]")
			strFlash1 = Replace(strFlash1,"[rm","[ rm ")
			t=1
		End If
		if InStr(strFlash1,"[/url]")>0 Then
			strFlash1 = Replace(strFlash1,"[/url]","[ /url ]")
			strFlash1 = Replace(strFlash1,"[url","[ url ")
			t=1
		End If
		if InStr(strFlash1,"meta")>0 Then
			strFlash1 = Replace(strFlash1,"meta","ｍeta")
			t=1
		End If
		if InStr(strFlash1,"embed")>0 Then
			strFlash1 = Replace(strFlash1,"embed","ｅmbed")
			t=1
		End If
		if t=1 then
			FilterUBBFlash=strFlash1
		else
			FilterUBBFlash=strFlash
		end if
	End Function

	'封IP
	Public Sub KillIP(sIP) 
		Dim rstCache
		Set rstCache = Server.CreateObject("Adodb.RecordSet")       	        
		rstCache.Open "Select * From  oblog_config Where id=5",conn,1,3
		If InStr(rstCache("ob_value"),sIP)<=0 Then
			rstCache("ob_value")=rstCache("ob_value")& vbCrLf & sIP
			rstCache.Update
		End If
		rstCache.Close
		Set rstCache=Nothing
		reloadsetup
	End Sub
	'过滤关键字、黑白名单ip中的空行
	Function FilterEmpty(badstr)
		Dim arrStr,strReturn,i
		badstr=Trim (badstr)
		If badstr= "" Then 
			FilterEmpty=badstr 
			Exit Function
		End if
		If InStr (badstr,vbcrlf)>0 Then
			arrStr = Split (badstr,vbcrlf)
			For i = 0 To UBound(arrStr)
				If arrStr(i)<>"" Then 
					strReturn = strReturn & vbcrlf & arrStr(i)
				End if
			Next
			strReturn = Replace (strReturn,vbcrlf,"",1,1,1)
		Else 
			strReturn = badstr
		End If
		FilterEmpty = strReturn
	End Function

End Class

Class AjaxXml
	Private m_contentType,m_encoding,m_xml

	Private Sub Class_Initialize()
		m_contentType = "text/xml"
		m_encoding = "gb2312"
		m_xml=true
	End sub

	Public sub re(result)
		Response.contentType = m_contentType
		Response.Expires=0
		response.Write serialize(result)
	End Sub

	Private function serialize(result)
		Dim restr,i
		if m_xml then
			restr = "<?xml version=""1.0"" encoding="""&m_encoding&"""?>"
			restr = restr+"<Response>"
			if IsArray(result) then
				For i=0 to UBound(result)
					restr = restr + "<item><![CDATA["&result(i)&"]]></item>"
				next
			else
				restr = restr + result
			end If
			restr = restr + "</Response>"
		else
			restr = result
		end if
		serialize = restr
	end function
End Class
%>