📄 cl_function_public.asp

📁 淘客网上商店网站程序淘客网上商店网站程序淘客网上商店网站程序
💻 ASP
📖 第 1 页 / 共 4 页
字号:
			sTemp = sTemp & "<li><span class='title'><a href='" & LinkUrl & "' title='"&Rs(3)&"' target='_blank'>" & Cl.GotTopic(Rs(3),TitleLen) & "</a></span>"
			if ShowHits=True then
			sTemp = sTemp & "(<span class='hits'>" & Rs(5) & "</span>)"
			end if
			sTemp = sTemp & "</li>"
			Rs.movenext
		loop
	end if
	Rs.close:set Rs=Nothing
	ShowCorrelative = sTemp & "</ul>"
End Function

'显示所有栏目（树形目录效果）(预留)
Function ShowClass_Tree(Byval sChannelID)
	dim rsClass,sqlClass,tmpDepth,i,j
	sqlClass="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,Depth,NextID,IsOuter,LinkUrl,Child From Cl_Class where ChannelID="&Cint(sChannelID)&" and order by RootID,OrderID"
	set rsClass=Cl.Execute(sqlClass)
	if rsClass.bof and rsClass.eof then
		ShowClass_Tree="没有任何栏目"
		rsClass.close:set rsClass=Nothing : Exit Function
	End if
	dim arrShowLine(20),strClassTree
	for i=0 to ubound(arrShowLine)
		arrShowLine(i)=False
	next
	sqlClass = rsClass.GetRows(-1)
	rsClass.close:set rsClass=Nothing
	For i=0 to Ubound(sqlClass,2)
		tmpDepth=sqlClass(5,i)
		if sqlClass(6,i)>0 then
			arrShowLine(tmpDepth)=True
		else
			arrShowLine(tmpDepth)=False
		end if
		if tmpDepth>0 then
			for j=1 to tmpDepth
				if j=tmpDepth then
					if sqlClass(6,i)>0 then
						strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line1.gif"" width=""17"" height=""16"" valign=""abvmiddle"" alt="""" />"
					else
						strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line2.gif"" width=""17"" height=""16"" valign=""abvmiddle"" alt="""" />"
					end if
				else
					if arrShowLine(j)=True then
						strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line3.gif"" width=""17"" height=""16"" valign=""abvmiddle"" alt="""" />"
					else
						strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line4.gif"" width=""17"" height=""16"" valign=""abvmiddle"" alt="""" />"
					end if
				end if
			next
		end if
		if sqlClass(9,i)>0 then 
			strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/folder4.gif"" width=""15"" height=""15"" valign=""abvmiddle"" alt="""" />"
		else 
			strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/folder3.gif"" width=""15"" height=""15"" valign=""abvmiddle"" alt="""" />"
		end if 
		if sqlClass(7)=1 then
			strClassTree=strClassTree & "<a href=""" & sqlClass(8,i) & """ target=""_blank"">"
		else
			strClassTree=strClassTree & "<a href=""" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel.selectSingleNode("@createpathtype").text,Cl.HtmlDir,Cl.Channel.selectSingleNode("@channeldir").text,sqlClass(2,i),sqlClass(0,i),sqlClass(4,i),sqlClass(3,i),Cl.Channel.selectSingleNode("@iscreatehtml").text,Cl.Channel.selectSingleNode("@createfileext").text) & """>"
		end if
		if sqlClass(5,i)=0 then 
			strClassTree=strClassTree & "<b>"  & sqlClass(1,i) & "</b>"
		else
			strClassTree=strClassTree & sqlClass(1,i)
		end if 
		strClassTree=strClassTree & "</a>"
		if sqlClass(9,i)>0 then 
			strClassTree=strClassTree & "（" & sqlClass(9,i) & "）" 
		end if 
		strClassTree=strClassTree & "<br />"
	Next
	ShowClass_Tree=strClassTree
	sqlClass=Empty
End Function

'===============================================================
'显示当前栏目的下一级子栏目
'过程：ShowChildClass(sChannelID,sClassID,sTopNum,ShowType)
'参数：
'	sChannelID   ----- 频道ID
'	sClassID-----------栏目ID
'	sTopNum		------ 显示个数
'	ShowType	------ 显示方式(0,<li>每个栏目一行)
'===============================================================
Function ShowChildClass(Byval sChannelID,Byval sClassID,Byval sTopNum,Byval ShowType)
	Dim Node,Rs,n,sTemp
	sChannelID	= Cl.GetClng(sChannelID)
	sClassID	= Cl.GetClng(sClassID)
	sTopNum		= Cl.GetClng(sTopNum)
	Set Rs = Application(Cl.CacheName & "_classlist").DocumentElement.selectNodes("class[@channelid="&sChannelID&"][@parentid="&sClassID&"]")
	if Rs Is Nothing then
		ShowChildClass="<li>没有子栏目</li>" : Exit Function
	End if
	n=0 : sTemp="<ul>"
	For Each Node In Rs
		n=n+1
		sTemp=sTemp & "<li><a href=""" & Node.selectSingleNode("@linkurl").text & """>" & Node.selectSingleNode("@classname").text & "</a>"
		if CLng(Node.selectSingleNode("@child").text)>0 then sTemp=sTemp & "(" & Node.selectSingleNode("@child").text & ")"
		sTemp=sTemp & "</li>"
		If n>=sTopNum Then Exit For
	Next
	sTemp=sTemp & "</ul>"
	ShowChildClass=sTemp
End Function
'===============================================================
'显示栏目导航
'过程：ShowClassNavigation(sChannelID,sClassID,sCol)
'参数：
'	sChannelID   ----- 频道ID
'	sClassID-----------栏目ID
'	sCol		------ 几列换行
'===============================================================
Function ShowClassNavigation(Byval sChannelID,Byval sClassID,Byval sCol)
	Dim SQL,Rs,sTemp,PrevRootID,i,n
	sChannelID=Cl.GetClng(sChannelID)
	sClassID=Cl.GetClng(sClassID)
	sCol=Cl.GetClng(sCol)
	if sClassID>0 then
		Set Rs = Application(Cl.CacheName & "_classlist").DocumentElement.selectNodes("class[@channelid="&sChannelID&"][@classid="&sClassID&"]")
	Else
		Set Rs = Application(Cl.CacheName & "_classlist").DocumentElement.selectNodes("class[@channelid="&sChannelID&"][@depth=0]")
	End if
	if Rs Is Nothing then
		ShowClassNavigation="<li>没有任何栏目</li>" : Exit Function
	End If
	if sCol=0 then sCol=6
	Dim Node, tNode
	sTemp="<ul>"
	For Each Node In Rs
		sTemp=sTemp & "<li><span class=""parentclass"">【<a href=""" & Node.selectSingleNode("@linkurl").text & """>" & Node.selectSingleNode("@classname").text & "</a>】</span>"
		sTemp=sTemp & "<span class=""childclass"">"
		n=1
		For Each tNode In Application(Cl.CacheName & "_classlist").DocumentElement.selectNodes("class[@parentid="&Node.selectSingleNode("@classid").text&"]")
			sTemp=sTemp & "<a href=""" & tNode.selectSingleNode("@linkurl").text & """>" & tNode.selectSingleNode("@classname").text & "</a>&nbsp;&nbsp;"
			if n>=sCol then
				n=1 : sTemp=sTemp & "</span></li><li><span class=""parentclass"">&nbsp;</span><span class=""childclass"">"
			else
				n=n+1
			end if
		Next
		sTemp=sTemp & "</span></li>"
	Next
	ShowClassNavigation = sTemp & "</ul>"
End Function

'===============================================================
'过程名：ShowSearchForm(sChannelID,ShowType)
'参 数：
'		sChannelID	----	频道ID
'		ShowType	----	显示方式 1简,2标,3(带栏目),4(带专题),5(带栏目+专题)
'===============================================================
Function ShowSearchForm(Byval sChannelID,Byval ShowType)
	sChannelID	= Cl.GetClng(sChannelID)
	ShowType	= Cl.GetClng(ShowType)
	Cl.Load_ChannelSetting(sChannelID)
	Dim sTemp
	'sTemp="<div class=""searchform"">"
	sTemp=sTemp & "<form action=""" & Cl.WebDir & "SearchAdv.asp"" method=""post"" name=""SearchForm"" id=""SearchForm"">"
	'sTemp=sTemp & "<ul><li>"
	Select Case ShowType
	Case 0, 1
		sTemp=sTemp & "<input type=""hidden"" name=""field"" value=""Title"" />"
	Case 2
		sTemp=sTemp & ShowSearchField(Cl.Channel.selectSingleNode("@moduleid").text,Cl.Channel.selectSingleNode("@channelitemname").text)
	Case 3
		sTemp=sTemp & ShowSearchField(Cl.Channel.selectSingleNode("@moduleid").text,Cl.Channel.selectSingleNode("@channelitemname").text)
		sTemp=sTemp & "&nbsp;<select name=""ClassID""><option value="""">所有栏目</option>"
		sTemp=sTemp & ShowClass_Option(sChannelID,0,2,3) & "</select>"
	Case 4
		sTemp=sTemp & ShowSearchField(Cl.Channel.selectSingleNode("@moduleid").text,Cl.Channel.selectSingleNode("@channelitemname").text)
		sTemp=sTemp & "&nbsp;<select name=""SpecialID"">"
		sTemp=sTemp & ShowSpecial_Option(sChannelID,0,1) & "</select>"
	Case 5
		sTemp=sTemp & ShowSearchField(Cl.Channel.selectSingleNode("@moduleid").text,Cl.Channel.selectSingleNode("@channelitemname").text)
		sTemp=sTemp & "&nbsp;<select name=""ClassID""><option value="""">所有栏目</option>"
		sTemp=sTemp & ShowClass_Option(sChannelID,0,2,3) & "</select>"
		sTemp=sTemp & "&nbsp;<select name=""SpecialID"">"
		sTemp=sTemp & ShowSpecial_Option(sChannelID,0,1) & "</select>"
	End Select
	sTemp=sTemp & "&nbsp;<input type=""text"" name=""keyword"" size=""18"" value=""关键字"" maxlength=""50"" onFocus=""this.select();"" />&nbsp;"
	sTemp=sTemp & "<input type=""submit"" name=""Submit""  value=""搜索"" />"
	sTemp=sTemp & "<input type=""hidden"" name=""Action""  value=""Do"" />"
	sTemp=sTemp & "<input type=""hidden"" name=""ChannelID""  value="""&sChannelID&""" />"
	sTemp=sTemp & "<input type=""hidden"" name=""ModuleID""  value="""&Cl.Channel.selectSingleNode("@moduleid").text&""" />"
	sTemp=sTemp & "</form>"'</div>"
	ShowSearchForm=sTemp
End Function

Function ShowSearchField(Byval sModuleID,Byval sItemName)
	Dim sTemp
	sTemp="<select name=""Field"" size=""1"">"
	sTemp=sTemp & "<option value=""ID"">"&sItemName&"ID</option>"
	sTemp=sTemp & "<option value=""Title"" selected>"&sItemName&"标题</option>"
	sTemp=sTemp & "<option value=""Keyword"">关 键 字</option>"
	sTemp=sTemp & "<option value=""Intro"">"&sItemName&"简介</option>"
	sTemp=sTemp & "<option value=""Editor"">添加用户</option>"
	sTemp=sTemp & "<option value=""Censor"">审核用户</option>"
	sTemp=sTemp & "<option value=""Point"">"&sItemName&Cl.Web_Setting(28)&"</option>"
	select case Clng(sModuleID)
	case 1
		sTemp=sTemp & "<option value=""CopyFrom"">"&sItemName&"来源</option>"
		sTemp=sTemp & "<option value=""Author"">"&sItemName&"作者</option>"
	case 2
		sTemp=sTemp & "<option value=""Author"">"&sItemName&"作者</option>"
	case 3
		sTemp=sTemp & "<option value=""Author"">"&sItemName&"作者</option>"
	case 4
		sTemp=sTemp & "<option value=""Director"">"&sItemName&"导演</option>"
		sTemp=sTemp & "<option value=""ActName"">"&sItemName&"主演</option>"
	case 5
		sTemp=sTemp & "<option value=""Producer"">生 产 商</option>"
		sTemp=sTemp & "<option value=""Trademark"">品牌商标</option>"
		sTemp=sTemp & "<option value=""ProductModel"">"&sItemName&"型号</option>"
		sTemp=sTemp & "<option value=""MarketPrice"">"&sItemName&"价格</option>"
	end select
	ShowSearchField=sTemp & "</select>"
	sTemp=Empty
End Function

Function ShowRootClass(sChannelID,sRootID)
	Dim XmlDom,sTemp,Node,n
	Set XmlDom = Application(Cl.CacheName & "_classlist").DocumentElement.SelectNodes("class[@channelid="&sChannelID&"][@parentid=0][@isouter=0]")
	if XmlDom Is Nothing then 
		sTemp="还没有任何栏目，请首先添加栏目。"
	else
		n = 0
		For Each Node In XmlDom
			if CLng(Node.SelectSingleNode("@rootid").text)=sRootID then
				sTemp = sTemp & "<a href=""" & FileName & "&ClassID=" & Node.SelectSingleNode("@classid").text & """ style=""color:red;""><b>" & Node.SelectSingleNode("@classname").text & "</b></a>"
			else
				sTemp = sTemp & "<a href=""" & FileName & "&ClassID=" & Node.SelectSingleNode("@classid").text & """>" & Node.SelectSingleNode("@classname").text & "</a>"
			end If
			n = n + 1
			if n mod 8=0 then
				sTemp=sTemp&"<br />"
			else
				sTemp=sTemp&"&nbsp;|&nbsp;"
			end if
		Next
		Set Node=Nothing
		Set XmlDom=Nothing
	end if
	ShowRootClass=sTemp
	sTemp=Empty
End Function

Function ShowClass_Option(Byval sChannelID,Byval CurrentID,Byval sDepth,Byval ShowType)
	Dim XmlDom,sTemp,tmpDepth,i,n
	Dim arrShowLine(10)
	CurrentID	= Clng(CurrentID)
	ShowType	= Clng(ShowType)
	sChannelID	= Clng(sChannelID)
	sDepth		= Clng(sDepth)
	for i=0 to ubound(arrShowLine)
		arrShowLine(i)=False
	next
	if ShowType=0 then
		sTemp="<option value=""0"""
		if CurrentID=0 then sTemp=sTemp & " selected"
		sTemp=sTemp & ">无（作为一级栏目）</option>"
	end if
	if sDepth>0 then
		set XmlDom = Application(Cl.CacheName & "_classlist").DocumentElement.SelectNodes("class[@channelid="&sChannelID&"][@depth<"&sDepth&"]")
	else
		set XmlDom = Application(Cl.CacheName & "_classlist").DocumentElement.SelectNodes("class[@channelid="&sChannelID&"]")
	end if
	if XmlDom Is Nothing then
		ShowClass_Option = sTemp & "<option value="""">请先添加栏目</option>"
		Exit Function
	End if
	Dim sChecked, sTClassName, sTPurview, Node
	sTPurview=False
	For Each Node In XmlDom
		'ClassID,ClassName,Depth,NextID,IsOuter,Child
		tmpDepth=CLng(Node.SelectSingleNode("@depth").text)
		if CLng(Node.SelectSingleNode("@nextid").text)>0 then
			arrShowLine(tmpDepth)=True
		else
			arrShowLine(tmpDepth)=False
		end if
		sChecked = "" : sTClassName = ""
		if CLng(Node.SelectSingleNode("@classid").text)=CurrentID then sChecked = " selected"
		if tmpDepth>0 then
			for n=1 to tmpDepth
				sTClassName = sTClassName & "&nbsp;&nbsp;" 
				if n=tmpDepth then
					if CLng(Node.SelectSingleNode("@nextid").text)>0 then
						sTClassName = sTClassName & "├&nbsp;"
					else
						sTClassName = sTClassName & "└&nbsp;"
					end if
				else
					if arrShowLine(n)=True then
						sTClassName = sTClassName & "│"
					else
						sTClassName = sTClassName & "&nbsp;"
					end if
				end if
			next
		ElseIf ShowType<>3 then
		sTPurview=Cl.TrueClassPurview_U(3,sChannelID,Node.SelectSingleNode("@classid").text)
		end if
		sTClassName = sTClassName & Node.SelectSingleNode("@classname").text
		Select Case ShowType
		Case 0
			sTemp=sTemp & "<option value=""" & Node.SelectSingleNode("@classid").text & """ "&sChecked&">" & sTClassName
			if CLng(Node.SelectSingleNode("@isouter").text)=1 then sTemp=sTemp & "(外)"
			sTemp=sTemp & "</option>"
		Case 1
			if CLng(Node.SelectSingleNode("@isouter").text)=1 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName & "(外)"
			elseif CLng(Node.SelectSingleNode("@child").text)>0 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName
			else
				sTemp=sTemp & "<option value=""" & Node.SelectSingleNode("@classid").text & """ "&sChecked&">" & sTClassName
			end if
			sTemp=sTemp & "</option>"
		Case 2
			if Not sTPurview then
				sTPurview=Cl.TrueClassPurview_U(3,sChannelID,Node.SelectSingleNode("@classid").text)
			end if
			if CLng(Node.SelectSingleNode("@isouter").text)=1 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName & "(外)"
			elseif CLng(Node.SelectSingleNode("@child").text)>0 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName
			elseif Not sTPurview then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName & "(*)"
			else
				sTemp=sTemp & "<option value=""" & Node.SelectSingleNode("@classid").text & """ "&sChecked&">" & sTClassName
			end if
			sTemp=sTemp & "</option>"
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -