cl_clssystem.asp

淘客网上商店网站程序 淘客网上商店网站程序 淘客网上商店网站程序

		'Application(CacheName&"_channellist").Save(Server.MapPath("/channel.xml"))
	End Sub
	Rem 加载XML栏目列表
	Public Sub Load_ClassList()
		Dim Rs, Node, TChannel, TempXml
		Set Rs = Execute("select * From Cl_Class Order by RootID Asc,OrderID Asc")
		Set TempXml = RecordsetToxml(Rs,"class","classlist")
		Set Rs		= Nothing
		For Each Node In TempXml.documentElement.SelectNodes("class")
			If Clng(Node.selectSingleNode("@isouter").text)=1 then
				Node.selectSingleNode("@linkurl").text = Replace(Node.selectSingleNode("@linkurl").text,"{$webdir}",InstallDir)
			Else
				Set TChannel = Application(CacheName & "_channellist").documentElement.selectSingleNode("channel[@channelid="&Node.selectSingleNode("@channelid").text&"]")
				if Clng(TChannel.selectSingleNode("@iscreatehtml").text)=1 and CBool(TChannel.selectSingleNode("@iscreatelist").text) then
					Node.selectSingleNode("@linkurl").text = InstallDir & Cl.GetItemIndexPath(TChannel.selectSingleNode("@createpathtype").text, HtmlDir, TChannel.selectSingleNode("@channeldir").text) & "Class/" & Node.selectSingleNode("@classid").text &"_Index." & TChannel.selectSingleNode("@createfileext").text
				else
					Node.selectSingleNode("@linkurl").text = InstallDir & TChannel.selectSingleNode("@channeldir").text & "/ShowClass.asp?ClassID=" & Node.selectSingleNode("@classid").text
				end If
				Node.attributes.setNamedItem(TempXml.createNode(2,"namelength","")).text= strLength(Node.selectSingleNode("@classname").text)
				Set TChannel = Nothing
			End If
		Next
		'TempXML.Save(Server.MapPath(InstallDir & "Data/Cl_ClassList.xml"))
		Application.Lock
		Set Application(CacheName & "_classlist") = TempXML
		Application.unLock
		Set Node	= Nothing
		Set TempXml	= Nothing
	End Sub
	'加载专题列表XML
	Public Function Load_SpecialList()
		Dim Node,RsSpecial,TempXml
		'If not IsObject(Application(Cl.CacheName&"_channellist")) Then Load_ChannelList()
		Set RsSpecial=Execute("select * From Cl_Special Order by OrderID,ChannelID,isUse desc")
		Set TempXml=RecordsetToxml(RsSpecial,"special","speciallist")
		Set RsSpecial=Nothing
		For Each Node In TempXml.documentElement.SelectNodes("special")
			if Clng(Node.selectSingleNode("@channelid").text)>0 then
				Node.attributes.setNamedItem(TempXml.createNode(2,"linkurl","")).text= _
				Cl.WebDir & Application(Cl.CacheName&"_channellist").documentElement.selectSingleNode("channel[@channelid="&Node.selectSingleNode("@channelid").text&"]/@channeldir").text & "/ShowSpecial.Asp?SpecialID=" & Node.selectSingleNode("@specialid").text
			else
				Node.attributes.setNamedItem(TempXml.createNode(2,"linkurl","")).text= ""
			end if
			Node.attributes.setNamedItem(TempXml.createNode(2,"namelength","")).text= strLength(Node.selectSingleNode("@specialname").text)
		Next
		Application.Lock
		Set Application(CacheName & "_speciallist") = TempXML
		Application.unLock
		Set Node	= Nothing
		Set TempXml	= Nothing
	End Function

	Rem ReadClassXML,栏目数据量大于2000的可采用
	Public Sub Read_ClassList()
		Dim XMLDom,TempXml
		Set XMLDom = Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		XMLDom.Load Server.MapPath(InstallDir & "Data/Cl_ClassList.xml")
		Set TempXml = XMLDom.cloneNode(True)
		Application.Lock
		Set Application(CacheName & "_classlist") = TempXML
		Application.unLock
		Set XMLDom = Nothing
	End Sub

	Rem 频道导航li输出函数By mf
	Public Function ShowChannelMenu(sChannelID)
		Dim Node,sTemp,i
		sChannelID=Clng(sChannelID)
		For Each Node In Application(CacheName&"_channellist").documentElement.SelectNodes("channel[@isshow=1][@isdisabled=0]")
			if i > 0 then sTemp = sTemp & "<span class=""channelmenu_part"">|</span>"
			if Clng(Node.selectSingleNode("@channelid").text) = sChannelID then
				sTemp = sTemp & "<span class=""channelmenu_current"">"
			else
				sTemp = sTemp & "<span class=""channelmenu_other"">"
			end if
			sTemp = sTemp & "<a href=""" & Node.selectSingleNode("@linkurl").text &""" title=""" & Node.selectSingleNode("@readme").text & """"
			if CInt(Node.selectSingleNode("@opentype").text) = 1 then
				sTemp = sTemp & " target=""_blank"""
			end if
			sTemp = sTemp & ">" & Node.selectSingleNode("@channelname").text & "</a></span>"
			i = i + 1
		Next 
		ShowChannelMenu = sTemp
		sTemp		= Empty
		Set Node	= Nothing
	End Function

	Public Function GetModuleEnglishName(sModuleID)
		Select Case CLng(sModuleID)
		Case 1 : GetModuleEnglishName = "Article"
		Case 2 : GetModuleEnglishName = "Soft"
		Case 3 : GetModuleEnglishName = "Photo"
		Case 4 : GetModuleEnglishName = "Movie"
		Case 5 : GetModuleEnglishName = "Product"
		Case 6 : GetModuleEnglishName = "Supply"
		Case 10 : GetModuleEnglishName = "GuestBook"
		Case Else : GetModuleEnglishName = "Index"
		End Select
	End Function

	Public Function GetModuleChineseName(sModuleID)
		Select Case CLng(sModuleID)
		Case 1 : GetModuleChineseName = "文章"
		Case 2 : GetModuleChineseName = "软件"
		Case 3 : GetModuleChineseName = "图片"
		Case 4 : GetModuleChineseName = "影视"
		Case 5 : GetModuleChineseName = "产品"
		Case 6 : GetModuleChineseName = "供求"
		Case 10 : GetModuleChineseName = "留言"
		Case Else : GetModuleChineseName = "首页"
		End Select
	End Function

	Public Function GetChannelName(sChannelID)
		sChannelID = Clng(sChannelID)
		if sChannelID < 0 Then GetChannelName = "所有频道" : Exit Function
		If Application(CacheName&"_channellist").documentElement.selectSingleNode("channel[@channelid="&sChannelID&"]") Is Nothing Then Exit Function
		GetChannelName = Application(CacheName&"_channellist").documentElement.selectSingleNode("channel[@channelid="&sChannelID&"]/@channelname").text
	End Function

	Public Function GetClassName(sClassID)
		sClassID = Clng(sClassID)
		if sClassID <= 0 Then GetClassName = "所有栏目" : Exit Function
		If Application(CacheName&"_classlist").documentElement.selectSingleNode("class[@classid="&sClassID&"]") Is Nothing Then Exit Function
		GetClassName = Application(CacheName&"_classlist").documentElement.selectSingleNode("class[@classid="&sClassID&"]/@classname").text
	End Function

	Public Function GetClassLinkUrl(sClassID)
		sClassID = Clng(sClassID)
		if sClassID <= 0 Then GetClassLinkUrl = InstallDir & "Index.asp" : Exit Function
		If Application(CacheName&"_classlist").documentElement.selectSingleNode("class[@classid="&sClassID&"]") Is Nothing Then Exit Function
		GetClassLinkUrl = Application(CacheName&"_classlist").documentElement.selectSingleNode("class[@classid="&sClassID&"]/@linkurl").text
	End Function

	Public Function GetDefaultTemplateID(sModuleID,sTypeID,sProjectID)
		If sProjectID = 0 Then sProjectID = Cl.ProjectID
		If Not IsObject(Application(CacheName & "_defaulttemplateidlist_" & sProjectID)) Then Call Load_DefaultTemplateID(sProjectID)
		'Application(CacheName & "_defaulttemplateid_" & sProjectID).Save(Server.MapPath("/defaulttemplateid_" & sProjectID&".xml"))
		Dim Node
		If sModuleID>0 And ChannelID>0 Then
			Set Node = Application(CacheName&"_defaulttemplateidlist_" & sProjectID).documentElement.selectSingleNode("template[@moduleid="&sModuleID&" and @typeid="&sTypeID&" and @channelid="&ChannelID&"]")
			If Node Is Nothing Then
				Set Node = Application(CacheName&"_defaulttemplateidlist_" & sProjectID).documentElement.selectSingleNode("template[@moduleid="&sModuleID&" and @typeid="&sTypeID&"]")
			End if
		Else
			Set Node = Application(CacheName&"_defaulttemplateidlist_" & sProjectID).documentElement.selectSingleNode("template[@moduleid="&sModuleID&" and @typeid="&sTypeID&"]")
		End if
		If Node Is Nothing Then
			Response.write("找不到指定模版(ProjectID="&sProjectID&",ModuleID="&sModuleID&",ChannelID="&ChannelID&",TypeID="&sTypeID&")")
			Response.end
		End If
		GetDefaultTemplateID = Node.selectsingleNode("@templateid").text
		Set Node = Nothing
	End Function

	Public Sub Load_DefaultTemplateID(sProjectID)
		Dim Rs
		Set Rs = Cl.Execute("Select TemplateID,ModuleID,TypeID,ChannelID,ProjectID From Cl_Template Where ProjectID="&CLng(sProjectID)&" and IsDefault="&TrueType&" Order By TemplateID desc")
		Application.Lock
		Set Application(CacheName & "_defaulttemplateidlist_" & sProjectID) = RecordsetToxml(Rs,"template","templatelist")
		Application.UnLock
		Rs.Close : Set Rs=Nothing
	End Sub
	Public Sub Load_DefaultCssID()
		Dim Rs
		Set Rs = Cl.Execute("Select CssID,ProjectID From Cl_Css Where IsDefault="&TrueType&" Order By CssID desc")
		Application.Lock
		Set Application(CacheName & "_defaultcssidlist") = RecordsetToxml(Rs,"css","csslist")
		Application.UnLock
		Rs.Close : Set Rs=Nothing
	End Sub
	Public Function GetDefaultCssID(sProjectID)
		If sProjectID = 0 Then sProjectID = Cl.ProjectID
		If Not IsObject(Application(CacheName & "_defaultcssidlist")) Then Call Load_DefaultCssID()
		Dim Node
		Set Node = Application(CacheName&"_defaultcssidlist").documentElement.selectSingleNode("css[@projectid="&sProjectID&"]")
		If Node Is Nothing Then
			Response.write("找不到指定Css(ProjectID="&sProjectID&")")
			Response.end
		End If
		GetDefaultCssID = Node.selectsingleNode("@cssid").text
		Set Node = Nothing
	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 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 "<span style='font-size:12px;'>执行查询代码时发现错误。</span>"
			Response.write Command
			ExecuteErr
		End If
		SqlQueryNum=SqlQueryNum+1
	End Function
	Public Function Execute_U(Command)
		If UserTableType = "Aspoo" Then
			Set Execute_U = Execute(Command)
		Else
			If Not IsObject(Conn_U) Then OpenConn_U
			On Error Resume Next
			Set Execute_U = Conn_U.Execute(Command)
			If Err Then
				Conn_U.Close : Set Conn_U = Nothing
				Response.Write "<span style='font-size:12px;'>执行查询代码时发现错误。</span>"
				Response.write Command
				ExecuteErr
			End If
			SqlQueryNum=SqlQueryNum+1
		End if
	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
			Conn_L.Close : Set Conn_L = Nothing
			Response.Write "<span style='font-size:12px;'>执行查询代码时发现错误。</span>"
			Response.write Command
			ExecuteErr
		End If
		SqlQueryNum=SqlQueryNum+1
	End Function
	Public Sub ExecuteErr()
		Response.Write "<span style='font-size:12px;'><br />"
		Response.Write "错 误 号：" & Err.Number & "<br />"
		Response.Write "错误描述：" & Err.Description & "<br />"
		Response.Write "错误来源：" & Err.Source & "</span>"
		Err.Clear
		Response.end
	End Sub
	'记录错误事件
	Public Sub SaveSQLLOG(sSqlType,sCommand)
		Dim StrType,sTemp,ErrNum,IPstr
		ErrNum = GetClng(Session("ErrNum")) + 1
		Session("ErrNum") = ErrNum
		if ErrNum >= 3 then
			IPstr = Cstr(UserTrueIP)
			If IPstr<>"" And Trim(CacheData(9,0))<>"" Then
				CacheData(9,0)=Replace(Trim(CacheData(9,0)),IPstr,"")
				CacheData(9,0)=Replace(CacheData(9,0),"||","|")
				IPstr=CacheData(9,0) & "|" & Replace(IPstr,"|","")
			End If
			if IPstr<>"" and ErrNum<5 then
				Execute("update Cl_Setup set LockIP='"&replace(IPstr,"'","''")&"'")
				Load_Setup
			end if
			Session("ErrNum") = 5
			Response.write "您执行了非法操作次数已经超过3次，IP已封！"
			Response.write "<meta http-equiv=""Refresh"" content=""2; url=" & Request.ServerVariables("script_name") & """ />"
			Response.end
		end if
		Select Case CInt(sSqlType)
		Case 2 : StrType="SQL注入(POST)"
		Case 3 : StrType="SQL注入(GET)"
		Case 4 : StrType="SQL注入(Cookies)"
		Case Else : StrType="非法查询管理员表"
		End Select
		Execute_L("insert into [Cl_SqlLog] (ScriptName,S_Info,ip,Type) values ('"&Server.URLEnCode(Request.ServerVariables("PATH_INFO"))&"','"&Checkstr(Server.HTMLEnCode(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,Chr(0),""),".","")
		'strChar = Replace(Replace(strChar,"/",""),"\","")
		ReplaceBadChar = strChar
	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