📄 cl_function_public.asp

📁 淘客网上商店网站程序淘客网上商店网站程序淘客网上商店网站程序
💻 ASP
📖 第 1 页 / 共 4 页
字号:
上一页 1 2 34
		Case 3
			if CLng(Node.SelectSingleNode("@isouter").text)=0 then
				sTemp=sTemp & "<option value=""" & Node.SelectSingleNode("@classid").text & """ "&sChecked&">" & sTClassName & "</option>"
			end if
		Case 4
			if Not sTPurview then
				sTPurview=Cl.TrueClassPurview_U(3,sChannelID,Node.SelectSingleNode("@classid").text)
			end if
			if CLng(Node.SelectSingleNode("@child").text)>0 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName & "(*)"
			elseif sTPurview then
				sTemp=sTemp & "<option value=""" & Node.SelectSingleNode("@classid").text & """ "&sChecked&">" & sTClassName
			end if
			sTemp=sTemp & "</option>"
		Case else
			sTemp=sTemp & "<option value=""" & Node.SelectSingleNode("@classid").text & """ "&sChecked&">" & sTClassName & "</option>"
		End Select
	Next
	ShowClass_Option=sTemp
	Set Node = Nothing
	Set XmlDom = Nothing
	sTemp = Empty
End Function

Function ShowManageClassPath(Byval sChannelID,Byval sClassName,Byval sParentPath,Byval iDepth)
	dim sTemp
	if iDepth<=0 then ShowManageClassPath = sClassName : Exit Function
	dim sqlPath,rsPath,i
	sqlPath="select ClassID,ClassName,Depth From Cl_Class where ChannelID="&Clng(sChannelID)&" and ClassID in (" & sParentPath & ") order by Depth"
	set rsPath=Cl.Execute(sqlPath)
	do while not rsPath.eof
		for i=1 to rsPath("Depth")
			sTemp= sTemp & "&nbsp;&nbsp;&nbsp;"
		next
		if rsPath("Depth")>0 then
			sTemp= sTemp & "└"
		end if
		sTemp= sTemp & rsPath("ClassName") & "<br />"
		rsPath.movenext
	loop
	Set rsPath=Nothing
	if iDepth>0 and sClassName<>"" then
		for i=1 to iDepth
			sTemp= sTemp & "&nbsp;&nbsp;&nbsp;"
		next
		sTemp= sTemp & "└" & sClassName
	end if
	ShowManageClassPath = sTemp
	sTemp=Empty
End Function

Function ShowManageChild(Byval sChannelID,Byval sClassID)
	dim sqlChild,rsChild,sTemp,i
	sqlChild = "select ClassID,ClassName,Child From Cl_Class where ChannelID="&Cint(sChannelID)&" and ParentID=" & sClassID & " order by OrderID"
	Set rsChild = Cl.Execute(sqlChild)
	If rsChild.bof and rsChild.eof then
		ShowManageChild = ""
		rsChild.Close : Set rsChild = Nothing : Exit Function
	End If
	sqlChild=rsChild.GetRows(-1)
	rsChild.Close : Set rsChild = Nothing
	sTemp = " &gt;&gt; "
	For i=0 to Ubound(sqlChild,2)
		sTemp = sTemp & "<a href=""" & FileName & "&ClassID=" & sqlChild(0,i) & """>" & sqlChild(1,i) & "</a>"
		if sqlChild(2,i)>0 then sTemp = sTemp & "(" & sqlChild(2,i) & ")"
		if (i+1) mod 8=0 then
			sTemp = sTemp & "<br />"
		else
			sTemp = sTemp & "&nbsp;&nbsp;"
		end if
	Next
	ShowManageChild=sTemp
	sqlChild=Empty
End Function

Function ShowRootSpecial(Byval sChannelID,Byval sSpecialID)
	Dim XmlDom,sTemp,n,Node
	Set XmlDom = Application(Cl.CacheName & "_speciallist").DocumentElement.SelectNodes("special[@channelid=-1 or @channelid="&sChannelID&"]")
	if XmlDom Is Nothing then
		sTemp="没有任何专题"
	else
		For Each Node In XmlDom
			if CLng(Node.SelectSingleNode("@specialid").text)=sSpecialID then
				sTemp=sTemp&"<a href=""" & FileName & "&SpecialID=" & Node.SelectSingleNode("@specialid").text & """ style=""color:red;""><b>" & Node.SelectSingleNode("@specialname").text & "</b></a>"
			else
				sTemp=sTemp&"<a href=""" & FileName & "&SpecialID=" & Node.SelectSingleNode("@specialid").text & """>" & Node.SelectSingleNode("@specialname").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
	end if
	ShowRootSpecial=sTemp
	sTemp = Empty
	Set XmlDom = Nothing
End Function

Function ShowSpecial_Option(Byval sChannelID,Byval sSpecialID,Byval ShowType)
	Dim XmlDom,sTemp
	ShowType	= Clng(ShowType)
	sChannelID	= Clng(sChannelID)
	sTemp = "<option value=""0"""
	if sSpecialID="0" then sTemp = sTemp & " selected"
	sTemp = sTemp & ">不指定专题</option>"
	if sChannelID > 0 then
		set XmlDom = Application(Cl.CacheName & "_speciallist").DocumentElement.SelectNodes("special[@channelid=-1 or @channelid="&sChannelID&"]")
	else
		set XmlDom = Application(Cl.CacheName & "_speciallist").DocumentElement.SelectNodes("special[@channelid=-1]")
	end If
	if Not (XmlDom Is Nothing) then
		Dim Node
		For Each Node In XmlDom
		if Cl.ChkUserGroupID(Node.SelectSingleNode("@addgroup").text,Cl.UserGroupID) or ShowType=1 then
			if Instr(","&sSpecialID&",",","&Node.SelectSingleNode("@specialid").text&",")>0 then
				sTemp = sTemp & "<option value=""" & Node.SelectSingleNode("@specialid").text & """ selected>" & Node.SelectSingleNode("@specialname").text & "</option>"
			else
				sTemp = sTemp & "<option value=""" & Node.SelectSingleNode("@specialid").text & """>" & Node.SelectSingleNode("@specialname").text & "</option>"
			end if
		end if
		Next
		Set Node = Nothing
	end if
	Set XmlDom = Nothing
	ShowSpecial_Option = sTemp
End Function

'=================================================
'显示专题名称:ShowSpecial(sChannelID,TopNum)
'sChannelID		----- (频道ID，为区分链接)
'TopNum			----- (最多显示多少个专题名称)
'=================================================
Function ShowSpecial(Byval sChannelID,Byval TopNum)
	Dim XmlDom, sTemp, Node
	TopNum		= Cl.GetClng(TopNum)
	sChannelID	= Cl.GetClng(sChannelID)
	if TopNum = 0 then TopNum = 10
'	if sChannelID = 0 then sChannelID = 1
	if sChannelID > 0 then
		set XmlDom = Application(Cl.CacheName & "_speciallist").DocumentElement.SelectNodes("special[@channelid=-1 or @channelid="&sChannelID&"]")
	else
		set XmlDom = Application(Cl.CacheName & "_speciallist").DocumentElement.SelectNodes("special[@channelid=-1]")
	end If
	if XmlDom Is Nothing then
		ShowSpecial= "&nbsp;没有任何专题"
	else
		If ChannelID=0 then
			Cl.Load_ChannelSetting(1)
			For Each Node In XmlDom
				sTemp = sTemp & "<li><a href=""" & Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text & "/ShowSpecial.asp?SpecialID=" & Node.SelectSingleNode("@specialid").text & """>" & Node.SelectSingleNode("@specialname").text & "</a></li><br />"
			Next
		Else
			Cl.Load_ChannelSetting(sChannelID)
			For Each Node In XmlDom
				sTemp = sTemp & "<li><a href=""" & Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text & "/ShowSpecial.asp?SpecialID=" & Node.SelectSingleNode("@specialid").text & """>" & Node.SelectSingleNode("@specialname").text & "</a></li><br />"
			Next
		End if
		ShowSpecial=sTemp & "<p align=""right""><a href=""" & Cl.WebDir & "SpecialList.asp?ChannelID="&sChannelID&""">更多专题</a></p>"
		Set Node = Nothing
	end If
	Set XmlDom = Nothing
End Function

Sub Special_Setting()
	SpecialID = Cl.GetClng(request("SpecialID"))
	if SpecialID>0 Then
		Dim Node
		Set Node = Application(Cl.CacheName & "_speciallist").DocumentElement.SelectSingleNode("special[@specialid="&SpecialID&"]")
		if Node Is Nothing Then
			Call Cl.OutErr(0,Cl.Language.selectSingleNode("//ClassNoFind").text)
		End if
		SpecialName = Node.SelectSingleNode("@specialname").text
		Set Node = Nothing
	end if
End Sub
'==============================================

Sub RefreshClassMenuJs()
	Dim Node
	For Each Node In Application(Cl.CacheName & "_channellist").DocumentElement.SelectNodes("channel[@channeltype<2][@channelid!=0][@channelid!=6]")
		ChannelID = Node.SelectSingleNode("@channelid").text
		Cl.MakeHtml Template.GetClassMenu(ChannelID),Cl.WebDir&"Js/ClassMenu/ClassMenu_" & ChannelID & ".Js"
	Next
End Sub

Sub CreateClassJs(sChannelID)
	Cl.Load_ChannelSetting(sChannelID)
	'Cl.LoadTemplates("")
	Cl.MakeHtml Template.GetClassMenu(sChannelID),Cl.WebDir&"Js/ClassMenu/ClassMenu_" & sChannelID & ".Js"
	dim strSearchDate,i
	for i=3 to 5
	strSearchDate=Replace(Cl.ReplaceDir(ShowSearchForm(sChannelID,i)),chr(34),"\"&chr(34))
	strSearchDate="document.write (""" & Replace(strSearchDate,vbcrlf,"\n") & """);"
	Cl.MakeHtml strSearchDate,Cl.WebDir&"Js/Search/Search" & sChannelID & "_" & i & ".Js"
	next
End Sub

'==================================================================
'过程：Wap(sChannelID,sClassID)
'参数：
'	sChannelID		------  频道ID
'	sClassID		------  栏目ID
'==================================================================
Function Wap(sChannelID,sClassID)
		Dim sUrl
		If sChannelID<>"0" Then
			If sClassID=0 Then
				sUrl="&ChannelID="&sChannelID&""
			Else
				sUrl="&ChannelID="&sChannelID&"&ClassID="&sClassID&""
			End if
		Else
			sUrl=""
		End if
		Wap = "<a href=""" &InstallDir& "Help.asp?Action=wap"& sUrl &""" title=""欢迎使用本站Wap"">"
		Wap = Wap & "<img src="""&InstallDir&"Images/Wap.gif"" width=""31"" height=""11"" border=""0"" alt="""" />"
		Wap = Wap & "</a>"
End Function
'==================================================================
'过程：Rss(sChannelID,sClassID)
'参数：
'	sChannelID		------  频道ID
'	sClassID		------  栏目ID
'==================================================================
Function Rss(sChannelID,sClassID)
		Dim sUrl
		If sChannelID<>0 Then
			If sClassID=0 Then
				sUrl="?ChannelID="&sChannelID&""
			Else
				sUrl="?ChannelID="&sChannelID&"&ClassID="&sClassID&""
			End if
		Else
			sUrl=""
		End if
		Rss = "<a href=""" &InstallDir& "Rssfeed.asp"& sUrl &""" title=""欢迎使用本站Rss"">"
		Rss = Rss & "<img src="""&InstallDir&"Images/Rss.gif"" width=""31"" height=""11"" border=""0"" alt="""" />"
		Rss = Rss & "</a>"
End Function
'显示自定义字段
Function ShowField(AddType,ItemID,ModuleID)
	Dim TempStr,RsField,FieldValue,Options,Item
	If AddType<>"Add" Then
	Dim RsContent
	Select Case ModuleID
	Case 1
		Set RsContent=Cl.execute("Select * From Cl_Article Where InfoID="&ItemID&"")
	Case 2
		Set RsContent=Cl.execute("Select * From Cl_Soft Where InfoID="&ItemID&"")
	Case 3
		Set RsContent=Cl.execute("Select * From Cl_Photo Where InfoID="&ItemID&"")
	Case 4
		Set RsContent=Cl.execute("Select * From Cl_Movie Where InfoID="&ItemID&"")
	Case 5
		Set RsContent=Cl.execute("Select * From Cl_Product Where InfoID="&ItemID&"")
	Case else
		Exit Function
	End Select
	End if
	Set RsField=Cl.Execute("Select * From Cl_Field Where IsShow=1 And ModuleID="&ModuleID)
	Do While Not RsField.eof
		If Instr(","& RsField("arrChannelID") &",",","& ChannelID &",") > 0 Then
			TempStr=TempStr&"<tr class='tdbg'>"
			TempStr=TempStr&"<td width='100' align='right'><strong>"& RsField("FieldTitle") &"：</strong></td><td colspan='2'>"
			If AddType="Add" Then
				FieldValue= RsField("DefaultValue")
			Else
				FieldValue= RsContent(trim(RsField("FieldName")))
			End If
			Select Case RsField("FieldType")
			Case 1
				TempStr=TempStr&"<input name='"& RsField("FieldName") &"' type='text' size='100' maxlength='255' Value='"& FieldValue &"'>"
			Case 2
				TempStr=TempStr&"<textarea name='"& RsField("FieldName") &"' cols='40' rows='3' id='"& RsField("FieldName") &"'>"& FieldValue &"</textarea><a href=""javascript:admin_Size(-3,'"& RsField("FieldName") &"')""><img src=""images/minus.gif"" unselectable=""on"" border='0'></a> <a href=""javascript:admin_Size(3,'"& RsField("FieldName") &"')""><img src=""images/plus.gif"" unselectable=""on"" border='0'></a>"
			Case 3
				Options=Split(RsField("Options"),VbCrlf)
				TempStr=TempStr&"<select name="""& RsField("FieldName") &""" id="""& RsField("FieldName") &""">"
				for each Item in Options
					If Item=FieldValue Then
						TempStr=TempStr&"<option value="""& Item &""" selected>"& Item &"</option>"
					Else
						TempStr=TempStr&"<option value="""& Item &""">"& Item &"</option>"
					End If
				next
				TempStr=TempStr&"</select>"
			Case 4
				TempStr=TempStr&"<input name='"& RsField("FieldName") &"' type='text' size='40' maxlength='50' Value='"& FieldValue &"'>"
			Case 5
				TempStr=TempStr&"<input name='"& RsField("FieldName") &"' type='text' size='40' maxlength='50' Value='"& FieldValue &"' onfocus=""show_cele_date("& RsField("FieldName") &",'','',"& RsField("FieldName") &")"">"
			End Select
			TempStr=TempStr&"<br /><Font color='blue'>"& RsField("FieldIntro") &"</font></td></tr>"
		End If
	RsField.movenext
	Loop
	ShowField=TempStr
End Function

'保存自定义字段
Sub SaveField(sChannelID,sModuleID)
	'Response.write sChannelID & "<br>"
	'Response.write sModuleID & "<br>"
	'Response.write Request("Cl_Test") & "<br>"
	'	Response.end
	dim Sql,RsTemp,TempStr
	Sql = "Select arrChannelID,FieldType,FieldName,FieldTitle,IsNull From [Cl_Field] Where IsShow=1 And ModuleID = "& Clng(sModuleID) &" Order by FieldID"
	Set RsTemp = Cl.Execute(Sql)
	Do While Not RsTemp.eof
		If Instr(","& RsTemp(0) &",",","& ChannelID &",") > 0 then
			If RsTemp(1)=4 then
				TempStr = Cl.GetClng(Request(""& RsTemp(2) &""))
				If trim(Request(""& RsTemp(2) &""))="" and RsTemp(4)=0 Then Cl.OutMsg 0,"该项目“"& RsTemp(3) &"”不允许为空！","-1"
			Else
				TempStr = Trim(Request(""& RsTemp(2) &""))
				If Trim(Request(""& RsTemp(2) &""))="" and RsTemp(4)=0 Then Cl.OutMsg 0,"该项目“"& RsTemp(3) &"”不允许为空！","-1"
			End If
			Rs(""& RsTemp(2) &"") = TempStr
		end If
		RsTemp.MoveNext
	Loop
	RsTemp.Close:Set RsTemp = Nothing
End Sub

Function CheckUse(ItemID,ArrItemID)
	If Instr(","&ArrItemID&",",","&ItemID&",")>0 Then CheckUse=" style=""display:'none';"""
End Function
%>
上一页 1 2 34
⌨️ 快捷键说明

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