cl_function_photo.asp

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

<%
'===================================================
' CreateLive CMS Version 4.0
'							Powered by Aspoo.CoM
'===================================================
' File: Cl_Function_Photo.asp
' Date: 2005-10-31
' Mail: [e-mail], [e-mail]
' Q  Q: 3315263, 596197794
' Msn : [e-mail], [e-mail]
' Web : http://www.aspoo.com, http://www.aspoo.net
' Bbs : http://bbs.aspoo.com, http://bbs.aspoo.net
' Copyright (C) 2005-2007 Aspoo.CoM All Rights Reserved.
'===================================================
Public Sub Photo_Setting()
	CurrentPath = Cl.Language.selectSingleNode("//CurrentPath").text & "<a href='" & Cl.Web_info(4) & "'>" & Cl.Web_info(0) & "</a> &gt;&gt; <a href='" & Cl.WebDir & Cl.ChannelDir & "'>" & Cl.ChannelName & "</a>"
	Cl.Title = Cl.NoHtml(Cl.ChannelName) & " " & Cl.GotTopic(Cl.ChannelReadMe,50) & "[" & Cl.Web_info(1) & "]"
	if InfoID>0 then
		Set rs= Cl.Execute("select * from Cl_Photo where InfoID=" & InfoID)
		if rs.bof and rs.eof then
			rs.Close : Set rs=Nothing
			Call Cl.OutErr(0,Replace(Cl.Language.selectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.ChannelItemName))
		end if
		if rs("ChannelID")<>ChannelID Or rs("Deleted")=True Or rs("Status")<>1 Then
			rs.Close : Set rs=Nothing
			Call Cl.OutErr(0,Replace(Cl.Language.selectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.ChannelItemName))
		end If
		ClassID = rs("ClassID")
		InfoTitle = rs("PhotoName")
		if rs("Hot")=False then
			if rs("hits")>=Clng(Cl.Web_Setting(14)) then Cl.Execute("Update Cl_Photo Set Hot=" & TrueType & " where InfoID=" & InfoID & "")
		end if
		Template.TemplateID = 0
		If CLng(Cl.Channel.selectSingleNode("@info_projectid").text)>0 Then
			Template.ProjectID = CLng(Cl.Channel.selectSingleNode("@info_projectid").text)
			If CLng(Cl.Channel.selectSingleNode("@info_templateid").text)>0 Then Template.TemplateID = CLng(Cl.Channel.selectSingleNode("@info_templateid").text)
			If CLng(Cl.Channel.selectSingleNode("@info_cssid").text)>0 Then Template.CssID = CLng(Cl.Channel.selectSingleNode("@info_cssid").text)
		End if
	end if
	if ClassID>0 Then
		Set tClass = Application(Cl.CacheName&"_classlist").documentElement.selectSingleNode("class[@classid="&ClassID&"]")
		If tClass Is Nothing Then Call Cl.OutErr(0,Cl.Language.selectSingleNode("//ClassNoFind").text)
		ClassName	= tClass.selectSingleNode("@classname").text
		ParentID	= CLng(tClass.selectSingleNode("@parentid").text)
		ParentPath	= tClass.selectSingleNode("@parentpath").text
		ClassDir	= tClass.selectSingleNode("@classdir").text
		ParentDir	= tClass.selectSingleNode("@parentdir").text
		RootID		= CLng(tClass.selectSingleNode("@rootid").text)
		Depth		= CLng(tClass.selectSingleNode("@depth").text)
		Child		= CLng(tClass.selectSingleNode("@child").text)
		arrChildID	= tClass.selectSingleNode("@arrchildid").text
		BrowsePurview=CLng(tClass.selectSingleNode("@browsepurview").text)
		VipUser		= tClass.selectSingleNode("@vipuser").text
		ClassProjectID= CLng(tClass.selectSingleNode("@projectid").text)
		ClassTemplateID = CLng(tClass.selectSingleNode("@templateid").text)
		ClassCssID	= CLng(tClass.selectSingleNode("@cssid").text)
		If CLng(Cl.Channel.selectSingleNode("@class_projectid").text)>0 Then
			Cl.ProjectID = CLng(Cl.Channel.selectSingleNode("@class_projectid").text)
			'Template.TemplateID = CLng(Cl.Channel.selectSingleNode("@class_templateid").text)
			Cl.CssID = CLng(Cl.Channel.selectSingleNode("@class_cssid").text)
		End if
		If ClassProjectID > 0 Then
			Cl.ProjectID = ClassProjectID
			Cl.CssID = ClassCssID
		End if
		If ParentID>0 Then
			Dim tNode,tParent,i
			tParent = Split(ParentPath,",")
			For i=1 To UBound(tParent)
				Set tNode = Application(Cl.CacheName&"_classlist").documentElement.selectSingleNode("class[@classid=" & tParent(i) & "]")
				If Not tNode Is Nothing Then 
				CurrentPath=CurrentPath & " &gt;&gt; <a href='" & tNode.selectSingleNode("@linkurl").text & "'>" & tNode.selectSingleNode("@classname").text & "</a>"
				End If
				Set tNode=Nothing
			Next
			tParent = Null
		End If
		CurrentPath=CurrentPath & " &gt;&gt; <a href='" & tClass.selectSingleNode("@linkurl").text & "'>" & ClassName & "</a>"
		Set tClass = Nothing
	end if
End Sub

'=================================================
'过程名：ShowClassPhoto(sChannelID,sClassID,ModNum,TopNum)
'参  数：
'		sChannelID	----	频道ID
'		sClassID	----	指定栏目，多个用“|”分隔，不指定请留空或0
'		ModNum      ---		多少个换行
'		TopNum      ---		最多显示记录数
'=================================================
Function ShowClassPhoto(Byval sChannelID,Byval sClassID,Byval ModNum,Byval TopNum)
	Dim sqlRoot,rsRoot,ClassCount,iClassID,nClassID
	Dim sTemp,strValue,ClassLinkUrl
	sChannelID	= Cl.GetClng(sChannelID)
	sTemp		= ""
	sClassID	= Trim(sClassID)
	ModNum		= Cl.GetClng(ModNum)
	if sClassID="" or sClassID="0" then
		TopNum		= Cl.GetClng(TopNum)
		if TopNum=0 then TopNum = 6
		sqlRoot="select Top "&TopNum&" ClassID,ClassName,ParentPath,ClassDir,ParentDir,RootID,Child,arrChildID,Readme From Cl_Class where ChannelID="&sChannelID&" and ParentID=0 and IsElite="&TrueType&" and IsOuter=0 order by RootID"
	Else
		sqlRoot="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,RootID,Child,arrChildID,Readme From Cl_Class where ChannelID="&sChannelID&" and IsElite="&TrueType&" and IsOuter=0 and ClassID In ("&Replace(sClassID,"|",",")&") order by RootID"
	End if
	Set rsRoot= Cl.Execute(sqlRoot)
	if rsRoot.bof and rsRoot.eof then
		sTemp="还没有任何栏目，请首先添加栏目。"
		rsRoot.Close:Set rsRoot=Nothing:Exit Function
	end if
	sqlRoot=rsRoot.GetRows(-1)
	rsRoot.Close:Set rsRoot=Nothing
	Dim TemplateHTMLStr
	TemplateHTMLStr = Template.GetTemplate(Cl.GetDefaultTemplateID(3,9,Template.ProjectID))
	TemplateHTMLStr = Replace(TemplateHTMLStr,"{$webdir}",InstallDir)
	TemplateHTMLStr = Replace(TemplateHTMLStr,"{$csspicurl}",Cl.WebDir & Cl.CssPicUrl)
	TemplateHTMLStr = Split(TemplateHTMLStr,"@@@")
	'If ChannelID=0 Then ChannelID = sChannelID
	nClassID = Ubound(sqlRoot,2)
	for iClassID=0 to nClassID
		ClassID = sqlRoot(0,iClassID)
		ClassLinkUrl = Cl.GetClassLinkUrl(sqlRoot(0,iClassID))
		strValue=TemplateHTMLStr(1)
		strValue=Replace(strValue,"{$channelid}",sChannelID)
		strValue=Replace(strValue,"{$classid}",sqlRoot(0,iClassID))
		strValue=Replace(strValue,"{$classtitle}",sqlRoot(8,iClassID)&"")
		strValue=Replace(strValue,"{$classname}",sqlRoot(1,iClassID))
		strValue=Replace(strValue,"{$classfileurl}",ClassLinkUrl)
		strValue=Replace(strValue,"{$classlinkurl}",ClassLinkUrl)
		strValue=Template.ReplaceFlag(strValue,"showphoto","")
		If iClassID<nClassID then
			if ((iClassID+1) mod ModNum) = 0 then
				strValue = strValue & TemplateHTMLStr(3)
			else
				strValue = strValue & TemplateHTMLStr(2)
			end If
		End if
		sTemp=sTemp & strValue
	Next
	ShowClassPhoto=Replace(TemplateHTMLStr(0),"{$classphotobody}",sTemp)
	TemplateHTMLStr = Null
	sqlRoot=Empty
End Function

'====================================================================================================
'过程：ShowPicPhoto(sChannelID,sClassID,sSpecialID,TopNum,TitleLen,ShowType,Cols,ImgWidth,ImgHeight,ContentLen,IsHot,IsElite)
'参数：
'	sChannelID  ------  频道ID
'	sClassID    ------  栏目ID(0为所有栏目,若大于0，则调用指定栏目及其子栏目)
'	sSpecialID  ------  专题ID(0为所有栏目,若大于0，则调用指定地区)
'	TopNum      ------  最多显示多少篇
'	TitleLen    ------  标题最多字符数
'	ShowType    ------  显示方式。0(图),1(图+标),2(图+标+内),3(图+幻),4(图+标+幻)
'	Cols        ------  列数。超过此列数就换行
'	ImgWidth    ------  图片宽度
'	ImgHeight   ------  图片高度
'	ContentLen  ------  内容最多字符数
'	IsHot       ------  是否是热门(True为是，False为否)
'	IsElite     ------  是否是推荐(True为是，False为否)
'====================================================================================================
Function ShowPicPhoto(Byval sChannelID,Byval sClassID,Byval sSpecialID, _
	Byval TopNum,Byval TitleLen,Byval ShowType,Byval Cols,Byval ImgWidth, _
	Byval ImgHeight,Byval ContentLen,Byval IsHot,Byval IsElite)
	On Error Resume Next
	sChannelID	= Clng(sChannelID)	: sClassID		= Clng(sClassID)
	sSpecialID	= Clng(sSpecialID)	: TopNum		= Clng(TopNum)
	TitleLen	= Clng(TitleLen)	: ShowType		= Clng(ShowType)
	Cols		= Clng(Cols)		: ImgWidth		= Clng(ImgWidth)
	ImgHeight	= Clng(ImgHeight)	: ContentLen	= Clng(ContentLen)
	IsHot		= CBool(IsHot)		: IsElite		= CBool(IsElite)
	if Err then Err.Clear : ShowPicPhoto="ShowPicPhoto参数错误。":Exit Function
	On Error GoTo 0
	dim rsPic,sqlPic,tClass,j,strPic
	if TopNum<=0 then
		sqlPic="Select "
	else
		sqlPic="Select top "&TopNum&" "
	end if
	sqlPic=sqlPic & " InfoID,ChannelID,ChannelDir,ClassID,PhotoName,Author,AuthorEmail,Editor,Keyword,Hits,DayHits,WeekHits,MonthHits,UpdateTime,PicUrl,OnTop,Elite,Status,Intro,InfoGroup,InfoPoint,Stars,IsHtml,HtmlFileUrl from Cl_Photo where Deleted="&FalseType&" and Status=1 and PicUrl<>'' "
	if sChannelID>0 then sqlPic=sqlPic & " and ChannelID="&sChannelID&" "
	if sClassID>0 then
		set tClass=Cl.Execute("select ClassID,Child,ParentPath,arrChildID from Cl_Class where ChannelID="&sChannelID&" and ClassID=" & sClassID)
		if not(tClass.bof and tClass.eof) then
			if tClass(1)>0 then
				sqlPic=sqlPic & " and ClassID in (" & tClass(3) & ")"
			else
				sqlPic=sqlPic & " and ClassID=" & sClassID
			end if
		else
			sqlPic=sqlPic & " and ClassID=" & sClassID
		end if
		set tClass=Nothing
	end if
	if sSpecialID>0 then sqlPic=sqlPic & " and SpecialID Like '%," & sSpecialID & ",%'"
	if IsHot=True then sqlPic=sqlPic & " and Hot="&TrueType&" "
	if IsElite=True then sqlPic=sqlPic & " and Elite="&TrueType&" "
	if IsSqlDataBase=1 then
	sqlPic=sqlPic & " order by OnTop Desc,UpdateTime desc,InfoID desc"
	Else
	sqlPic=sqlPic & " order by OnTop Asc,UpdateTime desc,InfoID desc"
	End if
	Set rsPic= Server.CreateObject("ADODB.Recordset")
	OpenConn : rsPic.open sqlPic,Conn,1,1
	if rsPic.bof and rsPic.eof then
		strPic = strPic & "<img src=""" & Cl.WebDir & "images/NoPic.gif"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"">"
		rsPic.Close : Set rsPic = Nothing
	else
		dim FileType,TitleStr,LinkUrl
		if TopNum<=0 or TopNum>=100 then
			TotalPut=rsPic.recordcount
			if (TotalPut mod PageSize)=0 then
				TotalPages = TotalPut \ PageSize
			else
				TotalPages = TotalPut \ PageSize + 1
			end if
			if CurrentPage > TotalPages then CurrentPage=TotalPages
			if CurrentPage < 1 then CurrentPage=1
			rsPic.move (CurrentPage-1)*PageSize
			sqlPic = rsPic.GetRows(PageSize)
		else
			sqlPic=rsPic.GetRows(-1)
		end if
		rsPic.Close : Set rsPic = Nothing
		Select Case ShowType
		Case 0
			strPic = "<table width=""100%"" cellpadding=""0"" cellspacing=""0"" border=""0"" align=""center""><tr>"
			for j=0 to Ubound(sqlPic,2)