<%
Class DownloadClass_Cls
	Public membername, memberpass, membergrade, membertype, memberid
	Public DownLoad_sn, Version, Setting, StopReadme, Badwords, Badwordr
	Public tempid, System_ver, SetupDir, LockipList,Register_Key,Register_Code
	Public CacheName, Reloadtime, CacheData, Temp_Data
	Public SqlQueryNum, GetUserip, GetSetupDir, ScriptName
	Public TempName, TempDir, Style_CSS, skinid, Admin_Page, Unlock_Page
	Private LocalCacheName,CaCheInfo, Cache_Data, Cookiesid, Conn
	Public mainhtml, mainset, temphtml, tempset
	Public Copyright, Script_FSO, startime, Founderr, NowTime
	Public SqlString, SortingMenu, ClassMenu, SystemEdition, IsBusiness,isSqlDataBase
	Private Sub Class_Initialize()
		startime = Timer()
		SqlQueryNum = 0
		Reloadtime = 14400
		Founderr = False
		DownLoad_sn = Replace(LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"), Split(Request.ServerVariables("SCRIPT_NAME"), "/")(UBound(Split(Request.ServerVariables("SCRIPT_NAME"), "/"))), "")), "admin/", "")
		CacheName = Replace(Replace(Replace(Replace(LCase(Server.MapPath("index.asp")), "index.asp", ""), ":", ""), "\", ""), "admin", "")
		GetSetupDir = Replace(Left(LCase(Request.ServerVariables("SCRIPT_NAME")), InStrRev(LCase(Request.ServerVariables("SCRIPT_NAME")), "/")),"admin/","")
		GetUserip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If Len(GetUserip) = 0 Then GetUserip = Request.ServerVariables("REMOTE_ADDR")
		GetUserip = checkStr(GetUserip)
		membername = checkStr(Request.Cookies(DownLoad_sn)("username"))
		memberpass = checkStr(Request.Cookies(DownLoad_sn)("password"))
		membergrade = checkStr(Request.Cookies(DownLoad_sn)("grade"))
		membertype = checkStr(Request.Cookies(DownLoad_sn)("usertype"))
		memberid = Request.Cookies(DownLoad_sn)("userid")
		Dim tmpstr, i
		tmpstr = Request.ServerVariables("PATH_INFO")
		tmpstr = Split(tmpstr, "/")
		i = UBound(tmpstr)
		ScriptName = LCase(tmpstr(i))
		Admin_Page = False
		If InStr(ScriptName, "showerr") > 0 Or InStr(ScriptName, "login") > 0 Or InStr(ScriptName, "admin_") > 0 Or InStr(ScriptName, "Create_") > 0 Then Admin_Page = True
		Unlock_Page = False
		If InStr(ScriptName, "showerr") > 0 Or InStr(ScriptName, "login") > 0 Or InStr(ScriptName, "Create_") > 0 Or InStr(ScriptName, "admin_index") > 0 Or InStr(ScriptName, "admin_lockip") > 0 Then Unlock_Page = True
		IsBusiness = 0
		isSqlDataBase = CInt(isSqlDataBase)
		If isSqlDataBase = 1 Then
			SqlString = "GetDate()"
		Else
			SqlString = "Now()"
		End If
	End Sub

	Private Sub Class_Terminate()
		If IsObject(Conn) Then
			Conn.Close
			Set Conn = Nothing
		End If
	End Sub

	Public Property Let Name(ByVal vNewValue)
		LocalCacheName = LCase(vNewValue)
	End Property

	Public Property Let Value(ByVal vNewValue)
		If LocalCacheName <> "" Then
			ReDim Cache_Data(2)
			Cache_Data(0) = vNewValue
			Cache_Data(1) = Now()
			Application.Lock
			Application(CacheName & "_" & LocalCacheName) = Cache_Data
			Application.UnLock
		Else
			Err.Raise vbObjectError + 1, "DownsysClassCacheServer", " please change the CacheName."
		End If
	End Property

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

	Public Function ObjIsEmpty()
		ObjIsEmpty = True
		Cache_Data = Application(CacheName & "_" & LocalCacheName)
		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 (CacheName & "_" & MyCaheName)
		Application.UnLock
	End Sub

	Public Sub System_Config()
		Name = "Config"
		If ObjIsEmpty() Then ReloadConfig
		CacheData = Value
		'第一次起用系统或者重启IIS的时候加载缓存
		Name = "Date"
		If ObjIsEmpty() Then
			Value = Date
		Else
			If CStr(Value) <> CStr(Date) Then
				Name = "Config"
				Call ReloadConfig
				CacheData = Value
			End If
		End If
		Setting = Split(CacheData(1, 0), "|||")
		StopReadme = CacheData(2, 0)
		Badwords = CacheData(3, 0)
		Badwordr = CacheData(4, 0)
		tempid = CacheData(5, 0)
		Register_Key = CacheData(6, 0)
		Register_Code = CacheData(7, 0)
		System_ver = CacheData(8, 0)
		SetupDir = CacheData(9, 0)
		Script_FSO = CacheData(10, 0)
		LockipList = CacheData(11, 0)
		NowTime = Now() + CInt(Setting(16)) / 24
		Version = "Xuanxi DownLoad System"
		Copyright = vbCrLf&"<!-- S0575.Net All Rights Reserved . -->" & vbCrLf
		'IP锁定
		If Not Unlock_Page Then
			If Request.Cookies(DownLoad_sn & "Kill")("kill") = "1" Then
				Response.redirect ("" & SetupDir & "showerr.asp?action=iplock")
			ElseIf Request.Cookies(DownLoad_sn & "Kill")("kill") <> "0" Then
				ChecKIPlock
			End If
		End If
		'关闭系统相关部分
		If CInt(Setting(7)) = 1 And Not Admin_Page Then Response.redirect ("" & SetupDir & "showerr.asp?action=stop")
		SystemEdition = "3.2 Free Edition"
	End Sub

	Public Sub ReloadConfig()
		Dim SqlCon
		Dim RsCon
		SqlCon = "Select * from NC_Config"
		Set RsCon = Execute(SqlCon)
		Value = RsCon.GetRows(1)
		Set RsCon = Nothing
		Execute (" Update NC_Config Set SetupDir = '" & GetSetupDir & "' ")
	End Sub

	Public Sub ReloadTemplateslist()
		Dim Rs
		Dim SQL
		Dim tmpdata
		SQL = "select ID,TempName from [NC_Template]"
		Set Rs = Execute(SQL)
		tmpdata = Rs.GetString(, , "|||", "@@@", "")
		tmpdata = Left(tmpdata, Len(tmpdata) - 3)
		Set Rs = Nothing
		Value = tmpdata
	End Sub

	Public Sub LoadTemplates(Temp_Fields)
		Dim Main_Style
		Cookiesid = Request.Cookies("skin")("skinid")
		If Not IsNumeric(Cookiesid) Or Cookiesid = "" Then
			skinid = tempid
		Else
			skinid = Cookiesid
		End If
		skinid = CLng(skinid)
		Name = "TempName" & skinid
		If ObjIsEmpty() Then TemplatesToCache ("TempName")
		TempName = Value
		Name = "TempDir" & skinid
		If ObjIsEmpty() Then TemplatesToCache ("TempDir")
		TempDir = Value
		Name = "Style_CSS" & skinid
		If ObjIsEmpty() Then TemplatesToCache ("Style_CSS")
		Style_CSS = Value
		Style_CSS = Replace(Replace(Style_CSS, "{$SetupDir}", SetupDir), "{$PicUrl}", TempDir)
		Name = "Main_Style" & skinid
		If ObjIsEmpty() Then TemplatesToCache ("Main_Style")
		Main_Style = Value
		Main_Style = Replace(Main_Style, "{$SetupDir}", SetupDir)
		Main_Style = Replace(Main_Style, "{$PicUrl}", TempDir)
		Main_Style = Replace(Main_Style, "<head>", "<head>" & Copyright)
		Main_Style = Replace(Main_Style, "{$Version}", Version)
		Main_Style = Replace(Main_Style, "{$WebName}", Setting(0))
		Main_Style = Replace(Main_Style, "{$WebUrl}", Setting(1))
		Main_Style = Replace(Main_Style, "{$E-mail}", Setting(2))
		Main_Style = Replace(Main_Style, "{$Keyword}", Setting(3))
		Main_Style = Replace(Main_Style, "{$Copyright}", Setting(4))
		Main_Style = Replace(Main_Style, "{$IndexPage}", Setting(6))
		Main_Style = Split(Main_Style, "@@@")
		mainhtml = Split(Main_Style(0), "|||")
		mainset = Split(Main_Style(1), "|||")
		Name = "SortingMenu" & skinid
		If ObjIsEmpty() Then SortingMenuToCache
		SortingMenu = Value
		Name = "ClassMenu" & skinid
		If ObjIsEmpty() Then ClassMenuToCache
		ClassMenu = Value
		If Temp_Fields <> "" Then
			Name = "Temp_" & Temp_Fields & skinid
			If ObjIsEmpty() Then TemplatesToCache ("temp_" & Temp_Fields)
			ByValue = Value
		End If
	End Sub

	Public Sub TemplatesToCache(Temp_Fields)
		Dim Rs, SQL
		SQL = "Select " & Temp_Fields & " from [NC_Template] where id = " & skinid
		Set Rs = Execute(SQL)
		If Not Rs.EOF Then
			Value = Rs(0) & ""
		Else
			'处理错误
			If skinid = CLng(tempid) Then
				Call FixConfigtid
			End If
			Response.redirect "" & SetupDir & "cookies.asp?action=stylemod&skinid=0"
		End If
		Set Rs = Nothing
	End Sub

	Private Sub FixConfigtid()
		Dim Rs
		Dim SQL
		SQL = "Select Top 1 ID from [NC_Template] Order by ID"
		Set Rs = Execute(SQL)
		If Rs.EOF Then
			Response.Write "模板数据是空的，请添加。"
			Response.End
		Else
			ReloadConfigCache Rs(0), 5
			Execute (" Update NC_Config Set tempid = " & Rs(0) & " ")
		End If
		Set Rs = Nothing
	End Sub
	'*************************************************************
	'函数作用：更新总设置表部分缓存数组，入口：更新内容、数组位置
	'*************************************************************
	Public Function ReloadConfigCache(MyValue, n)
		CacheData(n, 0) = MyValue
		Name = "Config"
		Value = CacheData
	End Function

	Public Property Let ByValue(ByVal vNewValue)
		Dim tmpstr
		tmpstr = vNewValue
		tmpstr = Replace(tmpstr, "{$SetupDir}", SetupDir)
		tmpstr = Replace(tmpstr, "{$PicUrl}", TempDir)
		tmpstr = Replace(tmpstr, "<head>", "<head>" & Copyright)
		tmpstr = Replace(tmpstr, "{$Version}", Version)
		tmpstr = Replace(tmpstr, "{$WebName}", Setting(0))
		tmpstr = Replace(tmpstr, "{$WebUrl}", Setting(1))
		tmpstr = Replace(tmpstr, "{$E-mail}", Setting(2))
		tmpstr = Replace(tmpstr, "{$Keyword}", Setting(3))
		tmpstr = Replace(tmpstr, "{$Copyright}", Setting(4))
		tmpstr = Replace(tmpstr, "{$Width}", mainset(0))
		tmpstr = Replace(tmpstr, "{$IndexPage}", Setting(6))
		tmpstr = Split(tmpstr, "@@@")
		temphtml = Split(tmpstr(0), "|||")
		tempset = Split(tmpstr(1), "|||")
	End Property

	Public Sub SortingMenuToCache()
		Dim SQL, Rs, HtmlString, HtmlMenu, i, totalnumber
		If Not IsObject(Conn) Then ConnectionDatabase
		SQL = "select * from [NC_SoftSort] where depth=0 order by rootid"
		Set Rs = CreateObject("adodb.recordset")
		Rs.Open SQL, Conn, 1, 1
		SqlQueryNum = SqlQueryNum + 1
		HtmlString = mainset(3)
		If Not (Rs.EOF And Rs.bof) Then
			i = 1
			totalnumber = Rs.recordcount
			Do While Not Rs.EOF
				HtmlString = HtmlString & mainset(4)
				If CInt(Setting(5)) = 0 Then
					HtmlMenu = "<a href='" & SetupDir & "Sorting/Catalog" & Rs("sortid") & "/Sorting_Indate_Desc_1.html' class=""ToolBarLink"" title='" & Rs("Readme") & "'>" & Rs("SortName") & "</a>" & vbCrLf
				Else
					HtmlMenu = "<a href='" & SetupDir & "Sorting.asp?sortid=" & Rs("sortid") & "' class=""ToolBarLink"" title='" & Rs("Readme") & "'>" & Rs("SortName") & "</a>" & vbCrLf
				End If
				If (i Mod CInt(mainset(1))) = 0 And i <> totalnumber Then HtmlMenu = HtmlMenu & "<BR>"
				HtmlString = Replace(HtmlString, "{$SoftMeun}", HtmlMenu)
				Rs.movenext
				i = i + 1
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		HtmlString = HtmlString & mainset(5)
		HtmlString = Replace(HtmlString, "{$SetupDir}", SetupDir)
		HtmlString = Replace(HtmlString, "{$IndexPage}", Setting(6))
		Value = HtmlString
	End Sub

	Public Sub ClassMenuToCache()
		Dim SQL, Rs, HtmlString, HtmlMenu, i, totalnumber
		If Not IsObject(Conn) Then ConnectionDatabase
		SQL = "select * from [NC_Class] where depth=0 order by rootid"
		Set Rs = CreateObject("adodb.recordset")
		Rs.Open SQL, Conn, 1, 1
		SqlQueryNum = SqlQueryNum + 1
		HtmlString = mainset(6)
		If Not (Rs.EOF And Rs.bof) Then
			i = 1
			totalnumber = Rs.recordcount
			Do While Not Rs.EOF
				HtmlString = HtmlString & mainset(7)
				If CInt(Setting(5)) = 0 Then
					HtmlMenu = "<a href='" & SetupDir & "Listing/Catalog" & Rs("classid") & "/Listing_Indate_Desc_1.html' class=""ToolBarLink"" title='" & Rs("Readme") & "'>" & Rs("ClassName") & "</a>" & vbCrLf
				Else
					HtmlMenu = "<a href='" & SetupDir & "Listing.asp?classid=" & Rs("classid") & "' class=""ToolBarLink"" title='" & Rs("Readme") & "'>" & Rs("ClassName") & "</a>" & vbCrLf
				End If
				If i Mod CInt(mainset(2)) = 0 And i <> totalnumber Then HtmlMenu = HtmlMenu & "<BR>"
				HtmlString = Replace(HtmlString, "{$InfoMeun}", HtmlMenu)
				Rs.movenext
				i = i + 1
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		HtmlString = HtmlString & mainset(8)
		HtmlString = Replace(HtmlString, "{$SetupDir}", SetupDir)
		HtmlString = Replace(HtmlString, "{$IndexPage}", Setting(6))
		Value = HtmlString
	End Sub

	Property Get Get_ScriptNameUrl()
		If Request.ServerVariables("SERVER_PORT") = "80" Then
			Get_ScriptNameUrl = "http://" & Request.ServerVariables("server_name") & Replace(LCase(Request.ServerVariables("script_name")), ScriptName, "")
		Else
			Get_ScriptNameUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT") & Replace(LCase(Request.ServerVariables("script_name")), ScriptName, "")
		End If
	End Property

	Public Sub ConnectionDatabase()
		Set Conn = Server.CreateObject("ADODB.Connection")
		Conn.Open Connstr
	End Sub

	Public Function Execute(Command)
		If Not IsObject(Conn) Then ConnectionDatabase
		If InStr(LCase(Command), "nc_admin") > 0 And Left(ScriptName, 6) <> "admin_" Then
			Command = Replace(LCase(Command), "nc_admin", "nc<i>"&Chr(95)&"</i>admin")
		End If
		On Error Resume Next
		Set Execute = Conn.Execute(Command)
		If Err Then
			Err.Clear
			Set Conn = Nothing
			Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
			Response.End
		End If
		SqlQueryNum = SqlQueryNum + 1
	End Function
	'*************************************************************
	'函数作用：IP地址限制
	'*************************************************************
	Public Function ChecKIPlock()
		On Error Resume Next
		ChecKIPlock = False
		Dim locklist
		Dim locklists
		locklists = Trim(LockipList)
		If Len(locklists) = 0 Then Exit Function
		Dim i
		Dim StrUserIP
		Dim StrKillIP
		StrUserIP = GetUserip
		locklist = Split(locklists, "|")
		If Len(StrUserIP) = 0 Then Exit Function
		StrUserIP = Split(GetUserip, ".")
		If UBound(StrUserIP) <> 3 Then Exit Function
		For i = 0 To UBound(locklist)
			locklist(i) = Trim(locklist(i))
			If locklist(i) <> "" Then
				StrKillIP = Split(locklist(i), ".")
				If UBound(StrKillIP) <> 3 Then Exit For
				ChecKIPlock = True
				If (StrUserIP(0) <> StrKillIP(0)) And InStr(StrKillIP(0), "*") = 0 Then ChecKIPlock = False
				If (StrUserIP(1) <> StrKillIP(1)) And InStr(StrKillIP(1), "*") = 0 Then ChecKIPlock = False
				If (StrUserIP(2) <> StrKillIP(2)) And InStr(StrKillIP(2), "*") = 0 Then ChecKIPlock = False
				If (StrUserIP(3) <> StrKillIP(3)) And InStr(StrKillIP(3), "*") = 0 Then ChecKIPlock = False
				If ChecKIPlock Then Exit For
			End If
		Next
		Response.Cookies(DownLoad_sn & "Kill").Expires = DateAdd("s", 3600, Now())
		Response.Cookies(DownLoad_sn & "Kill").Path = SetupDir
		If ChecKIPlock Then
			Response.Cookies(DownLoad_sn & "Kill")("kill") = "1"
			Response.redirect ("" & SetupDir & "showerr.asp?action=iplock")
		Else
			Response.Cookies(DownLoad_sn & "Kill")("kill") = "0"
		End If
	End Function
	'*************************************************************
	'函数作用：判断服务器是否支持FSO组件（FileSystemObject）
	'*************************************************************
	Public Function IsObjectFSO(ObjString)
		On Error Resume Next
		IsObjectFSO = False
		Err = 0
		Dim TestFSO
		Set TestFSO = Server.CreateObject(ObjString)
		If 0 = Err Then IsObjectFSO = True
		Set TestFSO = Nothing
		Err = 0
	End Function
        '*************************************************************
        '函数名：ChkFormStr
        '作  用：过滤表单字符
        '参  数：str   ----原字符串
        '返回值：过滤后的字符串
        '*************************************************************
        Public Function ChkFormStr(str)
                If IsNull(str) Then
                        ChkFormStr = ""
                        Exit Function
                End If
                str = Replace(str, Chr(39), "&#39;")
                str = Replace(str, Chr(34), "&quot;")
                str = Replace(str, Chr(13), "")
                str = Replace(str, Chr(10), "")
                str = Replace(str, Chr(9), "")
                str = Replace(str, "&nbsp;", " ")
                ChkFormStr = Trim(str)
        End Function
	'*************************************************************
	'函数作用：过滤SQL非法字符
	'*************************************************************
	Public Function checkStr(Str)
		If IsNull(Str) Then
			checkStr = ""
			Exit Function
		End If
		checkStr = Replace(Str, "'", "''")
	End Function
	'*************************************************************
	'函数作用：过滤查询字符
	'*************************************************************
	Public Function ChkQueryStr(Str)
		If IsNull(Str) Then
			ChkQueryStr = ""
			Exit Function
		End If
		Str = Replace(Str,"!"," ")
		Str = Replace(Str,"]"," ")
		Str = Replace(Str,"["," ")
		Str = Replace(Str,")"," ")
		Str = Replace(Str,"("," ")
		Str = Replace(Str,"　"," ")
		Str = Replace(Str,"-"," ")
		Str = Replace(Str,"/"," ")
		Str = Replace(Str,"+"," ")
		Str = Replace(Str,"="," ")
		Str = Replace(Str,","," ")
		Str = Replace(Str,"'"," ")
		Str = Replace(Str,"&nbsp;"," ")
		ChkQueryStr = Str
	End Function
	'*************************************************************
	'函数作用：带脏话过滤
	'*************************************************************
	Public Function ChkBadWords(Str)
		If IsNull(Str) Then Exit Function
		Dim i, Bwords, Bwordr
		Bwords = Split(Badwords, "|")
		Bwordr = Split(Badwordr, "|")
		For i = 0 To UBound(Bwords)
			If i > UBound(Bwordr) Then
				Str = Replace(Str, Bwords(i), "*")
			Else
				Str = Replace(Str, Bwords(i), Bwordr(i))
			End If
		Next
		ChkBadWords = Str
	End Function
	'*************************************************************
	'函数作用：过滤HTML代码，带脏话过滤
	'*************************************************************
	Public Function HTMLEncode(fString)
		If Not IsNull(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, " ", "&nbsp;")
			fString = Replace(fString, Chr(10), "<BR> ")
			fString = ChkBadWords(fString)
			HTMLEncode = fString
		End If
	End Function
	'*************************************************************
	'函数作用：过滤HTML代码，不带脏话过滤
	'*************************************************************
	Public Function HTMLEncodes(fString)
		If Not IsNull(fString) Then
			fString = Replace(fString, "'", "&#39;")
			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), "<BR> ")
			fString = Replace(fString, " ", "&nbsp;")
			HTMLEncodes = fString
		End If
	End Function
	'*************************************************************
	'函数作用：判断发言是否来自外部
	'*************************************************************
	Public Function CheckPost()
		Dim server_v1, server_v2
		CheckPost = False
		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
			CheckPost = True
		End If
	End Function
	'*************************************************************
	'函数作用：显示字符串长度
	'*************************************************************
	Public Function gotTopic(Str, strlen)
		Dim l, T, c, i
		Str = Replace(Str, "&nbsp;", " ")
		l = Len(Str)
		T = 0
		For i = 1 To l
			c = Abs(Asc(Mid(Str, i, 1)))
			If c > 255 Then
				T = T + 2
			Else
				T = T + 1
			End If
			If T >= strlen Then
				gotTopic = Left(Str, i) & "..."
				Exit For
			Else
				gotTopic = Str & " "
			End If
		Next
	End Function
	Public Function CutString(Str, strlen)
		Dim HtmlStr, L, Re
		HtmlStr = Str
		HtmlStr = Replace(HtmlStr, "&nbsp;", " ")
		HtmlStr = Replace(Replace(Replace(HtmlStr, Chr(34), ""), Chr(13), " "), Chr(10), " ")
		Set Re = New RegExp
		Re.IgnoreCase =true
		Re.Global=True
		Re.Pattern="\[br\]"
		HtmlStr = Re.Replace(HtmlStr,"")
		Re.Pattern="\[align=right\](.*)\[\/align\]"
		HtmlStr = Re.Replace(HtmlStr,"")
		Re.Pattern="<(.[^>]*)>"
		HtmlStr = Re.Replace(HtmlStr,"")
		Set Re = Nothing
		L = Len(HtmlStr)
		If L >= strlen Then
			CutString = Left(HtmlStr, strlen) & "..."
		Else
			CutString = HtmlStr & " "
		End If
	End Function
	'*************************************************************
	'函数作用：判断非法字符
	'*************************************************************
	Public Function IsValidStr(Str)
		IsValidStr = True
		If IsNull(Str) Then Exit Function
		Dim ForbidStr, i
		ForbidStr = ":|=|%|&|$|#|@|+|-|*|/|\|<|>|;|,|"& Chr(32) &"|"& Chr(34) &"|"& Chr(39) &"|"& Chr(9)
		ForbidStr = Split(ForbidStr, "|")
		For i = 0 To UBound(ForbidStr)
			If InStr(Str, ForbidStr(i)) > 0 Then
				IsValidStr = False
				Exit Function
			End If
		Next
		IsValidStr = True
	End Function
	'*************************************************************
	'函数作用：判断密码非法字符
	'*************************************************************
	Public Function IsValidPassword(Str)
		IsValidPassword = True
		If IsNull(Str) Then Exit Function
		Dim ForbidStr, i
		ForbidStr = "=|%|&|;|,|"& Chr(32) &"|"& Chr(34) &"|"& Chr(39) &"|"& Chr(9)
		ForbidStr = Split(ForbidStr, "|")
		For i = 0 To UBound(ForbidStr)
			If InStr(Str, ForbidStr(i)) > 0 Then
				IsValidPassword = False
				Exit Function
			End If
		Next
		IsValidPassword = True
	End Function

	Public Sub admin_footer()
		Response.Write "<table align=center >" & vbCrLf
		Response.Write "<tr align=center><td>" & vbCrLf
		If CInt(Setting(18)) = 1 Then
			Dim Endtime
			Endtime = Timer()
			Response.Write "执行时间：" & FormatNumber((Endtime - startime) * 1000, 3) & "毫秒。查询数据库" & SqlQueryNum & "次。" & vbCrLf
			Response.Write CaCheInfo
		End If
		Response.Write "</td>" & vbCrLf
		Response.Write "</tr>" & vbCrLf
		Response.Write "</table>" & vbCrLf
		Response.Write "</div>" & vbCrLf
		Response.Write "</body></html>"
	End Sub

	Public Sub admin_header()
		Session.Timeout = Setting(21) 'Session会话的保持时间(分钟)
		Response.Write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">"
		Response.Write Copyright
		Response.Write "<html>" & vbCrLf
		Response.Write "<head>" & vbCrLf
		Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & vbCrLf
		Response.Write "<title>" & Setting(0) & "-管理页面</title>" & vbCrLf
		Response.Write "<LINK href=""style.css"" type=text/css rel=stylesheet>" & vbCrLf
		Response.Write "<script>" & vbCrLf
		Response.Write "function preloadImg(src)" & vbCrLf
		Response.Write "{" & vbCrLf
		Response.Write Chr(9) & "var img=new Image();" & vbCrLf
		Response.Write Chr(9) & "img.src=src" & vbCrLf
		Response.Write "}" & vbCrLf
		Response.Write "preloadImg(""images/admin_top_open.gif"");" & vbCrLf
		Response.Write "var displayBar=true;" & vbCrLf
		Response.Write "function switchBar(obj)" & vbCrLf
		Response.Write "{" & vbCrLf
		Response.Write Chr(9) & "if (displayBar)" & vbCrLf
		Response.Write Chr(9) & "{" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "parent.frame.cols=""0,*"";" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "displayBar=false;" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "obj.src=""images/admin_top_open.gif"";" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "obj.title=""打开左边管理菜单"";" & vbCrLf
		Response.Write Chr(9) & "}" & vbCrLf
		Response.Write Chr(9) & "else{" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "parent.frame.cols=""180,*"";" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "displayBar=true;" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "obj.src=""images/admin_top_close.gif"";" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "obj.title=""关闭左边管理菜单"";" & vbCrLf
		Response.Write Chr(9) & "}" & vbCrLf
		Response.Write "}" & vbCrLf
		Response.Write "</script>" & vbCrLf
		Response.Write "</head>" & vbCrLf
		Response.Write "<body leftmargin=0 bottommargin=0 rightmargin=0 topmargin=0>" & vbCrLf
		Response.Write "<script src=""images/admin.js"" type=""text/javascript""></script>" & vbCrLf
		Response.Write "<div class=menuskin id=popmenu " & vbCrLf
		Response.Write "      onmouseover=""clearhidemenu();highlightmenu(event,'on')"" " & vbCrLf
		Response.Write "      onmouseout=""highlightmenu(event,'off');dynamichide(event)"" style=""Z-index:100""></div>" & vbCrLf
		Response.Write "<div align=center>" & vbCrLf
		Response.Write "<TABLE cellSpacing=0 cellPadding=3 align=center style=""width:100%"" border=0>" & vbCrLf
		Response.Write " <TR>" & vbCrLf
		Response.Write "<td class=BodyTitle height=25><TABLE cellSpacing=0 cellPadding=0 width=""100%"" border=0>" & vbCrLf
		Response.Write " <TR>" & vbCrLf
		Response.Write " <TD align=""left""><img onclick=""switchBar(this)"" src=""images/admin_top_close.gif"" title=""关闭左边管理菜单"" style=""cursor:hand""></TD>" & vbCrLf
		Response.Write " <TD width=""25%"" style=""FONT-SIZE: 9pt; FILTER: dropshadow(color=#FFFFFF,offx=1,offy=1); COLOR: #000000;"">"
		Response.Write "下载系统控制面板"
		Response.Write " </TD>" & vbCrLf
		Response.Write " <TD width=""25%"" style=""FONT-SIZE: 9pt; FILTER: dropshadow(color=#FFFFFF,offx=1,offy=1); COLOR: #000000;"">"
		Response.Write "<a href=admin_password.asp target=main>修改管理员资料</a>"
		Response.Write " </TD>" & vbCrLf
		Response.Write " <TD width=""40%"" id=spid style=""FONT-SIZE: 9pt; FILTER: dropshadow(color=#FFFFF9,offx=1,offy=1); COLOR: #FF3300;""></TD>" & vbCrLf
		Response.Write " <TD align=right><A href=../ target=_top><img src=""images/i_home.gif"" title=""返回首页"" border=0></A></TD>" & vbCrLf
		Response.Write " </TR>" & vbCrLf
		Response.Write " </TABLE></TD>"
		Response.Write " </TR>" & vbCrLf
		Response.Write " <TR><TD height=10></TD></TR>" & vbCrLf
		Response.Write " </TABLE>" & vbCrLf
	End Sub

	'*************************************************************
	'函数作用：缓存后台跳转分类列表
	'*************************************************************
	Public Function SortingJumpList()
		Dim CacheJumpList, SQL, Rs1, i
		If Not IsObject(Conn) Then ConnectionDatabase
		Name = "SortingJumpList"
		If ObjIsEmpty() Then
			CacheJumpList = "<select name=""sortid"" size=""1"">" & vbCrLf
			Set Rs1 = Server.CreateObject("Adodb.recordset")
			SQL = "select * from NC_SoftSort order by rootid,orders"
			Rs1.Open SQL, Conn, 1, 1
			SqlQueryNum = SqlQueryNum + 1
			Do While Not Rs1.EOF
				If Rs1("depth") = 0 Then
					CacheJumpList = CacheJumpList & "<option value="""" "
				Else
					CacheJumpList = CacheJumpList & "<option value=""" & Rs1("RootID") & "," & Rs1("sortid") & "," & Rs1("SortName") & """ {SortID=" & Rs1("sortid") & "}"
				End If
				CacheJumpList = CacheJumpList & ">"
				If Rs1("depth") = 1 Then CacheJumpList = CacheJumpList & "　├ "
				If Rs1("depth") > 1 Then
					For i = 2 To Rs1("depth")
						CacheJumpList = CacheJumpList & "　"
					Next
					CacheJumpList = CacheJumpList & "　├ "
				End If
				CacheJumpList = CacheJumpList & Rs1("SortName") & "</option>" & vbCrLf
				Rs1.movenext
			Loop
			Rs1.Close
			Set Rs1 = Nothing
			CacheJumpList = CacheJumpList & "</select>"
			Value = CacheJumpList
		End If
		SortingJumpList = Value
	End Function
	'*************************************************************
	'函数作用：缓存后台跳转分类列表
	'*************************************************************
	Public Function ClassJumpList()
		Dim CacheJumpList, SQL, Rs1, i
		If Not IsObject(Conn) Then ConnectionDatabase
		Name = "ClassJumpList"
		If ObjIsEmpty() Then
			CacheJumpList = "<select name=""classid"" size=""1"">" & vbCrLf
			Set Rs1 = Server.CreateObject("Adodb.recordset")
			SQL = "select * from NC_Class order by rootid,orders"
			Rs1.Open SQL, Conn, 1, 1
			SqlQueryNum = SqlQueryNum + 1
			Do While Not Rs1.EOF
				If Rs1("depth") = 0 Then
					CacheJumpList = CacheJumpList & "<option value="""" "
				Else
					CacheJumpList = CacheJumpList & "<option value=""" & Rs1("RootID") & "," & Rs1("classid") & "," & Rs1("ClassName") & """ {ClassID=" & Rs1("classid") & "}"
				End If
				CacheJumpList = CacheJumpList & ">"
				If Rs1("depth") = 1 Then CacheJumpList = CacheJumpList & "　├ "
				If Rs1("depth") > 1 Then
					For i = 2 To Rs1("depth")
						CacheJumpList = CacheJumpList & "　"
					Next
					CacheJumpList = CacheJumpList & "　├ "
				End If
				CacheJumpList = CacheJumpList & Rs1("ClassName") & "</option>" & vbCrLf
				Rs1.movenext
			Loop
			Rs1.Close
			Set Rs1 = Nothing
			CacheJumpList = CacheJumpList & "</select>"
			Value = CacheJumpList
		End If
		ClassJumpList = Value
	End Function
End Class
%>
