<%
'===================================================
' CreateLive CMS Version 3.1
'							Powered by Aspoo.CoM
'===================================================
' File: Cl_ClsSysTem.asp
' Date: 2005-10-31
' Mail: aspoo@126.com, Info@aspoo.cn
' Q  Q: 3315263, 596197794
' Msn : aspoo@126.com, Clw866@hotmail.com
' Web : http://www.aspoo.com, http://www.aspoo.net
' Bbs : http://bbs.aspoo.com, http://bbs.aspoo.net
' Copyright (C) 2005 Aspoo.CoM All Rights Reserved.
'===================================================
' 注: 本程序采用动网先锋缓存类。
'===================================================
Class Cls_CMSSysTem
	Private LocalCacheName
	Public Reloadtime, CacheName, CacheData, SqlQueryNum, SysTemUpDate
	Public ScriptName, ServerName, Page_Admin, pNum, pNum2, IPDataBase
	Public Web_Setting, Web_Version, BadWords, rBadWord
	Public Upload_Setting, Product_Setting, Channel_Setting
	Public Web_Cookies, Web_Info, Web_Pack
	Public Admin_Info, Admin_Purview
	Public User_Info, User_IM, User_Purview
	Public UserID, UserLevel, UserTrueIP, MemberName, MemberWord
	Public ChannelName, ChannelItemName, ChannelReadMe, ChannelItemUnit, ChannelUrl, IsDisabled
	Public IsCreateHtml, CreatePathType, CreateFileType, CreateFileExt, IsCreateList
	Public StyleID, CssID, Logo, Banner, CountConfig, ChannelOtherSetting
	Public StyleName, Web_CSS, Web_PicUrl, mainhtml, mainsetting, lanstr, mainpic
	Public WebDir, HtmlDir, ChannelDir, UpLoadDir, DownLoadDir   '上传主目录，软件下载目录
	Public SendMsgNum, SendMsgID, SendMsgUser
	Public Path, Title, Keywords, DeScriptIon, PATH_INFO

	Private Sub Class_Initialize()
		Dim Web_CacheName,Tmpstr
		Web_Cookies		= "Aspoo"       'Cookies名称
	    Web_CacheName	= "Aspoo"		'网站缓存，如果一个站点有多个网站请更改
		Reloadtime		= 28800
		SysTemUpDate	= 20060622
		SqlQueryNum		= 0 : pNum = 1 : pNum2 = 0
		SendMsgNum		= 0 : SendMsgID	= 0 : SendMsgUser = ""
		CacheName		= Server.MapPath("/") & InstallDir & Web_CacheName
		CacheName		= Replace(Replace(Replace(Replace(CacheName," ",""),":",""),"\",""),"/","")
		MemberName		= Trim(Request.Cookies(Web_Cookies)("UserName"))
		MemberWord		= Trim(Request.Cookies(Web_Cookies)("PassWord"))
		UserID			= ChkClng(Request.Cookies(Web_Cookies)("UserID"))
		UserLevel		= Trim(Request.Cookies(Web_Cookies)("UserLevel"))
		UserTrueIP		= CheckStr(Request.ServerVariables("REMOTE_ADDR"))
		Path_Info		= Request.ServerVariables("PATH_INFO")
		Tmpstr			= Split(Path_Info,"/")
		ScriptName		= Lcase(Tmpstr(UBound(Tmpstr)))
		ServerName		= Lcase(request.ServerVariables("Server_Name"))
		Page_Admin		= False
		WebDir			= InstallDir
		If Not IsNumeric(UserLevel) or UserLevel = "" Then UserLevel=5
		UserLevel		= Clng(UserLevel)
		If InStr(ScriptName,"showerr.asp")>0 Or InStr(ScriptName,"login.asp")>0 Or InStr(ScriptName,"logout.asp")>0 Or InStr(ScriptName,"admin_index.asp")>0 Or InStr(ScriptName,"count.asp")>0 Then Page_Admin=True
	End Sub
	Private Sub class_terminate()
		User_Info		= Empty : Upload_Setting	= Empty
		Product_Setting	= Empty : Channel_Setting	= Empty
		Web_Info		= Empty : Web_Setting		= Empty
		CacheData		= Empty : MainHtml			= Empty
		User_IM			= Empty : User_Purview		= Empty
		if IsObject(Conn) then Conn.Close : Set Conn = Nothing
		if IsObject(Conn_U) then Conn_U.Close : Set Conn_U = Nothing
		if IsObject(Conn_L) then Conn_L.Close : Set Conn_L = Nothing
	End Sub
	Public Property Let Name(ByVal vNewValue)
		LocalCacheName=LCase(vNewValue)
	End Property
	Public Property Let Value(ByVal vNewValue)
		If LocalCacheName<>"" Then 
			Application.Lock
			Application(CacheName & "_" & LocalCacheName & "_-time")=Now()
			Application(CacheName & "_" & LocalCacheName) = vNewValue
			Application.unLock
		End If
	End Property
	Public Property Get Value()
		If LocalCacheName<>"" Then
			Value=Application(CacheName & "_" & LocalCacheName)
		End If
	End Property
	Public Function ObjIsEmpty()
		ObjIsEmpty=True
		If  Not IsDate(Application(CacheName & "_" & LocalCacheName &"_-time")) Then Exit Function
		If DateDiff("s",CDate(Application(CacheName & "_" & LocalCacheName &"_-time")),Now()) < (60*Reloadtime) Then ObjIsEmpty=False
	End Function
	Public Sub DelCahe(MyCaheName)
		Application.Lock
		Application.Contents.Remove(CacheName&"_"&MyCaheName & "_-time")
		Application.Contents.Remove(CacheName&"_"&MyCaheName)
		Application.unLock
	End Sub
	Public Sub DelAllCache()
		Dim Cachelist,i
		Cachelist=split(GetallCache(),",")
		If UBound(cachelist)>1 Then
			For i=0 to UBound(cachelist)-1
				Application.Lock
				Application.Contents.Remove(Cachelist(i))
				Application.unLock
			Next
		End If
		Value=Date()
		If InStr(ScriptName,"showlogin.asp")>0 or InStr(ScriptName,"showerr.asp")>0 Then Exit Sub
		Name="ReFreshData"
		Value="Yes"
		Dim sPathInfo
		sPathInfo = Request.ServerVariables("PATH_INFO")
		If request.ServerVariables("QUERY_STRING")<>"" then sPathInfo = sPathInfo & "?" & request.ServerVariables("QUERY_STRING")
		If ChannelID>0 or Page_Admin Then
			Response.Redirect "../ReFreshData.Asp?cUrl=" & sPathInfo
		Elseif InStr(ScriptName,"index.asp")>0 then
			Response.Redirect "ReFreshData.Asp?cUrl=" & sPathInfo
		End if
		'Response.end
	End Sub
	Public Function GetallCache()
		Dim Cacheobj
		For Each Cacheobj in Application.Contents
		If CStr(Left(Cacheobj,Len(CacheName)+1))=CStr(CacheName&"_") Then	
			GetallCache=GetallCache & Cacheobj & ","
		End If
		Next
	End Function
	'取得系统定义资源
	Public Sub GetWeb_Setting()
		If Not Response.IsClientConnected Then
			Session(CacheName & "UserID")=Empty
			Response.End
		End If
		Name = "Date"
		If ObjIsEmpty() Then
			Value=Date()
			'Call DelAllCache()
		ElseIf Cstr(value) <> Cstr(Date()) Then
			Call DelAllCache()
		End If
		Name = "setup"
		if ObjIsEmpty() then ReloadSetup()
		CacheData		= value
		CacheData(1,0)	= Split(CacheData(1,0),"@@")
		Web_Info		= Split(CacheData(1,0)(0),"$")
		Web_Setting		= Split(CacheData(2,0),"$")
		StyleID			= CLng(CacheData(3,0))
		CssID			= CLng(CacheData(4,0))
		Title			= Web_info(1) & " " & Web_Info(3)
		DeScriptIon		= Web_Info(3)
		Keywords		= Web_Info(2)
		Logo			= Web_Info(5)
		Banner			= Web_Info(6)
		Web_Version		= Split(CacheData(5,0),",")
		CacheData(6,0)	= Split(CacheData(6,0),"@@")
		Web_Pack		= Split(CacheData(6,0)(0),"|||")
		BadWords		= Split(CacheData(7,0),"|")
		rBadWord		= Split(CacheData(8,0),"|")
		Upload_Setting	= Split(CacheData(11,0),"$")
		Product_Setting	= Split(CacheData(12,0),"|||")
		HtmlDir			= Replace(Web_Info(16),"/","") & "/"
		UpLoadDir		= Replace(WebDir&"/"&Upload_Setting(0)&"/","//","/")
		IPDataBase		= WebDir & "Data/Cl_IpAddress.Mdb" 'IP数据库
		If Trim(Request.Cookies(Web_Cookies & "Kill")("kill")) <> "No" Then
			If Trim(Request.Cookies(Web_Cookies & "Kill")("kill")) = "Yes" Then
				If Not Page_Admin Then Response.Redirect WebDir & "Showerr.asp?action=iplock"
			Else
				If Not Page_Admin Then 
					Call ChecKIPlock()
					If Trim(Request.Cookies(Web_Cookies & "Kill")("kill")) = "Yes" Then Response.Redirect WebDir & "Showerr.asp?action=iplock"
				end if
			End If
		end if
		if Trim(CacheData(1,0)(1))<>Trim(CacheData(5,0)) and InStr(ScriptName,"showerr")=0 Then
			DelCahe("Setup")
			Cl.OutErr(CacheData(6,0)(1))
		end if
		if Trim(Web_Info(11))="Close" And Not Page_Admin Then response.Redirect WebDir & "Showerr.asp?action=Close"
		if Trim(Web_Setting(8))="Yes" and Not NoChkSqlInFiles then ChkSQLInPost : ChkSQLInGet
	End Sub

	Public Sub GetWeb_CSetting(Byval sChannelID)
		'Dim sTrStyleID, sTrCssID
		GetChannelSetting(sChannelID)
		'sTrCssID		= Request.Cookies("AspooSkins")("Css"&sChannelID)
		'sTrStyleID		= ChkClng(Request.Cookies("AspooSkins")("Style"&sChannelID))
		ChannelName		= Trim(Channel_Setting(1))
		ChannelItemName	= Trim(Channel_Setting(2))
		ChannelItemUnit = Trim(Channel_Setting(3))
		ChannelDir		= Trim(Channel_Setting(4))
		ChannelUrl		= Trim(Channel_Setting(5))
		IsDisabled		= Clng(Channel_Setting(9))
		IsCreateHtml	= Clng(Channel_Setting(10))
		CreatePathType	= Cint(Channel_Setting(11))
		CreateFileType	= Cint(Channel_Setting(12))
		CreateFileExt	= Trim(Channel_Setting(13))
		StyleID			= Clng(Channel_Setting(16))
		CssID			= Clng(Channel_Setting(17))
		ChannelReadMe	= Channel_Setting(23)
		DeScriptIon		= Channel_Setting(23)
		CountConfig		= Channel_Setting(24)
		ChannelOtherSetting	= Split(Channel_Setting(25),",")
		if Channel_Setting(18)<>"" then Logo	= Channel_Setting(18)
		if Channel_Setting(19)<>"" then Banner	= Channel_Setting(19)
		'If sTrCssID<>"" and IsNumeric(sTrCssID) then CssID = CLng(sTrCssID)
		'If sTrStyleID > 0 then StyleID = sTrStyleID
	End Sub

	Public Sub GetChannelSetting(Byval sChannelID)
		sChannelID = ChkClng(sChannelID)
		Name = "Channel_Setting" & sChannelID
		If ObjIsEmpty() Then
			Dim sv,Rs,SQL
			SQL = "Select ChannelID,ChannelName,ChannelItemName,ChannelItemUnit,ChannelDir,LinkUrl,ChannelType,OpenType,IsShow,IsDisabled,IsCreateHtml,CreatePathType,CreateFileType,CreateFileExt,IsCreateList,AutoCreateList,StyleID,CssID,Logo,Banner,ModuleID,CusTom,UpLoadSetting,ReadMe,CountConfig,OtherSetting"
			SQL=SQL+" From Cl_Channel Where ChannelID=" & sChannelID
			Set Rs = Execute(SQL)
			if Rs.Bof and Rs.Eof then
				Set Rs = Nothing
				Response.write "系统找不到指定频道“"&sChannelID&"”，请<a href='"&Cl.WebDir&"User/Login.Asp'>登录后台</a>，查看模版中是否存在着调用ID为“"&sChannelID&"”频道的标签，请删除！"
				Response.end
			else
				sv = Rs.GetString(,1,"$$","%%%","")
			end if
			Set Rs = Nothing
			value = Replace(sv,"%%%","") & "$$Aspoo"
		End if
		Channel_Setting = Split(value,"$$")
	End Sub

    '读取网站频道
	Public Sub Load_Channel()
		Dim Rs,SQL
		SQL = "select ChannelID,ChannelName,ChannelDir,LinkUrl,ChannelType,OpenType,ReadMe from Cl_Channel where IsShow=True order by OrderID"
		Set Rs = Execute(SQL)
		value = Rs.GetString(,,"|||","$$$","")
		Set Rs = Nothing
	End Sub

'===============
'频道导航输出li函数  mf+20051013+
'===============
	Public Function ShowChannelMenu(sChannelID)
		if Not IsNumeric(sChannelID) then
			Exit Function
		else
			sChannelID=Cint(sChannelID)
		end if
		Name="Channel"
		If ObjIsEmpty() Then Load_Channel()
		dim sTemp,sTrRow,sTrCol,i,RowNum,sLink
		sTrRow=Split(replace(value,"{%webdir%}",WebDir),"$$$")
		RowNum=UBound(sTrRow)-1
		if sChannelID=0 then
			sTemp = "<li class=""c0_now""><a href=""" & Cl.WebDir &"Index.asp"">首页</a></li>"
		else
			sTemp = "<li class=""c0""><a href=""" & Cl.WebDir &"Index.asp"">首页</a></li>"
		end if
		For i = 1 to RowNum
			sTrCol=Split(sTrRow(i),"|||")
			'Response.write strrow(i)
				if Cint(sTrCol(4))>=2 then
					sLink=sTrCol(3)
				else
					sLink=Cl.WebDir & sTrCol(2) & "/Index.asp"
				end if
				if Cint(strcol(0))= sChannelID then
					sTemp = sTemp & "<li class='c"& Cint(Strcol(0)) &"_now'>"
				else
					sTemp = sTemp & "<li class='c"& Cint(Strcol(0)) &"'>"
				end if
				sTemp = sTemp & "<a href='" & sLink &"' title='" & sTrCol(6) & "'"  
				if Cint(sTrCol(5))=1 then
					sTemp = sTemp & " rel='newlink'>"
				else
					sTemp = sTemp & ">"
				end if
				sTemp = sTemp & sTrCol(1)&"</a>"
				sTemp = sTemp & "</li>"
			next		
		ShowChannelMenu=replace(sTemp,"'",chr(34))
	End Function
'===添加结束
	
	Public Function ShowChannel(sChannelID)
		Name="Channel"
		sChannelID=Clng(sChannelID)
		If ObjIsEmpty() Then Load_Channel()
		dim sTemp,sTrRow,sTrCol,i,RowNum,sLink
		sTrRow=Split(replace(value,"{%webdir%}",WebDir),"$$$")
		RowNum=UBound(sTrRow)-1
		sTrCol=Split(sTrRow(0),"|||")
		sTemp=""
		'if Cint(sTrCol(4))=2 or Cint(sTrCol(0))=0 then
		'	sLink=sTrCol(3)
		'else
			sLink=Cl.WebDir & "Index.asp"
		'end if
		if Cint(sTrCol(5))=1 then
			sTemp=sTemp & "<a href=""" & sLink &""" target=""_blank"" title=""" & sTrCol(6) & """"
		else
			sTemp=sTemp & "<a href=""" & sLink &""" title=""" & sTrCol(6) & """"
		end if
		if Clng(sTrCol(0))=sChannelID then
			sTemp=sTemp & " class=""nchannel"">" & sTrCol(1)& "</a>"
		else
			sTemp=sTemp & " class=""ochannel"">" & sTrCol(1)& "</a>"
		end if
		For i = 1 to RowNum
			sTrCol=Split(sTrRow(i),"|||")
			'ChannelID=0,ChannelName=1,ChannelDir=2,LinkUrl=3,ChannelType=4,OpenType=5
			sTemp=sTemp & Cl.mainhtml(15)
			if Cint(sTrCol(4))=2 then
				sLink=sTrCol(3)
			else
				sLink=Cl.WebDir & sTrCol(2) & "/Index.asp"
			end if
			if Cint(sTrCol(5))=1 then
				sTemp=sTemp & "<a href=""" & sLink &""" target=""_blank"" title=""" & sTrCol(6) & """"
			else
				sTemp=sTemp & "<a href=""" & sLink &""" title=""" & sTrCol(6) & """"
			end if
			if Clng(sTrCol(0))=sChannelID then
				sTemp=sTemp & " class=""nchannel"">" & sTrCol(1)& "</a>"
			else
				sTemp=sTemp & " class=""ochannel"">" & sTrCol(1)& "</a>"
			end if
		next
		ShowChannel=sTemp
	End Function

	Public Function GetChannelName(sChannelID)
		sChannelID = Clng(sChannelID)
		if sChannelID < 0 then
			GetChannelName = "所有频道" : Exit Function
		end if
		Name="Channel"
		If ObjIsEmpty() Then Load_Channel()
		dim sTrRow,sTrCol,i
		sTrRow=Split(value,"$$$")
		For i = 0 to UBound(sTrRow)-1
			sTrCol=Split(sTrRow(i),"|||")
			if Cint(sTrCol(0))=sChannelID then
				GetChannelName = sTrCol(1)
				Exit For
			end if
		Next
    End Function
	Public Function NoChkSqlInFiles()
		NoChkSqlInFiles=False
		if UserTrueIP="127.0.0.1" or ServerName="localhost" or Page_Admin or InStr(ScriptName,"install.asp")>0 then NoChkSqlInFiles=True : Exit Function
		If Instr(Lcase(CacheData(14,0)),ScriptName)>0 then NoChkSqlInFiles=True
	End Function 
	Public Sub ReloadSetup()
		Dim SQL,Rs
		SQL = "Select ID,Web_Info,Web_Setting,Web_StyleID,Web_CssID,Web_Version,Web_Pack,Badwords,rBadword,LockIP,Regword,UpLoad_Setting,Product_Setting,SqlInword,NoChkSqlInFiles,Web_Css from [Cl_Setup]"
		Set Rs = Execute(SQL)
		value = Rs.GetRows(1)
		Set Rs = Nothing
	End Sub
	'装载模板
	Public Sub LoadTemplates(ModuleNames)
		Dim Style_Pic,Main_Style,TempStyle,sCssTemp
		TempStyle		= Split(CacheData(15,0),"@@@")
		sCssTemp		= Split(TempStyle(1),"|||")
		If CssID>=UBound(sCssTemp) Then CssID = 0
		Web_CSS			= sCssTemp(CssID)
		Web_PicUrl		= Split(TempStyle(2),"|||")(CssID)
		Name = "StyleName" & StyleID
		If ObjIsEmpty() Then TemplatesToCache ("StyleName")
		StyleName=value
		Name = "Main_Style" & StyleID
		If ObjIsEmpty() Then TemplatesToCache ("Main_Style")
		Main_Style		= Replace(value,"{%picurl%}",WebDir&Web_PicUrl)
		Main_Style		= Replace(Main_Style,"{%webdir%}",WebDir)
		If ModuleNames<>"" Then
			Name="module_" & ModuleNames & StyleID
			If ObjIsEmpty() Then TemplatesToCache ("module_"&ModuleNames)
			Template.value = Replace(value,"{%webdir%}",WebDir)
		End If
		Main_Style		= Split(Main_Style,"@@@")
		mainhtml		= Split(Main_Style(0),"|||")
		lanstr			= Split(Main_Style(1),"|||")
		mainpic			= Split(Main_Style(2),"|||")
		mainsetting		= Split(mainhtml(0),"||")
		Web_CSS			= Replace(Web_CSS,"{%picurl%}",WebDir & Web_PicUrl)
		Web_CSS			= replace(Web_CSS,"{%webdir%}",WebDir)
		'Title			= replace(lanstr(0),"创力网站管理系统官方站",Web_Info(0))
	End Sub
	Public Sub TemplatesToCache(ModuleNames)
		Dim Rs,SQL
		SQL = "Select "&ModuleNames&" from [Cl_Style] where id = " & Clng(StyleID)
		Set Rs = Execute(SQL)
		If Not Rs.EOF Then
			value=Rs(0)&""
		Else
			Call FixSetupsid()
		End If
		Set Rs = Nothing
	End Sub
	Private Sub FixSetupsid()
		Dim Rs,SQL
		SQL = "Select Top 1 ID from [Cl_Style] Order by ID"
		Set Rs = Execute(SQL)
		If Rs.EOF Then
			Response.Write "模板数据是空的，无任何可用风格，请添加后再运行网站。"
			Response.End
		Else
			if ChannelID="" or Not IsNumeric(ChannelID) then
			Execute("Update Cl_Setup Set Web_StyleID="&Rs(0)&",Web_CssID=0")
			else
			Execute("Update Cl_Channel Set StyleID="&Rs(0)&",CssID=0 where ChannelID="&ChannelID&"")
			end if
		End If
		Set rs=Nothing 
	End Sub 
	'读取模板列表
	Public Sub ReloadTemplateslist()
		Dim Rs,SQL,tmpdata
		SQL = "Select ID,StyleName from Cl_Style"
		Set Rs = Execute(SQL)
		tmpdata = Rs.GetString(,,"|||","@@@","")
		tmpdata = Left(tmpdata,Len(tmpdata)-3)
		Set Rs = Nothing
		value=tmpdata
	End Sub
	Public Function Head()
		dim sTemp
		sTemp = mainhtml(1)
		if ChannelID>0 and ChannelID<>6 then sTemp = sTemp & vbNewLine & mainhtml(2)
		sTemp = Replace(sTemp,"{%webcss%}","<link title="""" type=""application/rss+xml"" rel=""alternate"" href=""http://"&ServerName & Cl.WebDir & "RssFeed.Asp?ChannelID={%channelid%}"" />"&VbNewline&"{%webcss%}")
		if Cl.Web_Info(15) = "1" or CreateHtmlIng=True then
			sTemp = Replace(sTemp,"{%webcss%}","<link href="""&Cl.Webdir&"Skins/Css/Css"&Cl.CssID&".Css"" rel=""stylesheet"" type=""text/css"" />")
			sTemp = Replace(sTemp,"{%showchannel%}",Cl.ShowChannel(ChannelID))
			'sTemp = Replace(sTemp,"{%showchannel%}","<script type=""text/javascript"" src="""&Cl.Webdir&"Js/ChannelMenu/ChannelMenu_"&ChannelID&".Js""></script>")
		else
			sTemp = Replace(sTemp,"{%webcss%}","<style type=""text/css"">"&VbNewline& Cl.Web_CSS & VbNewline &"</style>")
			sTemp = Replace(sTemp,"{%showchannel%}",Cl.ShowChannel(ChannelID))
		end if
        Head = sTemp
	End Function
	Public Function Bottom()
		dim sTemp,Powered
		Powered = lanstr(2) & "<a href="""&Web_Version(0)&""" target=""_blank"">"&Web_Version(1)&"</a>"
		if SysTemVersion>1 then
		sTemp=Replace(mainhtml(3),"{%powered%}","")
		else
		sTemp=Replace(mainhtml(3),"{%powered%}",Powered)
		end if
		if Web_Setting(44)="Yes" then sTemp = sTemp & VbNewLine & "<NOSCRIPT><IFRAME src='*' Width='0' Height='0'></IFRAME></NOSCRIPT>"
		Bottom = sTemp
	End Function
	Public Function GetClassMenu(sChannelID)
		GetChannelSetting(sChannelID)
		Dim sTemp, TopNum, ModNum, SettingStr
		SettingStr	= Split(Channel_Setting(25),",")
		TopNum		= Clng(SettingStr(0))
		ModNum		= Clng(SettingStr(1))
		If TopNum > 0 then
			TopNum	= "Top "&TopNum&""
		Else
			TopNum	= ""
		End if
		If ModNum = 0 then ModNum=10
		sTemp = "<!--" & vbcrlf
		sTemp = sTemp & "stm_bm(['uueoehr',400,'','"&WebDir&"images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
		sTemp = sTemp & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
		sTemp = sTemp & "stm_ai('p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','"&mainsetting(11)&"','"&mainsetting(12)&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
		sTemp = sTemp & "stm_aix('p0i1','p0i0',[0,'"&Channel_Setting(1)&"','','',-1,-1,0,'" & WebDir & Channel_Setting(4) & "','_self','" & WebDir & Channel_Setting(4) & "','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','"&mainsetting(11)&"','"&mainsetting(12)&"','9pt 宋体','9pt 宋体']);" & vbcrlf
		sTemp = sTemp & "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','"&mainsetting(11)&"','"&mainsetting(12)&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
		dim SQL,Rs,j
		SQL="Select "&TopNum&" ClassID,ClassName,ParentPath,ClassDir,ParentDir,Depth,NextID,Child,Readme,IsOuter,LinkUrl From Cl_Class where ChannelID="&Cint(sChannelID)&" and Depth=0 and ShowOnTop=True order by RootID"
		Set rs = Execute(SQL)
		if Not (Rs.bof and Rs.eof) then
			SQL = Rs.GetRows(-1)
			pNum = 1 : pNum2 = 0
			For j=0 to Ubound(SQL,2)
				if (j+1) mod ModNum=0 then
					sTemp = sTemp & "stm_em();" & vbcrlf
					sTemp = sTemp & "//-->" & vbcrlf
					sTemp = sTemp & "<!--" & vbcrlf
					sTemp = sTemp & "stm_bm(['uueoehr',400,'','"&WebDir&"images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
					sTemp = sTemp & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
					sTemp = sTemp & "stm_ai('p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','"&mainsetting(11)&"','"&mainsetting(12)&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
				end if
				if SQL(9,j)=1 then
					sTemp = sTemp & "stm_aix('p0i"&j&"','p0i0',[0,'" & SQL(1,j) & "','','',-1,-1,0,'" & SQL(10,j) & "','_blank','" & SQL(10,j) & "','" & SQL(8,j) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','"&mainsetting(11)&"','"&mainsetting(12)&"','9pt 宋体','9pt 宋体']);" & vbcrlf
				else
					sTemp = sTemp & "stm_aix('p0i"&j&"','p0i0',[0,'" & SQL(1,j) & "','','',-1,-1,0,'" & WebDir & GetClassUrl(Channel_Setting(11),HtmlDir,Channel_Setting(4),SQL(2,j),SQL(0,j),SQL(4,j),SQL(3,j),Channel_Setting(10),Channel_Setting(13)) & "','_self','" & WebDir & GetClassUrl(Channel_Setting(11),HtmlDir,Channel_Setting(4),SQL(2,j),SQL(0,j),SQL(4,j),SQL(3,j),Channel_Setting(10),Channel_Setting(13)) & "','" & SQL(8,j) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#ffffff','#ff0000','"&mainsetting(11)&"','"&mainsetting(12)&"','9pt 宋体','9pt 宋体']);" & vbcrlf
				end if
				if SQL(7,j)>0 and Clng(SettingStr(2))=1 then
					sTemp = sTemp & GetChildMenu(SQL(0,j),0,sChannelID)
				end if
				sTemp = sTemp & "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','"&mainsetting(11)&"','"&mainsetting(12)&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
			Next
			SQL=Empty
		end if
		Rs.Close : Set Rs=Nothing
		sTemp = sTemp & "stm_em();" & vbcrlf
		GetClassMenu = ReplaceDir(sTemp) & "//-->"
		sTemp=Empty
	End Function
	Public Function GetChildMenu(ID,ShowType,sChannelID)
		dim SQL,Rs,k,sTemp
		if pNum=1 then
			sTemp = "stm_bp('p" & pNum & "',[1,4,0,0,2,3,6,7,100,'progid:DXImageTransform.Microsoft.Fade(overlap=.5,enabled=0,Duration=0.43)',-2,'',-2,67,2,3,'#999999','#ffffff','',3,1,1,'#aca899']);" & vbcrlf
		else
			if ShowType=0 then
				sTemp = "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,4,0,0,2,3,6]);" & vbcrlf
			else
				sTemp = "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,2,-2,-3,2,3,0]);" & vbcrlf
			end if
		end if
		SQL="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,Depth,NextID,Child,Readme,IsOuter,LinkUrl From Cl_Class where ChannelID="&Cint(sChannelID)&" and ParentID=" & ID & " and ShowOnTop=True order by OrderID asc"
		Set Rs = Execute(SQL)
		if Not (Rs.Bof and Rs.Eof) THen
			SQL = Rs.GetRows(-1)
			For k=0 to Ubound(SQL,2)
				if SQL(9,k)=1 then
					if SQL(7,k) > 0 then
					sTemp = sTemp & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & SQL(1,k) & "','','',-1,-1,0,'" & SQL(10,k) & "','_blank','" & SQL(10,k) & "','" & SQL(8,k) & "','','',6,0,0,'"&WebDir&"images/arrow_r.gif','"&WebDir&"images/arrow_w.gif',7,7,0,0,1,'#ffffff',0,'#cccccc',0,'','',3,3,0,0,'#fffff7','#000000','#000000','#ffffff','9pt 宋体']);" & vbcrlf
					pNum=pNum+1 : pNum2=pNum2+1
					sTemp = sTemp & GetChildMenu(SQL(0,k),1,sChannelID)
					else
					sTemp = sTemp & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & SQL(1,k) & "','','',-1,-1,0,'" & SQL(10,k) & "','_blank','" & SQL(10,k) & "','" & SQL(8,k) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbcrlf
					end if
				else
					if SQL(7,k) > 0 then
					sTemp = sTemp & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & SQL(1,k) & "','','',-1,-1,0,'" & WebDir & GetClassUrl(Channel_Setting(11),HtmlDir,Channel_Setting(4),SQL(2,k),SQL(0,k),SQL(4,k),SQL(3,k),Channel_Setting(10),Channel_Setting(13)) & "','_self','" & WebDir & GetClassUrl(Channel_Setting(11),HtmlDir,Channel_Setting(4),SQL(2,k),SQL(0,k),SQL(4,k),SQL(3,k),Channel_Setting(10),Channel_Setting(13)) & "','" & SQL(8,k) & "','','',6,0,0,'"&WebDir&"images/arrow_r.gif','"&WebDir&"images/arrow_w.gif',7,7,0,0,1,'#ffffff',0,'#cccccc',0,'','',3,3,0,0,'#fffff7','#000000','#000000','#ffffff','9pt 宋体']);" & vbcrlf
					pNum=pNum+1 : pNum2=pNum2+1
					sTemp = sTemp & GetChildMenu(SQL(0,k),1,sChannelID)
					else
					sTemp = sTemp & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & SQL(1,k) & "','','',-1,-1,0,'" & WebDir & GetClassUrl(Channel_Setting(11),HtmlDir,Channel_Setting(4),SQL(2,k),SQL(0,k),SQL(4,k),SQL(3,k),Channel_Setting(10),Channel_Setting(13)) & "','_self','" & WebDir & GetClassUrl(Channel_Setting(11),HtmlDir,Channel_Setting(4),SQL(2,k),SQL(0,k),SQL(4,k),SQL(3,k),Channel_Setting(10),Channel_Setting(13)) & "','" & SQL(8,k) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbcrlf
					end if
				end if
			Next
			SQL=Empty
		End if
		Rs.Close : Set Rs=Nothing
		GetChildMenu = sTemp & "stm_ep();" & vbcrlf
		sTemp=Empty
	End Function
	Public Function ShowUserLogin(Byval sType)
		dim sTemp,sTemp2
		if sType="1" then
		sTemp2=Split(Cl.mainhtml(5),"||")
		else
		sTemp2=Array(mainhtml(4),mainhtml(6),mainhtml(7), _
		mainhtml(8),mainhtml(9),mainhtml(13))
		end if
		if UserID=0 Or UserLevel=5 then
			sTemp=Replace(sTemp2(0),"{%webname%}",Web_Info(0))
			if Cl.Web_Setting(39)="Yes" then
				sTemp=Replace(sTemp,"{%getcode%}",Replace(sTemp2(5),"{%getcode%}",Cl.GetCode("GetCode")))
			else
				sTemp=Replace(sTemp,"{%getcode%}","")
			end if
		Else
			if Cint(User_Info(21))=1 then
				sTemp=Replace(sTemp2(2),"{%webname%}",Web_Info(0))
			else
				sTemp=Replace(sTemp2(1),"{%webname%}",Web_Info(0))
			end if
			if Cint(User_Info(24))=1 then
				sTemp=Replace(sTemp,"{%userinfo%}",sTemp2(3))
				if clng(User_Info(22))>10 then
					sTemp=Replace(sTemp,"{%color2%}",mainsetting(3))
				else
					sTemp=Replace(sTemp,"{%color2%}",mainsetting(4))
				end if
			else
				sTemp=Replace(sTemp,"{%userinfo%}",sTemp2(4))
				if clng(User_Info(40))>10 then
					sTemp=Replace(sTemp,"{%color3%}",mainsetting(5))
				else
					sTemp=Replace(sTemp,"{%color3%}",mainsetting(6))
				end if
			end if
			if Cint(SendMsgNum)>0 and Web_Setting(36)="Yes" then
				sTemp=sTemp & vbNewLine & mainhtml(10)
				sTemp=Replace(sTemp,"{%inceptid(1)%}",SendMsgID)
				sTemp=Replace(sTemp,"{%inceptid(2)%}","")
				sTemp=Replace(sTemp,"{%newincept%}","<font color="""&mainsetting(9)&""">"&SendMsgNum&"</font>")
			else
				sTemp=Replace(sTemp,"{%newincept%}","<font color="""&mainsetting(10)&""">"&SendMsgNum&"</font>")
			end if
			sTemp=Replace(sTemp,"{%username%}",User_Info(5))
			sTemp=Replace(sTemp,"{%userpoint%}",User_Info(22))
			sTemp=Replace(sTemp,"{%usermoney%}",User_Info(23))
			sTemp=Replace(sTemp,"{%moneyitemname%}",Cl.Web_Setting(26))
			sTemp=Replace(sTemp,"{%moneyitemunit%}",Cl.Web_Setting(27))
			sTemp=Replace(sTemp,"{%pointitemname%}",Cl.Web_Setting(28))
			sTemp=Replace(sTemp,"{%pointitemunit%}",Cl.Web_Setting(29))
			sTemp=Replace(sTemp,"{%userlevel%}",User_Info(31))
			sTemp=Replace(sTemp,"{%uservalidday%}",User_Info(40))
			sTemp=Replace(sTemp,"{%color1%}",mainsetting(2))
			if clng(User_Info(23))>10 then
				sTemp=Replace(sTemp,"{%color4%}",mainsetting(7))
			else
				sTemp=Replace(sTemp,"{%color4%}",mainsetting(8))
			end if
		end if
		ShowUserLogin=sTemp
		sTemp=Empty : sTemp2=Empty
    End Function

	Public Function newincept(sName)
		'if UserTableType="Dvbbs" then
			newincept=Cl.Execute_U("Select Count(id) From " & Db.MessageTable & " Where flag=0 and issend=1 and delR=0 And incept='"&sName&"'")(0)
		'else
		'	newincept=Cl.Execute("Select Count(id) From " & Db.MessageTable & " Where flag=0 and issend=1 and delR=0 And incept='"&sName&"'")(0)
		'end if
		if Isnull(newincept) or Not IsNumeric(newincept) then newincept=0
	End function
 	'更新用户短信通知信息（新短信条数||新短讯ID||发信人名）
	Public Sub Update_User_Msg(sName)
		Dim msginfo,sMewMsgN,UP_UserInfo
		sMewMsgN=newincept(sName)
		If sMewMsgN>0 Then
			msginfo=sMewMsgN & "||" & inceptid(1,sName) & "||" & inceptid(2,sName)
		Else
			msginfo="0||0||null"
		End If
		Cl.Execute_U("Update " & Db.UserTable & " Set " & Db.UserMsg & "='"&Cl.CheckStr(msginfo)&"' Where " & Db.UserName & "='"&Cl.CheckStr(sName)&"'")
		If Trim(sName)=Trim(Cl.User_Info(5)) Then
			UP_UserInfo=Session(CacheName & "UserID")
			UP_UserInfo(30)=msginfo
			Session(CacheName & "UserID")=UP_UserInfo
		Else
			Call NeedUpdateList(sName,1)
		End If
	End Sub
	Public Function inceptid(stype,iusername)
		Dim Rs
		Set Rs=Cl.Execute_U("Select top 1 id,sender From " & Db.MessageTable & " Where flag=0 And issend=1 And DelR=0 And incept='"& iusername &"'")
		If not rs.eof Then
			If stype=1 Then
				inceptid=Rs(0)
			Else
				inceptid=Rs(1)
			End If
		Else
			If stype=1 Then
				inceptid=0
			Else
				inceptid="null"
			End If
		End If
		Rs.Close : Set Rs=Nothing
	End Function
	Public Function Execute(Command)
		If Not IsObject(Conn) Then OpenConn
		On Error Resume Next
		Set Execute = Conn.Execute(Command)
		If Err Then
			Conn.Close : Set Conn = Nothing
			Response.Write "执行查询代码时发现错误，请检查您的查询代码是否正确。" & Err.Description &"<br />" & Command
			err.Clear
			Response.End
		End If
		SqlQueryNum=SqlQueryNum+1
	End Function
	Public Function Execute_U(Command)
		If Not IsObject(Conn_U) Then OpenConn_U
		On Error Resume Next
		Set Execute_U = Conn_U.Execute(Command)
		If Err Then
			err.Clear
			Conn_U.Close : Set Conn_U = Nothing
			Response.Write "执行查询代码时发现错误，请检查您的查询代码是否正确。" & Err.Description &"<br />" & Command
			Response.End
		End If
		SqlQueryNum=SqlQueryNum+1
	End Function
	Public Function Execute_L(Command)
		If Not IsObject(Conn_L) Then OpenConn_L
		On Error Resume Next
		Set Execute_L = Conn_L.Execute(Command)
		If Err Then
			err.Clear
			Conn_L.Close : Set Conn_L = Nothing
			Response.Write "执行查询代码时发现错误，请检查您的查询代码是否正确。" & Err.Description &"<br />" & Command
			Response.End
		End If
		SqlQueryNum=SqlQueryNum+1
	End Function
	'记录错误事件
	Public Sub SaveSQLLOG(sSqlType,sCommand)
		Dim StrType,sTemp,strErrNum
		strErrNum=Request.Cookies("SqlErrNum")
		if Not IsNumeric(strErrNum) then
			strErrNum=1
		else
			strErrNum=Clng(strErrNum)+1
		end if
		if strErrNum >= 3 then
			Dim strip
			strip=cstr(UserTrueIP)
			If strip<>"" Then
				If Trim(CacheData(9,0))<>"" Then
					CacheData(9,0)=Replace(Trim(CacheData(9,0)),strip,"")
					CacheData(9,0)=Replace(CacheData(9,0),"||","|")
					strip=CacheData(9,0) & "|" & Replace(strip,"|","")
				End If
			End If
			if strip<>"" and strErrNum<5 then
				Execute("update Cl_Setup set LockIP='"&replace(strip,"'","''")&"'")
				Name="setup"
				reloadsetup
			end if
			Response.Cookies("SqlErrNum")=5
			Response.write "您执行了非法操作次数已经超过3次，IP已封！"
			Response.write "<meta HTTP-EQUIV=REFRESH CONTENT=""2; URL="&Request.ServerVariables("Script_Name")&""" />"
			Response.end
		end if
		Response.Cookies("SqlErrNum")=strErrNum
		Select Case Cint(sSqlType)
		Case 2 : StrType="SQL注入（POST）"
		Case 3 : StrType="SQL注入（GET）"
		Case Else : StrType="非法查询管理员表"
		End Select
		Cl.Execute_L("insert into [Cl_SqlLog] (ScriptName,S_Info,ip,Type) values ('"&Request.ServerVariables("PATH_INFO")&"','"&Checkstr(Left(sCommand,250))&"','"&UserTrueIP&"','"&StrType&"')")
		sTemp="您执行了非法操作，操作已被禁止并作了如下记录↓<br />"
		sTemp=sTemp & "操作ＩＰ："&UserTrueIP&"<br />"
		sTemp=sTemp & "操作时间："&Now&"<br />"
		sTemp=sTemp & "操作页面："&Request.ServerVariables("PATH_INFO")&"<br />"
		sTemp=sTemp & "操作方式："&StrType&"<br />"
		sTemp=sTemp & "提交数据："&sCommand
		Response.write sTemp
		Response.end
	End Sub
    '过滤非法的SQL字符
	Public Function ReplaceBadChar(Byval strChar)
		strChar=replace(replace(strChar," ",""),"'","")
		strChar=replace(replace(strChar,".",""),"<","")
		strChar=replace(replace(strChar,")",""),"(","")
		strChar=replace(replace(strChar,"?",""),"*","")
		strChar=replace(replace(strChar,"/",""),"\","")
		ReplaceBadChar=replace(strChar,Chr(0),"")
	End Function
	Public Function ChkBadWords(Byval Str)
		If IsNull(Str) Then Exit Function
		Dim i
		For i = 0 To Ubound(BadWords)
			If i > UBound(rBadWord) Then
				Str = Replace(Str,BadWords(i),"*")
			Else
				Str = Replace(Str,BadWords(i),rBadWord(i))
			End If
		Next
		ChkBadWords = Str
	End Function
    '求字符串长度。汉字算两个字符，英文算一个字符。
	Public Function strLength(Byval str)
		If isNull(str) Or Str = "" Then
			StrLength = 0:Exit Function
		End If
		Dim WINNT_CHINESE
		WINNT_CHINESE=(len("例子")=2)
		If WINNT_CHINESE Then
			Dim l,t,c,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
			Next
			strLength=t
		Else
			strLength=len(str)
		End If
	End Function
	Public Function Checkstr(Byval Str)
		If Isnull(Str) Then
			CheckStr = ""
			Exit Function 
		End If
		Str = Replace(Str,Chr(0),"")
		CheckStr = Replace(Str,"'","''")
	End Function
    '截字符串，汉字一个算两个字符，英文算一个字符（str）原字符串 （strlen）截取长度
	Public Function GotTopic(Byval str,Byval strlen)
		dim l, t, c, i
		if str="" then gotTopic="" : Exit function
		str		= replace(replace(str,"&nbsp;"," "),"&quot;",chr(34))
		str		= replace(replace(str,"&gt;",">"),"&lt;","<")
		l		= len(str) : t		= 0
		strlen	= Clng(strlen)
		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
				'if Abs(Asc(right(str,1)))>255 then
				gotTopic=left(str,i) & "..."
				exit for
			else
				gotTopic=str
			end if
		next
	End Function
	Public Function FormatNum(Byval num,Byval n)
		If Not IsNumeric(num) or num="" Then num=0
		If num<1 and num>0 Then
			FormatNum = Cdbl("0" & FormatNumber(num,n))
		Else
			FormatNum = Cdbl(FormatNumber(num,n))
		End If
	End Function
	'时间格式处理
	Public Function Format_Time(Byval Tvar,Byval sType)
        dim Tt,sYear,sMonth,sDay,sHour,sMinute,sSecond
        If Not IsDate(Tvar) or sType=0 Then Format_Time = "" : Exit Function
        Tt			= Tvar
        sYear		= Year(Tt)
        sMonth		= Right("0" & Month(Tt),2)
		sDay		= Right("0" & Day(Tt),2)
		sHour		= Right("0" & Hour(Tt),2)
		sMinute		= Right("0" & Minute(Tt),2)
		sSecond		= Right("0" & Second(Tt),2)
        Select Case sType
        Case 1	'2005-10-01 23:45:45
			Format_Time = sYear & "-" & sMonth & "-" & sDay & " " & sHour & ":" & sMinute & ":" & sSecond
        Case 2	'年-月-日 时:分:秒
			Format_Time = sYear & "年" & sMonth & "月" & sDay & "日 " & sHour & "时" & sMinute & "分" & sSecond & "秒"
        Case 3	'2005-10-01
			Format_Time = sYear & "-" & sMonth & "-" & sDay
        Case 4	'2005\10\01
			Format_Time = sYear & "\" & sMonth & "\" & sDay
        Case 5	'10-01 23:45
			Format_Time = sMonth & "-" & sDay & " " & sHour & ":" & sMinute
        Case 6	'2005年10月01日
			Format_Time = sYear & "年" & sMonth & "月" & sDay & "日"
        Case 7	'10-01
			Format_Time = sMonth & "-" & sDay
        Case 8	'20051001234545
			Format_Time = sYear & sMonth & sDay & sHour & sMinute & sSecond
        Case Else
			Format_Time = Tt
        End Select
    End Function

	Public Function GetTitleFont(Byval sValue,Byval sType)
		Select Case ChkClng(sType)
		Case 0 : GetTitleFont = sValue
		Case 1 : GetTitleFont = "<strong>" & sValue & "</strong>"
		Case 2 : GetTitleFont = "<em>" & sValue & "</em>"
		Case 3 : GetTitleFont = "<strong><em>" & sValue & "</em></strong>"
		Case 4 : GetTitleFont = "<u>" & sValue & "</u>"
		Case 5 : GetTitleFont = "<strong><u>" & sValue & "</u></strong>"
		Case 6 : GetTitleFont = "<em><u>" & sValue & "</u></em>"
		Case 7 : GetTitleFont = "<strong><em><u>" & sValue & "</u></em></strong>"
		Case Else : GetTitleFont = sValue
		End Select
	End Function

	Public Function FormatColor(Byval sValue,Byval sColor)
		sColor=Trim(sColor)
		if Isnull(sColor) or sColor="" then FormatColor=sValue : Exit Function
		FormatColor = "<font color="""& sColor &""">" & sValue & "</font>"
	End Function

	'写入客人session
	Public Sub LetGuestSession()
		Dim statID,GuestSID
		GuestSID = checkStr(Trim(Request.Cookies(Web_Cookies)("GuestSID")))
		If Not IsNumeric(GuestSID) or GuestSID = "" Then
			statID = Split(UserTrueIP,".")
			GuestSID = ""
			for i=0 to Ubound(statID)
				GuestSID=GuestSID&right("00"&statID(i),3)
			next
			randomize
			GuestSID=GuestSID&int(600*rnd+369)
			If Not IsNumeric(GuestSID) Then GuestSID = int(10089657999*rnd+25789657939)
			'GuestSID = Ccur(GuestSID) & int(600*rnd+369) '随机验证码
		End If
		GuestSID = Ccur(GuestSID)
		Response.Cookies(Web_Cookies).Expires=DateAdd("s",3600,Now())
		Response.Cookies(Web_Cookies)("GuestSID") = GuestSID
		'客人=SessionID+活动时间+IP
		GuestSID = GuestSID & "_" & Now & "_" & Now & "_" & ScriptName
		User_Info=Split(GuestSID,"_")
		Session(CacheName & "UserID") = User_Info
	End Sub 
    '检查用户是否登录
	Public Function ChkUserLogin()
		Dim NeedToUpdate,ToUpdate,sUserMsg
		ChkUserLogin=False
		if UserID=0 Or UserLevel=5 or MemberName="" or MemberWord="" then
			UserLevel=5 : UserID=0
			If Not IsArray(Session(CacheName & "UserID")) Then Call LetGuestSession()
			Exit Function
		end if
		ToUpdate=False
		Name="NeedToUpdate"
		If Not ObjIsEmpty() Then 
			NeedToUpdate=","&Value&","
			If InStr(NeedToUpdate,","&MemberName&",")>0 Then
				Call NeedUpdateList(MemberName,0)
				ToUpdate=True
			End If
		End If
		If Not IsArray(Session(CacheName & "UserID")) or Toupdate Then
			GetCacheUserInfo
			if Ubound(User_Info)<39 then Exit Function
		else
			User_Info = Session(CacheName & "UserID")
			if Ubound(User_Info)<39 then
				GetCacheUserInfo
				if Ubound(User_Info)<39 then Exit Function
			end if
		end if
		UserID		= Clng(User_Info(4))
		UserLevel	= Clng(User_Info(21))
		User_IM		= Split(User_Info(13),"|||")
		sUserMsg	= Split(User_Info(30),"||")
		User_Purview= Split(User_Info(34),",")
		If Ubound(sUserMsg)=2 Then
			SendMsgNum	= sUserMsg(0)
			SendMsgID	= sUserMsg(1)
			SendMsgUser	= sUserMsg(2)
		End If
		ChkUserLogin=True
	End Function

	Public Sub GetCacheUserInfo()
		dim RsLogin,SqlLogin,RsGroup,sUserInfo,sValidDays,i
       	SqlLogin="Select " & Db.UserID & "," & Db.UserName & "," & Db.UserPassWord & ","&Db.UserReName&"," & Db.UserEmail & "," & Db.UserSex & "," & Db.UserFace & "," & Db.UserFaceWidth & "," & Db.UserFaceHeight & "," & Db.UserIM & "," & Db.UserJoinDate & "," & Db.UserLastLogin & "," & Db.UserLogins & "," & Db.UserQuestion & "," & Db.UserAnswer & "," & Db.UserLastIP & "," & Db.UserDataNum & "," & Db.UserLevel & "," & Db.UserPoint & "," & Db.UserMoney & "," & Db.ChargeType & "," & Db.BeginDate & "," & Db.ValidNum & "," & Db.UserTPassWord & "," & Db.WaitReceive & "," & Db.Received & "," & Db.UserMsg & "," & Db.UserLock & " From " & Db.UserTable & " where " & Db.UserID & "=" & UserID
		Set RsLogin=Execute_U(sqlLogin)
		if RsLogin.bof and RsLogin.eof then
			UserLevel=5 : UserID=0 : EmptyCookies : LetGuestSession
			RsLogin.Close : Set RsLogin = Nothing : Exit Sub
		else
			if UserLevel<>rsLogin(17) or RsLogin(27)<>0 or MemberName<>rsLogin(1) or MemberWord<>rsLogin(2) then
				UserLevel=5 : UserID=0 : EmptyCookies : LetGuestSession
				RsLogin.Close : Set RsLogin = Nothing : Exit Sub
			end if
			Set RsGroup=Cl.Execute("Select GroupName,GroupImg,LoginPoint,Purview,Purview_Other,arrClassView,arrClassInput,arrClassCheck,arrClassMaster From Cl_UserGroup Where ID="&UserLevel&"")
			if RsGroup.Bof and RsGroup.Eof then
				UserLevel=5 : UserID=0 : EmptyCookies : LetGuestSession
				RsLogin.Close : Set RsLogin = Nothing
				RsGroup.Close : Set RsGroup = Nothing : Exit Sub
			End if
		  	sValidDays	= rsLogin(22)-DateDiff("D",RsLogin(21),now())
			if sValidDays<0 then sValidDays=0
			sUserInfo	= "ClCMS@@@"& Now & "@@@" & Now & "@@@" & ScriptName
			For i=0 to 26
			sUserInfo	= sUserInfo & "@@@" & RsLogin(i)
			Next
			For i=0 to 8
			sUserInfo	= sUserInfo & "@@@" & RsGroup(i)
			Next
			sUserInfo	= sUserInfo & "@@@" & sValidDays & "@@@ClCMS"
			User_Info	= Split(sUserInfo,"@@@")
			Session(CacheName & "UserID") = User_Info
			RsGroup.Close : Set RsGroup = Nothing
		End if
		RsLogin.Close : Set RsLogin = Nothing
	End Sub
    '检查管理员是否登录
	Public Function ChkAdminLogin()
		ChkAdminLogin=False
		if Not ChkUserLogin then Exit Function
		Admin_Info = Session(CacheName & "AdminInfo")
		if Not IsArray(Admin_Info) then
			Dim AdminName,AdminPass,AddUser,rsGetAdmin
			AdminName	= Trim(Checkstr(session("AdminName")))
			AdminPass	= Trim(Checkstr(session("AdminPass")))
			AddUser		= Trim(User_Info(5))
			if AdminName="" or AdminPass="" or AddUser="" then Exit Function
			'0(ID),1(用户),2(密码),3(权限),4(前台用户) 
			Set rsGetAdmin=Execute("select ID,UserName,Password,Purview,Purview_Other,arrClassMaster,arrClassCheck,arrClassInput,AddUser from Cl_Admin where UserName='" & AdminName & "' And AddUser='"&AddUser&"'")
			if rsGetAdmin.bof and rsGetAdmin.eof then
				Set rsGetAdmin=Nothing : Exit Function
			ElseIf rsGetAdmin(2) <> AdminPass then
				Set rsGetAdmin=Nothing : Exit Function
			End if
			Admin_Info = Split(rsGetAdmin.GetString(,1, "@@","",""),"@@")
			Set rsGetAdmin = Nothing
			Session(CacheName & "AdminInfo") = Admin_Info
		ElseIF Ubound(Admin_Info)<8 then
			Session(CacheName & "AdminInfo") = Empty
			ChkAdminLogin = False : Exit Function
		End if
		Admin_Purview			= Split(Admin_Info(3),",")
		ChkAdminLogin			= True
	End Function
	Public Function ChkSchoolUser()
		Dim rs_IP, sqlIP
		Dim sPurview, sarrClassID, sBeginDate, sUseDayNum, sIsClose, sIsLogin
		Dim C_sValidDays
		ChkSchoolUser=0
		set rs_IP = Cl.Execute("select SchoolIP,SchoolName,Purview,arrClassID,BeginDate,UseDayNum,IsClose,IsLogin from [Cl_SchoolIP] Where SchoolIP='"&Cl.UserTrueIP&"'")
		if rs_IP.Bof and rs_IP.Eof then
			rs_IP.close:set rs_IP=nothing : Exit Function
		end if
		sPurview	= rs_IP(2) : sarrClassID = rs_IP(3)
		sBeginDate	= rs_IP(4) : sUseDayNum  = rs_IP(5)
		sIsClose	= rs_IP(6) : sIsLogin	 = rs_IP(7)
		rs_IP.close : set rs_IP=nothing
		if sIsClose=True then Exit Function
		if sIsLogin=True and Not Cl.ChkUserLogin then Exit Function
		C_sValidDays=Clng(sUseDayNum - datediff("d",sBeginDate,now))
		if C_sValidDays <= 0 then
			Cl.Execute("Update Cl_SchoolIP Set IsClose=True Where SchoolIP='"&Cl.UserTrueIP&"'")
			Exit Function
		end if
		if sPurview=1 then
			ChkSchoolUser=True
		else
			Dim Prs,sPPath,n
			Set Prs=Cl.Execute("Select ParentPath From Cl_Class Where ClassID=" & Clng(sClassID))
			If Not (Prs.Bof And Prs.Eof) then
				sPPath=Split(Prs(0) & "," & sClassID,",")
				For n=1 to Ubound(sPPath)
					If Instr(","&sarrClassID&",",","&sPPath(n)&",")>0 then
						IsSchoolUser=True
						Exit For
					End if
					if n>=20 then Exit For '防止进入死循环
				Next
			End if
			Set Prs=Nothing
		end if
	End Function
	Public Function IsTrueSchoolUser(Byval sClassID)
		Dim rs_IP, sqlIP
		Dim sPurview, sarrClassID, sBeginDate, sUseDayNum, sIsClose, sIsLogin
		Dim C_sValidDays
		IsSchoolUser=False
		set rs_IP = Cl.Execute("select SchoolIP,SchoolName,Purview,arrClassID,BeginDate,UseDayNum,IsClose,IsLogin from [Cl_SchoolIP] Where SchoolIP='"&Cl.UserTrueIP&"'")
		if rs_IP.Bof and rs_IP.Eof then
			rs_IP.close:set rs_IP=nothing : Exit Function
		end if
		sPurview	= rs_IP(2) : sarrClassID = rs_IP(3)
		sBeginDate	= rs_IP(4) : sUseDayNum  = rs_IP(5)
		sIsClose	= rs_IP(6) : sIsLogin	 = rs_IP(7)
		rs_IP.close : set rs_IP=nothing
		if sIsClose=True then Exit Function
		if sIsLogin=True and Not Cl.ChkUserLogin then Exit Function
		C_sValidDays=Clng(sUseDayNum - datediff("d",sBeginDate,now))
		if C_sValidDays <= 0 then
			Cl.Execute("Update Cl_SchoolIP Set IsClose=True Where SchoolIP='"&Cl.UserTrueIP&"'")
			Exit Function
		end if
		if sPurview=1 then
			IsSchoolUser=True
		else
			Dim Prs,sPPath,n
			Set Prs=Cl.Execute("Select ParentPath From Cl_Class Where ClassID=" & Clng(sClassID))
			If Not (Prs.Bof And Prs.Eof) then
				sPPath=Split(Prs(0) & "," & sClassID,",")
				For n=1 to Ubound(sPPath)
					If Instr(","&sarrClassID&",",","&sPPath(n)&",")>0 then
						IsSchoolUser=True
						Exit For
					End if
					if n>=20 then Exit For '防止进入死循环
				Next
			End if
			Set Prs=Nothing
		end if
	End Function
	Public Function GetCookies(sName)
		GetCookies=Trim(Request.Cookies(Web_Cookies)(sName))
	End Function
	Public Sub SetCookies(sName,sValue)
		Response.Cookies(Web_Cookies)(sName)=Trim(sValue)
	End Sub
	Public Sub EmptyCookies()
		Response.Cookies(Web_Cookies)("UserID")			= Empty
		Response.Cookies(Web_Cookies)("UserName")		= Empty
		Response.Cookies(Web_Cookies)("Password")		= Empty
		Response.Cookies(Web_Cookies)("UserLevel")		= Empty
		Response.Cookies(Web_Cookies)("TruePassWord")	= Empty
		Response.Cookies(Web_Cookies & "Kill")("kill")	= Empty
		Response.Cookies(Web_Cookies)					= Empty
		Session(CacheName & "UserID")					= Empty
	End Sub
	'更新验证码
	Public Sub SetTruePassWord(UserIDStr)
		if isnull(UserIDStr) or not isnumeric(UserIDStr) then Exit Sub
		Dim NewTruePassWord
		NewTruePassWord=Createpass(16)
		Response.Cookies(Web_Cookies)("TruePassWord")=NewTruePassWord
		if Checkstr(Trim(Request.Cookies(Web_Cookies)("TruePassWord")))=NewTruePassWord then
			Execute_U("Update "&Db.UserTable&" Set " & Db.UserTPassWord & "='"&NewTruePassWord&"' where UserID="&Clng(UserIDStr))
			User_Info = Session(CacheName & "UserID")
			User_Info(27)=NewTruePassWord
			Session(CacheName & "UserID")=User_Info
		end if
	End Sub
	'更新用户资料
	Public Sub NewUserInfo(Number,strData)
		if not isnumeric(Number) then Exit Sub
		Dim str_Info
		str_Info=Session(CacheName & "UserID")
		If Not IsArray(str_Info) Then Exit Sub
		if Ubound(str_Info)<28 then Exit Sub
		str_Info(Cint(Number))=Trim(strData)
		Session(CacheName & "UserID")=str_Info
	End Sub
	Public Sub NeedUpdateList(username,act)
		Dim Tmpstr,TmpUsername
		Name="NeedToUpdate"
		If ObjIsEmpty() Then Value=""
		Tmpstr=Value
		TmpUsername=","&username&","
		Tmpstr=Replace(Tmpstr,TmpUsername,",")
		Tmpstr=Replace(Tmpstr,",,",",")
		IF act=1 Then 
			'If IsONline(username,0) Then
				If Tmpstr="" Then
					Tmpstr=TmpUsername
				Else
					Tmpstr=Tmpstr&TmpUsername
				End If
			'End If
		End If
		Tmpstr=Replace(Tmpstr,",,",",")
		Value=Tmpstr
	End Sub
	'系统分配随机密码
	Public Function Createpass(Byval LengthNum)
		Dim Ran,i
		if Not IsNumeric(LengthNum) then LengthNum=16
		Createpass=""
		For i=1 To LengthNum
			Randomize
			Ran = CInt(Rnd * 2)
			Randomize
			Select Case Ran
			Case 0
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& UCase(Chr(Ran))
			Case 1
				Ran = CInt(Rnd * 9)
				Createpass = Createpass & Ran
			Case 2
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& Chr(Ran)
			End Select
		Next
	End Function
	Public Function GetUserSex(strSex)
		'if UserTableType = "Bbsxp" then
		'	if strSex="male" then
		'		GetUserSex="男"
		'	else
		'		GetUserSex="女"
		'	end if
		'else
		Select Case ChkClng(strSex)
		Case 0 : GetUserSex="女"
		Case 1 : GetUserSex="男"
		Case Else : GetUserSex="保密"
		End Select
		'end if
	End Function
	Public Function GetPaymentName(Byval str)
		Select Case ChkClng(str)
		Case 0 : GetPaymentName="账户支付"
		Case 1 : GetPaymentName="在线支付"
		Case 2 : GetPaymentName="银行汇款"
		Case 3 : GetPaymentName="邮政汇款"
		Case Else : GetPaymentName="其它支付"
		End Select
	End Function
    '检查用户权限
	Public Function ChkUserLevel(Byval sPurview,Byval sLevel)
		ChkUserLevel=False
		if Instr(","&sPurview&",",",5,")>0 then
			ChkUserLevel=True : Exit Function
		end if
		if Instr(","&sPurview&",",","&sLevel&",")>0 then ChkUserLevel=True
	End Function
	'======================================================
	'sPurview-----1(Master),2(Check),3(Input)
	'======================================================
	Public Function TrueChannelPurview(Byval sPurview,Byval sChannelID)
		TrueChannelPurview = True
		If Cint(Cl.Admin_Purview(0)) = 1 Then Exit Function
		If Not IsNumeric(sPurview) or Not IsNumeric(sChannelID) then
			TrueChannelPurview = False : Exit Function
		end if
		If Ubound(Cl.Admin_Purview) < sChannelID Then
			TrueChannelPurview = False : Exit Function
		Else
			if Cint(Cl.Admin_Purview(sChannelID)) <= sPurview Then Exit Function
		End if
		TrueChannelPurview = False
	End Function
	Public Function TrueClassPurview(Byval sPurview,Byval sChannelID,Byval sClassID)
		TrueClassPurview = True
		If Cint(Cl.Admin_Purview(0)) = 1 Then Exit Function
		If Not IsNumeric(sPurview) or Not IsNumeric(sChannelID) or Not IsNumeric(sClassID) then
			TrueClassPurview = False : Exit Function
		end if
		If Ubound(Cl.Admin_Purview) < sChannelID Then
			TrueClassPurview = False : Exit Function
		Else
			if Cint(Cl.Admin_Purview(sChannelID)) < 3 Then Exit Function
			if Cint(Cl.Admin_Purview(sChannelID)) >= 4 Then TrueClassPurview = False : Exit Function
		End if
		if Instr(","&Cl.Admin_Info(5)&",",","&sClassID&",")>0 Then
			Exit Function
		ElseIf sPurview <= 1 Then
			TrueClassPurview = False : Exit Function
		End If
		If Instr(","&Cl.Admin_Info(6)&",",","&sClassID&",")>0 Then
			Exit Function
		ElseIf sPurview <= 2 Then
			TrueClassPurview = False : Exit Function
		End If
		If Instr(","&Cl.Admin_Info(7)&",",","&sClassID&",")>0 Then
			Exit Function
		End IF
		TrueClassPurview = False
	End Function

	Public Function TrueOtherPurview(Byval sPurview)
		TrueOtherPurview = True
		If Cint(Cl.Admin_Purview(0)) = 1 Then Exit Function
		if Instr("," & Lcase(Cl.Admin_Info(4)) & ",","," & Lcase(sPurview) & ",")>0 then Exit Function
		TrueOtherPurview = False
	End Function

	'======================================================
	'User:sPurview-----1(Master),2(Check),3(Input),4(View)
	'======================================================
	Public Function TrueChannelPurview_U(Byval sPurview,Byval sChannelID)
		TrueChannelPurview_U = True
		if UserID=0 or UserLevel=5 then TrueChannelPurview_U = False : Exit Function
		If Cint(Cl.User_Purview(0)) = 1 Then Exit Function
		If Cint(Cl.User_Purview(0)) > 2 Then TrueChannelPurview_U = False : Exit Function
		If Ubound(Cl.User_Purview) < sChannelID Then TrueChannelPurview_U = False : Exit Function
		if Cint(Cl.User_Purview(sChannelID)) <= sPurview Then Exit Function
		TrueChannelPurview_U = False
	End Function

	Public Function TrueClassPurview_U(Byval sPurview,Byval sChannelID,Byval sClassID)
		TrueClassPurview_U = True
		if UserID=0 or UserLevel=5 then TrueClassPurview_U = False : Exit Function
		If Cint(Cl.User_Purview(0)) = 1 Then Exit Function
		If Cint(Cl.User_Purview(0)) > 2 Then TrueClassPurview_U = False : Exit Function
		If Not IsNumeric(sPurview) or Not IsNumeric(sChannelID) or Not IsNumeric(sClassID) then
			TrueClassPurview_U = False : Exit Function
		end if
		If Ubound(Cl.User_Purview) < sChannelID Then TrueClassPurview_U = False : Exit Function
		Select Case Cint(Cl.User_Purview(sChannelID))
		Case 1
			Exit Function
		Case 2
			If sPurview >= 2 Then Exit Function
		Case 3
			If Instr(","&Cl.User_Info(39)&",",","&sClassID&",")>0 Then
				TrueClassPurview_U = True : Exit Function
			ElseIf sPurview <= 1 Then
				TrueClassPurview_U = False : Exit Function
			End If
			If Instr(","&Cl.User_Info(38)&",",","&sClassID&",")>0 Then
				Exit Function
			ElseIf sPurview <= 2 Then
				TrueClassPurview_U = False : Exit Function
			End If
			If Instr(","&Cl.User_Info(37)&",",","&sClassID&",")>0 Then
				Exit Function
			ElseIf sPurview <= 3 Then
				TrueClassPurview_U = False : Exit Function
			End If
			If Instr(","&Cl.User_Info(36)&",",","&sClassID&",")>0 Then
				Exit Function
			End IF
		Case 4, 5
			If sPurview >= 3 Then Exit Function
		Case 6
			If sPurview >= 4 Then Exit Function
		End Select
		TrueClassPurview_U = False
	End Function

	Public Function TrueOtherPurview_U(Byval sPurview)
		TrueOtherPurview_U = True
		if UserID=0 or UserLevel=5 then TrueOtherPurview_U = False : Exit Function
		If Cint(Cl.User_Purview(0)) = 1 Then Exit Function
		if Instr("," & Lcase(Cl.User_Info(35)) & ",","," & Lcase(sPurview) & ",")>0 then Exit Function
		TrueOtherPurview_U = False
	End Function

	Public Function TrueBrowsePurview()
		TrueBrowsePurview=False
		Select Case BrowsePurview
		Case 0 : TrueBrowsePurview=True
		Case 1
			if TrueChannelPurview_U(1,ChannelID) then
				TrueBrowsePurview=True
			else
				Dim sTr,i
				sTr=Split(ParentPath & "," & ClassID,",")
				for i=1 to Ubound(sTr)
				TrueBrowsePurview=TrueClassPurview_U(3,ChannelID,sTr(i))
				if TrueBrowsePurview=True then Exit For
				Next
			end if
		Case 2
			if Instr("|"&VipUser&"|","|"&MemberName&"|")>0 or UserLevel=1 then
				TrueBrowsePurview=True
			end if
		End Select
	End Function
    '取得用户级别
	Public Function GetUserGroupName(Byval sLevel)
		Name="UserGroup"
		if ObjIsEmpty then LoadUserGroup
		Dim sGroup,sRow,sGL,n
		sGroup=Split(Value,"@@")
		If IsNull(sLevel) or sLevel="" then Exit Function
		if Instr(sLevel,",")>0 then
			Dim sL
			sLevel=Split(sLevel,","):sGL=","
			for sL=0 to Ubound(sLevel)
				for n=0 to Ubound(sGroup)-1
					sRow=Split(sGroup(n),"||")
					if ChkClng(sRow(0))=ChkClng(sLevel(sL)) then
						sGL=sGL & "," & sRow(1) : Exit For
					end if
				Next
			Next
			sGL=Replace(sGL,",,","")
		else
			for n=0 to Ubound(sGroup)-1
				sRow=Split(sGroup(n),"||")
				if ChkClng(sRow(0))=ChkClng(sLevel) then
					sGL=sRow(1):Exit For
				end if
			Next
		end if
		GetUserGroupName=sGL
	End Function
	Public Function UserGroup_Option(Byval sLevel)
		Name="UserGroup"
		if ObjIsEmpty then LoadUserGroup
		Dim sGroup,sRow,n,sTemp
		sGroup=Split(Value,"@@"):sTemp=""
		for n=0 to Ubound(sGroup)-1
			sRow=Split(sGroup(n),"||")
			if Instr(","&sLevel&",",","&sRow(0)&",")>0 then
				sTemp=sTemp & "<option value='" & sRow(0) & "' selected>" & sRow(1) & "</option>"
			else
				sTemp=sTemp & "<option value='" & sRow(0) & "'>" & sRow(1) & "</option>"
			end if
		Next
		UserGroup_Option=sTemp
	End Function
	
    '缓存用户级别
	Public Sub LoadUserGroup()
		Dim rs
		Set rs=Execute("Select ID,GroupName,GroupImg,Purview,Purview_Other,arrClassView,arrClassInput,arrClassCheck,arrClassMaster from Cl_UserGroup Order by ID")
		if rs.bof and rs.eof then
			Value=""
		else
			Value=rs.GetString(,,"||","@@","")
		end if
	End Sub

	Public Function GetClassUrl(Byval sPathType, Byval sHtmlDir, Byval sChannelDir, Byval sParentPath, _
		Byval sClassID, Byval sParentDir, Byval sClassDir, Byval sIsCreate, Byval sCreateFileExt)
		if Clng(sIsCreate)=1 and CBool(Channel_Setting(14)) then
			GetClassUrl=GetItemPath(sPathType, sHtmlDir, sChannelDir, sParentPath, sClassID, sParentDir, sClassDir) & sClassID &"_Index." & sCreateFileExt
		else
			GetClassUrl=sChannelDir &"/ShowClass.asp?ClassID="&sClassID
		end if
    End Function

	Public Function GetItemPath(Byval sPathType, Byval sHtmlDir, Byval sChannelDir, _
		Byval sParentPath, Byval sClassID, Byval sParentDir, Byval sClassDir)
		Select Case Clng(sPathType)
        Case 0      'HtmlDir/频道/大类/小类/文件
            GetItemPath = sHtmlDir & sChannelDir & "/" & sParentDir & sClassDir & "/"
        Case 1      'HtmlDir/频道/大类(ClassID)/小类(ClassID)/文件
            GetItemPath = sHtmlDir & sChannelDir & "/" & GetClassIDPath(sParentPath, sClassID) & "/"
        Case 2      'HtmlDir/频道/栏目(英文)/文件
            GetItemPath = sHtmlDir & sChannelDir & "/" & sClassDir & "/"
        Case 3      'HtmlDir/频道/栏目(ClassID)/文件
            GetItemPath = sHtmlDir & sChannelDir & "/" & "Class" & sClassID&"/"
        Case 4      'HtmlDir/频道/文件
            GetItemPath = sHtmlDir & sChannelDir & "/"
        Case 5      'HtmlDir/频道/年月/文件
            GetItemPath = sHtmlDir & sChannelDir & "/" & Year(Now()) & Right("0" & Month(Now()),2) & "/"
        Case 6      'HtmlDir/频道/年/月/文件
            GetItemPath = sHtmlDir & sChannelDir & "/" & Year(Now()) & "/" & Right("0" & Month(Now()),2) & "/"
        Case 7      '频道/Html目录/大类(英文目录)/小类(英文目录)/文件
            GetItemPath = sChannelDir & "/" & sHtmlDir & sParentDir & sClassDir & "/"
        Case 8      '频道/Html目录/大类(ClassID)/小类(ClassID)/文件
            GetItemPath = sChannelDir & "/" & sHtmlDir & GetClassIDPath(sParentPath, sClassID) & "/"
        Case 9      '频道/大类(英文目录)/小类(英文目录)/文件
            GetItemPath = sChannelDir & "/" & sParentDir & sClassDir & "/"
        Case 10      '频道/大类(ClassID)/小类(ClassID)/文件
            GetItemPath = sChannelDir & "/" & GetClassIDPath(sParentPath, sClassID) & "/"
        Case 11      '频道/Html目录/栏目(英文目录)/文件
            GetItemPath = sChannelDir & "/" & sHtmlDir & "/" & sClassDir & "/"
        Case 12      '频道/Html目录/栏目(ClassID)/文件
            GetItemPath = sChannelDir & "/" & sHtmlDir & "/" & "Class" & sClassID & "/"
        Case 13      '频道/栏目(英文目录)/文件
            GetItemPath = sChannelDir & "/" & sClassDir & "/"
        Case 14      '频道/栏目(ClassID)/文件
            GetItemPath = sChannelDir & "/" & "Class" & sClassID&"/"
        Case 15      '频道/Html目录/文件
            GetItemPath = sChannelDir & "/" & sHtmlDir & "/"
        Case 16      '频道/Html目录/年月/文件
            GetItemPath = sChannelDir & "/" & sHtmlDir & "/" & Year(Now()) & Right("0" & Month(Now()),2) & "/"
        Case 17      '频道/Html目录/年/月/文件
            GetItemPath = sChannelDir & "/" & sHtmlDir & "/" & Year(Now()) & "/" & Right("0" & Month(Now()),2) & "/"
        Case Else
            GetItemPath = sHtmlDir & sChannelDir & "/" & sParentDir & sClassDir & "/"
		End Select
		GetItemPath = Replace(GetItemPath, "//", "/")
		if Not CheckFolder(Webdir&GetItemPath,False) then
			dim objFSO,sPath,tPath,i
			Set objFSO = Server.CreateObject(Trim(Cl.Web_Info(13)))
			tPath	= Split(GetItemPath,"/")
			sPath	= WebDir
			For i=0 to Ubound(tPath)-1
				If objFSO.FolderExists(Server.MapPath(sPath & tPath(i)))=False Then
					objFSO.CreateFolder Server.MapPath(sPath & tPath(i))
				End If
				sPath = sPath & tPath(i) & "/"
			Next
			Set objFSO = Nothing
		end if
	End Function

	Public Function GetItemFileName(ByVal sType, ByVal sClassID, ByVal sInfoID, ByVal sInfoTime)
		Select Case Clng(sType)
        Case 0      'ID + 时间(20051001234545)
			GetItemFileName = sInfoID & Format_Time(sInfoTime,8)
        Case 1      'ID
            GetItemFileName = sInfoID
        Case 2      'ID + 时间(20051001234545)
            GetItemFileName = Format_Time(sInfoTime,8)
        Case 3      '栏目ID + _ + ID + 时间(20051001234545)
            GetItemFileName = sClassID & "_" & sInfoID & Format_Time(sInfoTime,8)
        Case 4      '栏目ID + _ + ID
            GetItemFileName = sClassID & "_" & sInfoID
        Case 5      '栏目ID + _ + 时间(20051001234545)
            GetItemFileName = sClassID & "_" & Format_Time(sInfoTime,8)
        Case Else   'ID
            GetItemFileName = sInfoID
		End Select
	End Function

	Public Function GetItemIndexPath(ByVal sPathType, ByVal sHtmlDir, ByVal sChannelDir)
		Select Case Clng(sPathType)
        Case 0, 1, 2, 3, 4, 5, 6		 'HtmlDir/频道/
            GetItemIndexPath = sHtmlDir & sChannelDir & "/"
        Case 7, 8, 11, 12, 15, 16, 17     '频道/Html目录/
            GetItemIndexPath = sChannelDir & "/" & sHtmlDir & "/"
        Case 9, 10, 13, 14		 '频道/
            GetItemIndexPath = sChannelDir & "/"
		Case Else
            GetItemIndexPath = sHtmlDir & sChannelDir & "/"
		End Select
		GetItemIndexPath = Replace(GetItemIndexPath, "//", "/")
		if Not CheckFolder(Webdir&GetItemIndexPath&"Special/",False) then
			dim objFSO,sPath,tPath,i
			Set objFSO = Server.CreateObject(Trim(Cl.Web_Info(13)))
			tPath	= Split(GetItemIndexPath,"/")
			sPath	= WebDir
			For i=0 to Ubound(tPath)-1
				If objFSO.FolderExists(Server.MapPath(sPath & tPath(i)))=False Then
					objFSO.CreateFolder Server.MapPath(sPath & tPath(i))
				End If
				sPath = sPath & tPath(i) & "/"
			Next
			objFSO.CreateFolder Server.MapPath(sPath&"Special/")
			objFSO.CreateFolder Server.MapPath(sPath&"Update/")
			objFSO.CreateFolder Server.MapPath(sPath&"Elite/")
			objFSO.CreateFolder Server.MapPath(sPath&"Hot/")
			Set objFSO = Nothing
		end if
	End Function
	Public Sub CreateFolder(Byval sFolder)
		On Error Resume Next
		Dim objFSO
		err=0
		sFolder=Server.MapPath(sFolder)
		Set objFSO = Server.CreateObject(Trim(Cl.Web_Info(13)))
		If Not objFSO.FolderExists(sFolder) Then
			objFSO.CreateFolder sFolder
		End If
		Set objFSO = Nothing
		err=0
	End Sub
	Public Sub DelFolder(Byval sFolder)
		On Error Resume Next
		Dim objFSO
		err=0
		sFolder=Server.MapPath(sFolder)
		Set objFSO = Server.CreateObject(Trim(Cl.Web_Info(13)))
		If objFSO.FolderExists(sFolder) Then
			objFSO.DeleteFolder sFolder,True
		End If
		Set objFSO = Nothing
		err=0
	End Sub
	Public Function MoveFolder(Byval oFolder,Byval nFolder)
		On Error Resume Next
		Dim objFSO
		err=0
		MoveFolder=False
		oFolder=Server.MapPath(oFolder)
		nFolder=Server.MapPath(nFolder)
		Set objFSO = Server.CreateObject(Trim(Cl.Web_Info(13)))
		If objFSO.FolderExists(nFolder) Then
			MoveFolder=False
		Else
			objFSO.MoveFolder oFolder,nFolder
			MoveFolder=True
		End If
		Set objFSO = Nothing
		err=0
	End Function
	'检查目录是否存在！(sFolderPath,sIsCreate 不存在是否创建)
	Public Function CheckFolder(byval sFolder,byval sIsCreate)
		On Error Resume Next
		Dim objFSO
		CheckFolder=False:err=0
		sFolder=Server.MapPath(sFolder)
		Set objFSO = Server.CreateObject(Trim(Cl.Web_Info(13)))
		If objFSO.FolderExists(sFolder) Then
			CheckFolder=True
		ElseIf sIsCreate=True then
			objFSO.CreateFolder sFolder
			if err=0 then CheckFolder=True
		End If
		Set objFSO = Nothing
		err=0
	End Function
	'按月份自动分类（By梅傲风）
	Public Function CreatePath(Byval sTopPath,Byval sSort)
		Dim objFSO,sPath,tPath,i
		if Not IsNumeric(sSort) then sSort=0
		sTopPath=Replace(sTopPath&"/","//","/")
		Select Case sSort
		Case 1 : sPath = year(now)	'以年分类，格式：2005
		Case 2 : sPath = year(now)&"-"&month(now)	'以年-月分类，格式：2005-9
		Case 3 : sPath = year(now)&"/"&month(now)	'以年/月分类，格式：2005/9
		Case 4 : sPath = year(now)&"-"&month(now)&"-"&day(now)	'以年-月-日分类，格式：2005-9-28
		Case 5 : sPath = year(now)&"-"&month(now)&"/"&day(now)	'以年-月/日分类，格式：2005-9/28
		Case 6 : sPath = year(now)&"/"&month(now)&"/"&day(now)	'以年/月/日分类，格式：2005/9/28
		Case Else : sPath = year(now)
		End Select
		On Error Resume Next
		Err.Number = 0
		Set objFSO = Server.CreateObject(Trim(Cl.Web_Info(13)))
		If objFSO.FolderExists(Server.MapPath(sTopPath))=False Then
			objFSO.CreateFolder Server.MapPath(sTopPath)
		End If
		If Err.Number = 0 Then
			tPath	= Split(sPath,"/")
			For i=0 to Ubound(tPath)
				If objFSO.FolderExists(Server.MapPath(sTopPath & tPath(i)))=False Then
					objFSO.CreateFolder Server.MapPath(sTopPath & tPath(i))
				End If
				sTopPath = sTopPath & tPath(i) & "/"
			Next
		Else
			Err.Clear
		End If
		Set objFSO = Nothing
		CreatePath = sTopPath
	End Function
	'取得文件路径
	Public Function GetClassIDPath(sParentPath, sClassID)
		Dim P,tPath
		GetClassIDPath="":tPath=sParentPath
		if Instr(tPath,",")>0 or Instr(tPath,"|")>0 then
			tPath=Split(Replace(tPath,"|",","),",")
			for p=1 to Ubound(tPath)
				GetClassIDPath=GetClassIDPath & "Class" & tPath(p)&"/"
			next
		end if
		GetClassIDPath=GetClassIDPath & "Class" & sClassID&"/"
	End Function

	Public Function Getstar(starNum)
		Getstar = "<img src="""&Cl.WebDir&"Images/Star/Star0.gif"" border=""0"" alt="""" />"
		starNum = ChkClng(starNum)
		if starNum<1 or starNum>5 then Exit Function
		Getstar = "<img src="""&Cl.WebDir&"Images/Star/Star"&starNum&".gif"" border=""0"" alt="""&starNum&"星级"" />"
	End Function
	'显示验证码
	Public Function GetCode(CodeType)
		GetCode="<img src="""&WebDir&"Inc/Cl_GetCode.asp?type="&Trim(CodeType)&""" alt="""" />"
	End Function
	'检查验证码是否正确
	Public Function CodeIsTrue(CodeStr,CodeType)
		'Dim CodeStr
		CodeType=Trim(CodeType):CodeStr=Trim(CodeStr)
		If CStr(Session(CodeType)&"")=CStr(CodeStr&"") And CodeStr<>"" Then
			CodeIsTrue=True
			Session(CodeType)=Empty
		Else
			CodeIsTrue=False
			Session(CodeType)=Empty
		End If
	End Function
    '检查Email地址合法性
	Public Function ChkEmail(email)
		dim names, name, i, c
		ChkEmail = true : names = Split(email, "@")
		if UBound(names) <> 1 then ChkEmail = false : Exit Function
		for each name in names
			if Len(name) <= 0 then ChkEmail = false:exit function
			for i = 1 to Len(name)
		   	    c = Lcase(Mid(name, i, 1))
				if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
		    	   ChkEmail = false:Exit Function
		   	    end if
		    next
		    if Left(name, 1) = "." or Right(name, 1) = "." then
   		 	    ChkEmail = false:Exit Function
	 	    end if
		next
		if InStr(names(1), ".") <= 0 then ChkEmail = false:exit function
		i = Len(names(1)) - InStrRev(names(1), ".")
		if i <> 2 and i <> 3 then ChkEmail = false : Exit function
		if InStr(email, "..") > 0 then ChkEmail = false
	End Function
    '检查组件是否已经安装
	Public Function ChkObjInstalled(strClassString)
		On Error Resume Next
		ChkObjInstalled = False
		Err = 0
		Dim xTestObj
		Set xTestObj = Server.CreateObject(strClassString)
		If 0 = Err Then ChkObjInstalled = True
		Set xTestObj = Nothing
		Err = 0
	End Function
	'判断提交信息是否来自外部
	Public Function ChkIsOuter()
		Dim server_v1,server_v2
		ChkIsOuter=True 
		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 ChkIsOuter=False 
	End Function
    '向地址中加入 ? 或 & 
	Public Function JoinChar(strUrl)
		if strUrl="" then JoinChar="":Exit Function
		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 IsSafeStr(str)
		Dim s_BadStr, n, i
		s_BadStr = "' 　&<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
		n = Len(s_BadStr)
		IsSafeStr = True
		For i = 1 To n
			If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then
				IsSafeStr = False
				Exit Function
			End If
		Next
	End Function
	'获取任何表任何字段信息函数（字段名,表名,过滤,是否用户表1为是）
	Public Function GetTableInfo(ColumnName,TableName,StrWhere,IsUser)
		'On Error Resume Next
		dim RsStr,SqlStr
		SqlStr="select " & ColumnName & " from [" & TableName & "] where "&StrWhere&""
		If IsUser=1 then
			Set RsStr=Execute_U(SqlStr)
		Else
			Set RsStr=Execute(SqlStr)
		End If
		If Err Then
			GetTableInfo=""
			RsStr.close:set RsStr=Nothing
			Exit Function
		End if
		if RsStr.bof and RsStr.Eof then
			GetTableInfo=""
		else
			GetTableInfo=RsStr(0)
		end if
		RsStr.close:set RsStr=Nothing
	End Function
	Public Sub InToDataBase(DataBaseName,TableName,ColumnName,ColumnValue)
		On Error Resume Next
		dim sConn,sConnstr	
		Set sConn = Server.CreateObject("ADODB.Connection")
		sConnstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DataBaseName)
		sConn.Open sConnstr
		sConn.Execute("insert into ["&TableName&"] ("&ColumnName&") values ("&Replace(Replace(ColumnValue,"True","1"),"False","0")&")")
		sConn.Close:Set sConn = Nothing
		If Err Then
			Response.Write "在数据库"&DataBaseName&"表"&TableName&"中添加记录失败！原因：<font color=red>" & Err.Description
			Err.Clear
		End If
	End Sub
	Public Sub InToColumn(TableName,ColumnName,ColumnValue)
		On Error Resume Next
		Execute("insert into ["&TableName&"] ("&ColumnName&") values ("&Replace(Replace(ColumnValue,"True","1"),"False","0")&")")
		If Err Then
			Response.Write "在数据库表"&TableName&"中添加记录失败！原因：<font color=red>" & Err.Description
			Err.Clear
			'Response.end
		End If
	End Sub
	Public Sub SaveAdminLog()
		On Error Resume Next
		Dim RequestStr
		RequestStr   = Request("Action")
		If RequestStr<>"" Then
			RequestStr=Left("Action="&RequestStr & "&"&request.ServerVariables("QUERY_STRING"),200)
			RequestStr=CheckStr(URLDecode(RequestStr))
			SQL="Insert Into Cl_AdminLog (UserID,UserName,UserLevel,UserIP,ScriptName,LogContent,LogTime) values ("&Cl.User_Info(4)&",'"&Cl.User_Info(5)&"',"&Cl.User_Info(21)&",'"&Cl.UserTrueIP&"','"&Cl.ScriptName&"','"&RequestStr&"','"&Now&"')"
			Cl.Execute_L(SQL)
		End If
		If request.form<>"" Then
			RequestStr=Left(request.form,200)
			RequestStr=CheckStr(URLDecode(RequestStr))
			SQL="Insert Into Cl_AdminLog (UserID,UserName,UserLevel,UserIP,ScriptName,LogContent,LogTime) values ("&Cl.User_Info(4)&",'"&Cl.User_Info(5)&"',"&Cl.User_Info(21)&",'"&Cl.UserTrueIP&"','"&Cl.ScriptName&"','"&RequestStr&"','"&Now&"')"
			Cl.Execute_L(SQL)
		End if
		If Err Then
			'Response.Write "添加管理事件记录失败！原因：" & Err.Description
			Err.Clear
		End If
	End Sub
	'Server.URLEncode解码函数
	Public Function URLDecode(byval enStr)
		dim deStr, c, i, v
		deStr=""
		for i=1 to len(enStr)
			c=Mid(enStr,i,1)
			if c="%" then
				v=eval("&h"+Mid(enStr,i+1,2))
				if v<128 then
					deStr=deStr&chr(v)
					i=i+2
				else
					if IsValidHex(mid(enstr,i,3)) then
						if IsValidHex(mid(enstr,i+3,3)) then
						v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
						deStr=deStr&chr(v)
						i=i+5
						else
						v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
						deStr=deStr&chr(v)
						i=i+3 
						end if
					else
						destr=destr&c
					end if
				end if
			else
				if c="+" then
					deStr=deStr&" "
				else
					deStr=deStr&c
				end if
			end if
		next
		URLDecode=deStr
	End Function

	Public Function IsValidHex(byval str)
		Dim c
		IsValidHex=true
		str=ucase(str)
		if len(str)<>3 then IsValidHex=False : Exit Function
		if left(str,1)<>"%" then IsValidHex=False : Exit Function
		c=mid(str,2,1)
		if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then IsValidHex=False : Exit Function
		c=mid(str,3,1)
		if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then IsValidHex=False : Exit Function
	End Function
	'防SQL注入POST
	Public Sub ChkSQLInPost()
		If Request.Form<>"" Then
			Dim StrSqlInWord,StrPost,i
			CacheData(13,0)=Trim(CacheData(13,0))
			if Isnull(CacheData(13,0)) or CacheData(13,0)="" then Exit Sub
			StrSqlInWord=Split(LCase(CacheData(13,0)),"|")
			For Each StrPost In Request.Form
				For i=0 To Ubound(StrSqlInWord)
				If Instr(LCase(Request.Form(StrPost)),StrSqlInWord(i))<>0 Then
					Call SaveSQLLOG(2,StrPost&"="&Trim(Request.Form(StrPost)))
				end if
				Next
			Next
		End if
	End Sub
	'防SQL注入GET
	Public Sub ChkSQLInGet()
		If Request.QueryString<>"" Then
			Dim StrSqlInWord,StrGet,i
			CacheData(13,0)=Trim(CacheData(13,0))
			if Isnull(CacheData(13,0)) or CacheData(13,0)="" then Exit Sub
			StrSqlInWord=Split(LCase(CacheData(13,0)),"|")
			For Each StrGet In Request.QueryString
				For i=0 To Ubound(StrSqlInWord)
				If Instr(LCase(Request.QueryString(StrGet)),StrSqlInWord(i))<>0 Then
					Call SaveSQLLOG(3,StrGet&"="&Trim(Request.QueryString(StrGet)))
				end if
				Next
			Next
		End if
	End Sub
	'显示"上一页 下一页":链接地址,总数,页数,单位,项目名
	Public Function ShowPage(sFileName,TotalNumber,MaxperPage,sUnit,sItem)
		dim n, i, sTemp, strUrl
   		n = TotalPages
		sTemp = sTemp & "<div id=""showpage"" class=""showpage"">" & VbCrlf
		if CreateHtmlIng=True then
			sTemp = sTemp & "<script type=""text/javascript"" src="""&WebDir&"Inc/Js/page.js""></script>" & vbcrlf
			sTemp = sTemp & "<form action=""?"" method=""post"" name=""PageForm"">" & VbCrlf
			sTemp = sTemp & "共 <b>" & totalnumber & "</b> " & sUnit & sItem & "&nbsp;"
			sTemp = sTemp & "&nbsp;<b>" & maxperpage & "</b>" & sUnit & "/页&nbsp;"
			sTemp = sTemp & "&nbsp;页次：<strong><font color=""red"">" & CurrentPage & "</font>/" & n & "</strong>页&nbsp;&nbsp;"
  			if CurrentPage<2 then
    			sTemp = sTemp & "首页 上一页&nbsp;"
			else
    			sTemp = sTemp & "<a href="""&CreateFilePre&"_"&DefaultPage&"."&Cl.Channel_Setting(13)&""">首页</a>&nbsp;"
				if (CurrentPage-1) = 1 then
    				sTemp = sTemp & "<a href="""&CreateFilePre&"_"&DefaultPage&"."&Cl.Channel_Setting(13)&""">上一页</a>&nbsp;"
				else
    				sTemp = sTemp & "<a href="""&CreateFilePre&"_List_" & (CurrentPage-1) & "."&Cl.Channel_Setting(13)&""">上一页</a>&nbsp;"
				end if
			end if
			if CurrentPage >= n then
    			sTemp = sTemp & "下一页 尾页"
			else
    			sTemp = sTemp & "<a href="""&CreateFilePre&"_List_" & (CurrentPage+1) & "."&Cl.Channel_Setting(13)&""">下一页</a>&nbsp;"
    			sTemp = sTemp & "<a href="""&CreateFilePre&"_List_" & n & "."&Cl.Channel_Setting(13)&""">尾页</a>"
  			end if
			sTemp = sTemp & "&nbsp;转到：<input name=""page"" size=""6"" type=""text"" value="""&CurrentPage+1&""" class=""PageInput"" maxlength=""9"" />"   
			sTemp = sTemp & " <input type=""button"" value=""GO"" name=""button"" class=""PageInput"" onclick=""gotopage("&n&",'"&CreateFilePre&"','"&Cl.Channel_Setting(13)&"');"" />"
		else
			sTemp = sTemp & "<form action="""&sfilename&""" method=""post"" name=""PageForm"">" & VbCrlf
			strUrl = JoinChar(sfilename)
			sTemp = sTemp & "共 <b>" & totalnumber & "</b> " & sUnit & sItem & "&nbsp;"
			sTemp = sTemp & "&nbsp;<b>" & maxperpage & "</b>" & sUnit & "/页&nbsp;"
			sTemp = sTemp & "&nbsp;页次：<strong><font color=""red"">" & CurrentPage & "</font>/" & n & "</strong>页&nbsp;&nbsp;"
  			if CurrentPage < 2 then
    			sTemp = sTemp & "首页 上一页&nbsp;"
			else
    			sTemp = sTemp & "<a href=""" & strUrl & "page=1"">首页</a>&nbsp;"
    			sTemp = sTemp & "<a href=""" & strUrl & "page=" & (CurrentPage-1) & """>上一页</a>&nbsp;"
			end if
			if CurrentPage >= n then
    			sTemp = sTemp & "下一页 尾页"
			else
    			sTemp = sTemp & "<a href=""" & strUrl & "page=" & (CurrentPage+1) & """>下一页</a>&nbsp;"
    			sTemp = sTemp & "<a href=""" & strUrl & "page=" & n & """>尾页</a>"
  			end if
			sTemp = sTemp & "&nbsp;转到：<input name=""page"" size=""6"" type=""text"" value="""&CurrentPage+1&""" class=""PageInput"" maxlength=""9"" />"   
			sTemp = sTemp & " <input type=""submit"" value=""GO"" name=""submit"" class=""PageInput"" />"
		end if
		ShowPage = sTemp & "</form>" & VbCrlf & "</div>"
	End Function
	Public Sub ChecKIPlock()
		Dim IPlock
		IPlock = False
		Dim locklist
		If Checkstr(CacheData(9,0))="" Then Exit Sub
		Dim i,StrUserIP,StrKillIP
		StrUserIP=UserTrueIP
		If StrUserIP="" Then Exit Sub
		locklist=Split(Checkstr(CacheData(9,0)),"|")
		StrUserIP=Split(UserTrueIP,".")
		If Ubound(StrUserIP)<>3 Then Exit Sub
		For i= 0 to UBound(locklist)
			locklist(i)=Checkstr(locklist(i))
			If locklist(i)<>"" Then
				StrKillIP = Split(locklist(i),".")
				If Ubound(StrKillIP)<>3 Then Exit For
				IPlock = True
				If (StrUserIP(0) <> StrKillIP(0)) And Instr(StrKillIP(0),"*")=0 Then IPlock=False
				If (StrUserIP(1) <> StrKillIP(1)) And Instr(StrKillIP(1),"*")=0 Then IPlock=False
				If (StrUserIP(2) <> StrKillIP(2)) And Instr(StrKillIP(2),"*")=0 Then IPlock=False
				If (StrUserIP(3) <> StrKillIP(3)) And Instr(StrKillIP(3),"*")=0 Then IPlock=False
				If IPlock Then Exit For
			End If
		Next
		If IPlock Then
			Response.Cookies(Web_Cookies & "Kill")("kill") = "Yes"
		Else
			Response.Cookies(Web_Cookies & "Kill")("kill") = "No"
		End If
	End Sub
	Function OutMsg(Message,GoToUrl) 
		Message = Replace(Message,"'","") 
		If GoToUrl="-1" Then
		Response.Write "<script type=""text/javascript"">alert('" & Message & "');history.go(-1)</script>" 
		Else 
		Response.Write "<script type=""text/javascript"">alert('" & Message & "');location='" & GoToUrl &"'</script>" 
		End If 
		Response.End
	End Function
	Public Sub OutErr(ErrCodes)
		Response.Redirect WebDir & "Showerr.asp?action=Ohter&ErrCodes="&HTMLCode(ErrCodes)&""
		Response.End
	End Sub
    '显示成功提示信息
	Public Function ShowSuc(Message)
		LoadTemplates("")
		ShowSuc = Replace(mainhtml(11),"{%sucmsg%}",Message)
		'response.end
	End Function
    '显示错误提示信息
	Public Function ShowErr(Message)
		LoadTemplates("")
		ShowErr = Replace(mainhtml(12),"{%errmsg%}",Message)
		'response.end
    End Function
    '显示错误提示信息
	Public Function NotLoginErr(sLevel,sFunName)
		LoadTemplates("")
		NotLoginErr = Replace(Cl.lanstr(7),"{%level%}",GetUserGroupName(sLevel))
		NotLoginErr = Replace(NotLoginErr,"{%function%}",sFunName)
    End Function
	Public Function ReplaceLabel(Byval sTrC)
        Name="ReplaceLabel"
	    if ObjIsEmpty() then
		    Dim RsLabel
		    Set RsLabel = Execute("Select LabelName,LabelContent from Cl_Label Order By LabelPriority,LabelID")
			if RsLabel.bof or RsLabel.eof then
				Value=""
			else
				Value=RsLabel.GetString(,,"||","@@","")
			end if
			Set RsLabel = Nothing
		end if
		if Value<>"" then
			dim sRow,sCol,i
			sRow=Split(Value,"@@")
			for i=0 to Ubound(sRow)-1
				sCol=Split(sRow(i),"||")
				sTrC = Replace(sTrC,"{%"&Trim(sCol(0))&"%}",sCol(1))
			next
		end if
		ReplaceLabel=sTrC
	End Function
	Public Function ReplaceKeyword(Byval sTrC)
		Name="ReplaceKeyword"
	    if ObjIsEmpty() then
		    Dim RsKeyword
		    Set RsKeyword = Execute("Select KeywordName,KeywordColor,KeywordLink from Cl_Keyword Order By KeywordPriority,KeywordID")
			if RsKeyword.bof or RsKeyword.eof then
				Value=""
			else
				Value=RsKeyword.GetString(,,"||","@@","")
			end if
			Set RsKeyword = Nothing
		end if
		if Value<>"" then
			dim sRow,sCol,i
			sRow=Split(Value,"@@")
			for i=0 to Ubound(sRow)-1
				sCol=Split(sRow(i),"||")
				sTrC = Replace(sTrC,Trim(sCol(0)),"<a href="&sCol(2)&"><strong><font color="&sCol(1)&">"&Trim(sCol(0))&"</font></strong></a>")
			next
		end if
		ReplaceKeyword=sTrC
	End Function
	Public Function ReplaceFlag(Byval sTrC,Byval strFlag,Byval strData)
		Dim regEx,Matches,Match,TempStr
		sTrC = Replace(sTrC,"<!--{%","{%")
		sTrC = Replace(sTrC,"%}-->","%}")
		ReplaceFlag			= sTrC
		Set regEx			= New RegExp
		regEx.Pattern		= "(\{%"&strFlag&")(.[^\{]*)(\%\})"
		regEx.IgnoreCase	= True
		regEx.Global		= True
		Set Matches			= regEx.Execute(sTrC)
		For Each Match in Matches
			TempStr = Replace(Match.Value,"{%","")
			TempStr = Replace(TempStr,"%}","")
			TempStr = Replace(TempStr,"(",",")
			TempStr = Replace(TempStr,")","")
			TempStr = Replace(TempStr,"""","")
			if strData<>"" then
				ReplaceFlag = Replace(ReplaceFlag,Match.Value,strData)
			else
				ReplaceFlag = Replace(ReplaceFlag,Match.Value,GetLabelContent(TempStr,sTrC))
			end if
		Next
	End Function
	Public Function ReplaceAllFlag(Byval sTrC)
		Dim regEx,Matches,Match,TempValue,ArrayStr,DataStr
		sTrC	= Replace(sTrC,"{%showhead%}",Cl.Head)
		sTrC	= Replace(sTrC,"{%showfooter%}",Cl.Bottom)
		sTrC	= ReplaceLabel(sTrC)
		sTrC	= ReplacePublicFlag(sTrC)
		Set regEx	= New RegExp
		regEx.IgnoreCase= True
		regEx.Global	= True
		regEx.Pattern	= "(\【)(.[^\【]*)(\】)"
		Set Matches		= regEx.Execute(sTrC)
		For Each Match in Matches
			TempValue	= Match.Value
			TempValue	= Replace(TempValue,"【","")
			TempValue	= Replace(TempValue,"】","")
			'TempValue	= Replace(TempValue,"(",",")
			'TempValue	= Replace(TempValue,")","")
			TempValue	= Replace(TempValue,"""","")
			ArrayStr	= Split(TempValue,",")
			Select Case Lcase(ArrayStr(0))
			Case "getarticle"
			sTrC	= Replace(sTrC,Match.Value,GetArticle(ArrayStr(1),ArrayStr(2),ArrayStr(3),ArrayStr(4),ArrayStr(5),ArrayStr(6),ArrayStr(7),ArrayStr(8),ArrayStr(9),ArrayStr(10),ArrayStr(11),ArrayStr(12),ArrayStr(13),ArrayStr(14)))
			Case "getsoft"
			sTrC	= Replace(sTrC,Match.Value,GetSoft(ArrayStr(1),ArrayStr(2),ArrayStr(3),ArrayStr(4),ArrayStr(5),ArrayStr(6),ArrayStr(7),ArrayStr(8),ArrayStr(9),ArrayStr(10),ArrayStr(11),ArrayStr(12),ArrayStr(13),ArrayStr(14)))
			Case "getphoto"
			sTrC	= Replace(sTrC,Match.Value,GetPhoto(ArrayStr(1),ArrayStr(2),ArrayStr(3),ArrayStr(4),ArrayStr(5),ArrayStr(6),ArrayStr(7),ArrayStr(8),ArrayStr(9),ArrayStr(10),ArrayStr(11),ArrayStr(12),ArrayStr(13),ArrayStr(14)))
			Case "getmovie"
			sTrC	= Replace(sTrC,Match.Value,GetMovie(ArrayStr(1),ArrayStr(2),ArrayStr(3),ArrayStr(4),ArrayStr(5),ArrayStr(6),ArrayStr(7),ArrayStr(8),ArrayStr(9),ArrayStr(10),ArrayStr(11),ArrayStr(12),ArrayStr(13),ArrayStr(14)))
			Case "getproduct"
			sTrC	= Replace(sTrC,Match.Value,GetProduct(ArrayStr(1),ArrayStr(2),ArrayStr(3),ArrayStr(4),ArrayStr(5),ArrayStr(6),ArrayStr(7),ArrayStr(8),ArrayStr(9),ArrayStr(10),ArrayStr(11),ArrayStr(12),ArrayStr(13),ArrayStr(14)))
			End Select
		Next
		regEx.Pattern		= "(\{%mainhtml)(.[^\{]*)(\%\})"
		Set Matches			= regEx.Execute(sTrC)
		For Each Match in Matches
			TempValue = Replace(Match.Value,"{%","")
			TempValue = Replace(TempValue,"%}","")
			TempValue = Replace(TempValue,"(",",")
			TempValue = Replace(TempValue,")","")
			ArrayStr  = Split(TempValue,",")
			sTrC	  = Replace(sTrC,Match.Value,Cl.mainhtml(ArrayStr(1)))
		Next
		regEx.Pattern		= "(\{%)(.[^\{]*)(\%\})"'"{%([^{%}])*%}"
		Set Matches			= regEx.Execute(sTrC)
		For Each Match in Matches
			TempValue	= Match.Value
			'TempValue	= Replace(TempValue,Chr(13) & Chr(10),"")
			TempValue	= Replace(TempValue,"{%","")
			TempValue	= Replace(TempValue,"%}","")
			TempValue	= Replace(TempValue,"(",",")
			TempValue	= Replace(TempValue,")","")
			TempValue	= Replace(TempValue,"""","")
			sTrC	= Replace(sTrC,Match.Value,GetLabelContent(TempValue,sTrC))
		Next
		sTrC = Replace(sTrC,"{%temploadjs%}","")
		sTrC = Replace(sTrC,"{%width%}",mainsetting(0))
		sTrC = Replace(sTrC,"{%webname%}",Web_info(0))
		sTrC = Replace(sTrC,"{%weburl%}",Web_info(4))
		sTrC = Replace(sTrC,"{%picurl%}",WebDir&Cl.Web_PicUrl)
		sTrC = Replace(sTrC,"{%channelid%}",ChannelID)
		sTrC = Replace(sTrC,"{%channelname%}",ChannelName)
		sTrC = ReplaceDir(sTrC)
		'sTrC = ReplaceItem(sTrC)
		ReplaceAllFlag		= sTrC
		Set Matches	= Nothing : Set regEx = Nothing
	End Function
	Public Function ReplaceDir(Byval sTrC)
		sTrC		= Replace(sTrC,"{%webdir%}",WebDir)
		sTrC		= Replace(sTrC,"{%admindir%}",Web_Info(14))
		sTrC		= Replace(sTrC,"{%bbsdir%}",BbsDir)
		sTrC		= Replace(sTrC,"{%uploaddir%}",UploadDir)
		'sTrC		= Replace(sTrC,"{%downloaddir%}",DownLoadDir)
		sTrC		= Replace(sTrC,"{%channeldir%}",ChannelDir)
		ReplaceDir	= sTrC
	End Function
	Public Function ReplaceItem(Byval sTrC)
		sTrC = Replace(sTrC,"{%channelitemname%}",ChannelItemName)
		sTrC = Replace(sTrC,"{%channelitemunit%}",ChannelItemUnit)
		sTrC = Replace(sTrC,"{%moneyitemname%}",Web_Setting(26))
		sTrC = Replace(sTrC,"{%moneyitemunit%}",Web_Setting(27))
		sTrC = Replace(sTrC,"{%pointitemname%}",Web_Setting(28))
		sTrC = Replace(sTrC,"{%pointitemunit%}",Web_Setting(29))
		ReplaceItem	= sTrC
	End Function
	Public Sub MakeHtml(Byval MakeData,Byval MakeFileName)
		Dim Fso,Make
		On Error Resume Next
		Err=0
		MakeFileName=Trim(MakeFileName)
		Set Fso = CreateObject(Trim(Cl.Web_Info(13)))
			Set Make = Fso.CreateTextFile(Server.MapPath(MakeFileName), True)
			Make.Write MakeData & vbNewLine & _
				"<!--Powered by:"& Web_Version(1) & " (Asp"&"oo.c"&"n) " &_
						"CreateDate:"&Now&"--> "
			Set Make = Nothing
		Set Fso = Nothing
		If 0 <> Err Then
			Response.Write "<font color=red>生成（"&MakeFileName&"）失败，请检查你的服务器是否有FSO(FileSystemObject)！</font><br />"
		End if
		Err=0
	End Sub
	'取得带端口的URL
	Public Function 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 Function
	' 转为根路径格式
	Public Function RelativePath2RootPath(Byval url)
		Dim sTempUrl
		sTempUrl = url
		If Left(sTempUrl, 1) = "/" Then
			RelativePath2RootPath = sTempUrl
			Exit Function
		End If
		Dim sNowPath
		sNowPath = Request.ServerVariables("SCRIPT_NAME")
		sNowPath = Left(sNowPath, InstrRev(sNowPath, "/") - 1)
		Do While Left(sTempUrl, 3) = "../"
			sTempUrl = Mid(sTempUrl, 4)
			sNowPath = Left(sNowPath, InstrRev(sNowPath, "/") - 1)
		Loop
		RelativePath2RootPath = sNowPath & "/" & sTempUrl
	End Function
	' 根路径转为带域名全路径格式
	Public Function RootPath2DomainPath(Byval url)
		Dim sHost, sPort
		sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
		sPort = Request.ServerVariables("SERVER_PORT")
		If sPort <> "80" Then sHost = sHost & ":" & sPort
		RootPath2DomainPath = sHost & url
	End Function

	Public Function GetSize(Byval size,Byval unit)
		if isEmpty(size) or Not Isnumeric(size) then Exit Function
		size=CheckUnit(size,unit)
 		if size>1024 then
 			size=(size/1024)
 			getsize=formatnumber(size,2) & " MB"
		else
			getsize=size & " KB"
			Exit Function
 		end if
 		if size>1024 then
 			size=(size/1024)
 			getsize=formatnumber(size,2) & " GB"
 		end if
	End Function
	Public Function CheckUnit(Byval size,Byval unit)
		Select Case Lcase(Unit)
		Case "b"
			CheckUnit = formatnumber(size/1024,2)
		Case "k"
			CheckUnit = size
		Case "m"
			CheckUnit = (size*1024)
		Case "g"
			CheckUnit = (size*1024*1024)
		Case Else
			CheckUnit = size
		End Select
	End Function
	Public Sub DelFiles(Byval strFiles)
		if strFiles="" then Exit Sub
		dim fso,arrFiles,i
		On Error Resume Next
		Err=0
		Set fso = CreateObject(Trim(Web_Info(13)))
			if fso.FileExists(server.MapPath(strFiles)) then
				fso.DeleteFile(server.MapPath(strFiles))
				if 0=Err then
					Response.write "<br />清除文件（"&strFiles&"）成功！"
				else
					Response.write "<br />清除文件（"&strFiles&"）失败！"
				end if
			end if
		Set fso = Nothing
		Err=0
	End Sub
	Public Sub DownloadFile(Byval strFile,Byval sReName)
		On error resume next
		Server.ScriptTimeOut=999999
		Dim S,fso,f,intFilelength,strFilename
		strFilename = strFile
		Response.Clear
		Set s = Server.CreateObject("Adodb." & "Str" & "eam")
		s.Open
		s.Type = 1
		Set fso = Server.CreateObject(Trim(Cl.Web_Info(13)))
		If Not fso.FileExists(strFilename) Then
			Response.Write("<h1>错误: </h1><br />系统找不到指定文件！<a href='javascript:history.go(-1)'><font color=red>点此返回</font></a>吧！")
			Exit Sub
		End If
		Set f = fso.GetFile(strFilename)
		intFilelength = f.size
		s.LoadFromFile(strFilename)
		If err Then
		 	Response.Write("<h1>错误: </h1>" & err.Description & "<p>")
			Response.End 
		End If
		Set fso=Nothing
		Dim Data
		Data=s.Read
		s.Close
		Set s=Nothing
		If Response.IsClientConnected Then 
			Response.AddHeader "Content-Disposition", "attachment; filename="&ReplaceBadChar(sReName)&"."&GetDownLoadFileExt(f.name)
			Response.AddHeader "Content-Length", intFilelength 
 			Response.CharSet = "UTF-8" 
			Response.ContentType = "application/octet-stream"
			Response.BinaryWrite Data
			Response.Flush
		End If
	End Sub
	Public Function GetDownLoadFileExt(Byval strFile)
		GetDownLoadFileExt="rar"
		Dim strExt
		if Isnull(strFile) then Exit Function
		if Instr(strFile,".")<=0 then Exit Function
		strExt=Split(strFile,".")
		GetDownLoadFileExt=strExt(Ubound(strExt))
	End Function

	Public Function HTMLEncode(Byval fString)
		If Not IsNull(fString) then
		fString = replace(fString, ">", "&gt;")
		fString = replace(fString, "<", "&lt;")
		fString = replace(fString, "&", "&amp;")
		fString = Replace(fString, CHR(32), "&nbsp;")
		fString = Replace(fString, CHR(9), "&nbsp;")
		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 /> ")
		HTMLEncode = fString
		End If
	End Function

	Public Function HTMLCode(Byval fString)
		If Not IsNull(fString) then
		fString = replace(fString, "&gt;", ">")
		fString = replace(fString, "&lt;", "<")
		fString = Replace(fString,  "&nbsp;"," ")
		fString = Replace(fString, "&quot;", CHR(34))
		fString = Replace(fString, "&#39;", CHR(39))
		fString = Replace(fString, "</P><P> ",CHR(10) & CHR(10))
		fString = Replace(fString, "<br /> ", CHR(10))
		HTMLCode = fString
		End If
	End Function

	Public Function NoHtml(Byval str)
		if not isnull(str) then
		dim re
		Set re=new RegExp
		re.IgnoreCase =true
		re.Global=True
		re.Pattern="(\<.[^\<]*\>)"
		str=re.replace(str," ")
		re.Pattern="(\<\/[^\<]*\>)"
		str=re.replace(str," ")
		NoHtml=str
		Set re=Nothing
		End if
	End Function

	'sContent（要转换的数据字符串）
	'sFilters（要过滤掉的格式集，用"|"分隔多个）
	Public Function DeCode(Byval sContent, Byval sFilters)
		Dim a_Filter, i, s_Result, s_Filters
		Decode = sContent
		If IsNull(sContent) or IsNull(sFilters) Then Exit Function
		If sContent = "" or sFilters = "" Then Exit Function
		s_Result  = sContent
		s_Filters = sFilters
		If InStr(s_Filters,"|")>0 then
			a_Filter = Split(s_Filters, "|")
			For i = 0 To UBound(a_Filter)
				s_Result = DecodeFilter(s_Result, a_Filter(i))
			Next
		Else
			s_Result = DecodeFilter(s_Result, s_Filters)
		End If
		DeCode = s_Result
	End Function

	Public Function DecodeFilter(Byval sContent, Byval sFilter)
		Dim regEx
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global	 = True
		Select Case Ucase(sFilter)
		Case "SCRIPT"'去除所有客户端脚本javascipt,vbscript,jscript,js,vbs,event,...
			regEx.Pattern	= "</?script[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "(javascript|jscript|vbscript|vbs):"
			sContent		= regEx.replace(sContent,"$1：")
			'regEx.Pattern	= "on(mouse|exit|error|click|key)"
			'sContent		= regEx.replace(sContent,"<I>on$1</I>")
		Case "OBJECT"'去除对象<object><param><embed></object>
			regEx.Pattern	= "</?object[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?param[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?embed[^>]*>"
			sContent		= regEx.replace(sContent,"")
		Case "TABLE"'去除表格<table><tr><td><th>
			regEx.Pattern	= "</?table[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?tr[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?th[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?td[^>]*>"
			sContent		= regEx.replace(sContent,"")
		Case "CLASS"'去除样式类class=""
			regEx.Pattern	= "(<[^>]+) class=[^ |^>]*([^>]*>)"
			sContent		= regEx.replace(sContent,"$1 $2")
		Case "STYLE"'去除样式style=""
			regEx.Pattern	= "(<[^>]+) style=\""[^\""]*\""([^>]*>)"
			sContent		= regEx.replace(sContent,"")
		Case "XML"'去除XML<?xml>
			regEx.Pattern	= "<\\?xml[^>]*>"
			sContent		= regEx.replace(sContent,"")
		Case "NAMESPACE"'去除命名空间<o:p></o:p>
			regEx.Pattern	= "<\/?[a-z]+:[^>]*>"
			sContent		= regEx.replace(sContent,"")
		Case Else
			regEx.Pattern	= "</?" & sFilter & "[^>]*>"
			sContent		= regEx.replace(sContent,"")
		End Select
		DecodeFilter = sContent
		Set regEx=nothing
	End Function

	Public Function UbbCode(str)
		If Not IsNull(str) then
			Set ClUbb=New Cls_UbbCode
			UbbCode=ClUbb.UbbCode(str)
			Set ClUbb=Nothing
		End if
	End Function

	Public Function ChkClng(ByVal str)
		If str<>"" and IsNumeric(str) Then
			ChkClng = CLng(str)
		Else
			ChkClng = 0
		End If
	End Function

	Public Function ChkCBool(ByVal str)
		If Not IsNull(str) Then
			ChkCBool = CBool(str)
		Else
			ChkCBool = False
		End If
	End Function

	Public Function ChkCDbl(ByVal str)
		If str<>"" and IsNumeric(str) Then
			ChkCDbl = CDbl(str)
		Else
			ChkCDbl = 0
		End If
	End Function

	Public Function ChkNull(ByVal str)
		If IsNull(str) Then
			ChkNull = ""
		Else
			ChkNull = str
		End If
	End Function

	Public Sub ChkUploadFile(iID,Content,Files)
		Dim sTr, sFiles, i, sFile
		iID		= ChkClng(iID)
		sTr		= Content
		sFiles	= Files
		If IsNull(sTr) or IsNull(sFiles) or sTr="" or sFiles="" Then Exit Sub
		sTr		= Lcase(ReplaceDir(sTr))
		If Instr(sFiles,"@@@") > 0 then
			sFiles = Split(sFiles,"@@@")
			For i=0 to Ubound(sFiles)
				sFile = Trim(sFiles(i))
				sFile = Lcase(ReplaceDir(sFile))
				If Instr(sTr,sFile)>0 then
				Execute("Update Cl_UpFileLog Set InfoID="&iID&",IsUse=1 Where SaveFileName='"&CheckStr(sFiles(i))&"'")
				Else
				Execute("Update Cl_UpFileLog Set InfoID="&iID&",IsUse=0 Where SaveFileName='"&CheckStr(sFiles(i))&"'")
				End if
			Next
		Else
			sFile = Trim(sFiles)
			sFile = Lcase(ReplaceDir(sFile))
			If Instr(sTr,sFile)>0 then
			Execute("Update Cl_UpFileLog Set InfoID="&iID&",IsUse=1 Where SaveFileName='"&CheckStr(sFiles)&"'")
			Else
			Execute("Update Cl_UpFileLog Set InfoID="&iID&",IsUse=0 Where SaveFileName='"&CheckStr(sFiles)&"'")
			End if
		End If
	End Sub

End Class

Class Cls_Templates
	Public html,Strings,pic
	Public Property Let Value(ByVal vNewValue)
		Dim tmpstr:tmpstr = vNewValue
		tmpstr = Replace(tmpstr,"{%PicUrl%}",Cl.Web_PicUrl)
		tmpstr = Split(tmpstr,"@@@")
		html = Split(tmpstr(0),"|||"):Strings = Split(tmpstr(1),"|||"):pic = Split(tmpstr(2),"|||")
	End Property
End Class

Class Cls_DataBase
	Private ConnStr
	Public UserTable,MessageTable,FriendTable
	Public UserID,UserName,UserSex,UserEmail,UserIM,UserPassword,UserQuestion,UserAnswer
	Public UserFace,UserFaceWidth,UserFaceHeight,UserJoinDate,UserLogins,UserLastLogin,UserLastIP,UserLock,UserWealth
	Public UserDataNum,UserLevel,UserPoint,UserMoney,ChargeType,BeginDate,ValidNum,UserCheckNum,UserTPassWord
	Public UserHomepage,UserQQ,UserIcq
	Public UserReName,UserTelePhone,UserAddRess,UserBirthday,IDCard,CityInfo,ZipCode,SchoolAge,UserWorking,UserHomePhone,UserMobile,UserReMark,WaitReceive,Received,UserMsg,TotalExp

	Public Property Let ConnValue(ByVal Val)
		ConnStr = Val
	End Property
	Public Property Get ConnValue()
		ConnValue = ConnStr
	End Property
	Public Function OpenConnection(DbType)
		Dim TempConn
		On Error Resume Next
		Set TempConn = Server.CreateObject("ADODB.Connection")
		TempConn.Open ConnValue 
		Set OpenConnection = TempConn
		Set TempConn = Nothing
		If Err Then
			Err.Clear
			Response.Write DbType & "链接出错，请检查数据库链接字符串！"
			Response.End
		End If
	End Function 
End Class
%>
