cl_function_photo.asp

正版创力4.1SQL商业版!!!ASP版。

			strPic = strPic & "document.write('<param name=""FlashVars"" value=""'+flashvar+'"">');" & vbcrlf
			strPic = strPic & "document.write('<embed src=""" & InstallDir & "Images/Bcastr31.swf"" wmode=""opaque"" FlashVars=""'+flashvar+'"" menu=""false"" quality=""high"" width=""'+ swfwidth +'"" height=""'+ swfheight +'"" type=""application/x-shockwave-flash"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" />'); " & vbcrlf
			strPic = strPic & "document.write('</object>');" & vbcrlf
			'strPic = strPic & "}" & vbcrlf
			strPic = strPic & "//-->" & vbcrlf
			strPic = strPic & "</script>" & vbcrlf
		end Select
		sqlPic=Empty
	end if
	ShowPicPhoto=strPic
End Function

'====================================================================================================
'过程：ShowPhoto(sChannelID,sClassID,sSpecialID,TopNum,TitleLen,ShowClassName,ShowProperty,ShowPrefix,ShowAuthor,ShowDateType,ShowHits,ShowHot,IsElite,IsHot,UserName,CssStyle)
'参数：
'	sChannelID		------  频道ID
'	sClassID		------  栏目ID(0为全部，如果大于0，则调用指定栏目及其子栏目)
'	sSpecialID		------  专题ID(0为全部，如果大于0，刚调用指定地区)
'	TopNum			------  最多记录数，0为全部(用于分页显示)
'	TitleLen		------  标题最多字符数
'	ShowClassName	------  是否显示栏目名称(True为显示，False为不显示)
'	ShowProperty	------  是否显示文章属性(固顶/推荐/普通)，(True为显示，False为不显示)
'	ShowPrefix		------  是否显示前缀如：[推荐][图文][注意]字样(True为显示，False为不显示)
'	ShowAuthor		------  是否显示文章作者，True为显示，False为不显示)
'	ShowDateType	------  显示更新日期的样式
'							---- 0(不显示)
'							---- 1(2004-10-01 23:45:45)
'							---- 2(年-月-日 时:分:秒)
'							---- 3(2004-10-01)
'							---- 4(2004\10\01)
'							---- 5(10-01 23:45)
'							---- 6(2004年10月01日)
'							---- 7(10-01)
'							---- 8(20041001234545)
'	ShowHits		------  是否显示文章点击数(True为显示，False为不显示)
'	ShowHot			------  是否显示热门文章标志(True为显示，False为不显示)
'	IsHot			------  是否热门(True为是，False为否)
'	IsElite			------  是否推荐(True为是，False为否)
'	UserName		------  指定某用户(不指定请留空值或0)
'	CssStyle        ------  CSS样式
'====================================================================================================
Function ShowPhoto(Byval sChannelID,Byval sClassID,Byval sSpecialID, _
	Byval TopNum,Byval TitleLen,Byval ShowClassName,Byval ShowProperty, _
	Byval ShowPrefix,Byval ShowAuthor,Byval ShowDateType,Byval ShowHits, _
	Byval ShowHot,Byval IsHot,Byval IsElite,Byval sUserName,Byval CssStyle)
	On Error ReSume Next
	sChannelID		= Clng(sChannelID)		: sClassID		= Clng(sClassID)
	sSpecialID		= Clng(sSpecialID)		: TopNum		= Clng(TopNum)
	TitleLen		= Clng(TitleLen)		: ShowClassName	= CBool(ShowClassName)
	ShowProperty	= CBool(ShowProperty)	: ShowPrefix	= CBool(ShowPrefix)
	ShowAuthor		= CBool(ShowAuthor)		: ShowDateType	= Clng(ShowDateType)
	ShowHits		= CBool(ShowHits)		: ShowHot		= CBool(ShowHot)
	IsHot			= CBool(IsHot)			: IsElite		= CBool(IsElite)
	sUserName		= Trim(sUserName)		: CssStyle		= Trim(CssStyle)
	if Err then Err.Clear : ShowPhoto="ShowPhoto参数错误。" : Exit Function
	On Error GoTo 0
	Dim rsInfo,SQLInfo,WhereStr
	if TopNum<=0 then
		SqlInfo="Select "
	else
		SqlInfo="Select Top "&TopNum&" "
	end if
	SqlInfo = SqlInfo & "InfoID, ChannelID, ChannelDir, ClassID, Prefixion, PhotoName, FontColor, FontType, Author, AuthorEmail, Editor, UpdateTime, Censor,Stars, OnTop, Hot, Elite, Hits, InfoPoint, InfoMoney, PicUrl, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Photo "
	WhereStr = " where Deleted="&FalseType&" and Status=1 "
	if sChannelID>0 then WhereStr = WhereStr & " and ChannelID="&sChannelID&" "
	if sClassID>0 then
		Dim tClass
		Set tClass=Cl.Execute("select Child,arrChildID from Cl_Class where ClassID=" & sClassID)
		if not(tClass.bof and tClass.eof) then
			if tClass(0)>0 then
				WhereStr=WhereStr & " and ClassID in (" & tClass(1) & ")"
			else
				WhereStr=WhereStr & " and ClassID=" & sClassID
			end if
		else
			WhereStr=WhereStr & " and ClassID=" & sClassID
		end if
		Set tClass=Nothing
	end if
	if sSpecialID>0 then WhereStr=WhereStr & " and SpecialID Like '%," & SpecialID & ",%'"
	if IsElite=True then WhereStr=WhereStr & " and Elite="&TrueType
	if IsHot=True then WhereStr=WhereStr & " and Hot="&TrueType
	if sUserName<>"" and sUserName<>"0" then WhereStr=WhereStr & " and Editor='" & sUserName & "'"
	'Response.write WhereStr
	'Response.end
	if IsSqlDataBase=1 then
	SqlInfo=SqlInfo & WhereStr & " order by OnTop Desc,UpdateTime desc,InfoID desc"
	Else
	SqlInfo=SqlInfo & WhereStr & " order by OnTop Asc,UpdateTime desc,InfoID desc"
	End if
	Set rsInfo=Cl.Execute(SqlInfo)
	'Set rsInfo=Server.CreateObject("ADODB.Recordset")
	'OpenConn : rsInfo.open SqlInfo,Conn,1,1
	if rsInfo.bof and  rsInfo.eof then
		'TotalPut=0
		ShowPhoto="<br /><li>当前没有记录！</li>"
		rsInfo.close:set rsInfo=Nothing : Exit Function
	End if
	if TopNum<=0 or TopNum>=50 then
		Dim rsTotalPut
		Set rsTotalPut= Cl.Execute("Select count(InfoID) from Cl_Photo " & WhereStr)
		TotalPut = rsTotalPut(0)
		rsTotalPut.Close : Set rsTotalPut=Nothing
		'TotalPut=rsInfo.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
		rsInfo.move (CurrentPage-1)*PageSize
		SqlInfo=rsInfo.GetRows(PageSize)
	else
		SqlInfo=rsInfo.GetRows(-1)
	end if
	rsInfo.close:set rsInfo=Nothing
	Dim sTemp,Linkurl,i,tClassName
	Dim TitleStr,Author,AuthorName,AuthorEmail,sTitleLen
	sTemp = "<ul class="""&CssStyle&""">" & VbCrlf
	for i=0 to Ubound(SqlInfo,2)
		sTitleLen=TitleLen
		sTemp=sTemp & "<li>"'&nbsp;
		if ShowProperty=True Then
			sTemp = sTemp & "<span class=""property"">"
			if SqlInfo(14,i)=True then
				sTemp = sTemp & "<img src=""" & InstallDir & "Images/SoftOntop.gif"" alt=""固顶"" />&nbsp;"
			elseif SqlInfo(16,i)=True then
				sTemp = sTemp & "<img src=""" & InstallDir & "Images/SoftElite.gif"" alt=""推荐"" />&nbsp;"
			else
				sTemp = sTemp & "<img src=""" & InstallDir & "Images/SoftCommon.gif"" alt=""普通"" />&nbsp;"
			end If
			sTemp = sTemp & "</span>"
		end if
		if ShowClassName=True and SqlInfo(3,i)<>sClassID Then
			tClassName = Cl.GetClassName(SqlInfo(3,i))
			sTemp=sTemp & "<span class=""classname"">[<a href=""" & Cl.WebDir & SqlInfo(2,i) & "/ShowClass.asp?ClassID="&SqlInfo(3,i)&""">" & tClassName & "</a>]&nbsp;</span>"
			sTitleLen=sTitleLen-Cl.strLength(tClassName)-1
		end if
		if ShowPrefix=True and SqlInfo(4,i)<>"" then
			sTemp = sTemp & "<span class=""prefix"">"&SqlInfo(4,i)&"</span>"
			sTitleLen=sTitleLen-Cl.strLength(SqlInfo(4,i))-2
		end if
		if CBool(SqlInfo(21,i)) then
			LinkUrl=Cl.WebDir & SqlInfo(22,i)
		else
			LinkUrl=Cl.WebDir & SqlInfo(2,i) & "/ShowInfo.asp?InfoID="&SqlInfo(0,i)
		end if
		sTemp = sTemp & "<span class=""title""><a href=""" & LinkUrl & """ title=""" & SqlInfo(5,i) & """ target=""_blank"">"
		TitleStr=Cl.GotTopic(SqlInfo(5,i),sTitleLen)
		TitleStr=Cl.GetTitleFont(TitleStr,SqlInfo(7,i))
		TitleStr=Cl.FormatColor(TitleStr,SqlInfo(6,i))
		sTemp=sTemp & TitleStr & "</a></span>"
		if ShowHot=True then
			if CDate(FormatDateTime(SqlInfo(11,i),2))=Date() then
				sTemp= sTemp & "<span class=""new""><img src=""" & InstallDir & "Images/news.gif"" alt=""最新"" /></span>"
			elseif SqlInfo(17,i)>=Clng(Cl.Web_Setting(14)) then
				sTemp= sTemp & "<span class=""hot""><img src=""" & InstallDir & "Images/hot.gif"" alt=""热门"" /></span>"
			end if
		end If
		if ShowAuthor=True or ShowHits=True or ShowDateType>0 then
			sTemp = sTemp & "<span class=""other"">("
			if ShowAuthor=True Then
				sTemp=sTemp & SqlInfo(8,i)
			end if
			if ShowHits=True then
				if ShowAuthor=True then
					sTemp=sTemp & ","
				end if
				sTemp=sTemp &  "<span style=""color:#ff0033;"">"&SqlInfo(17,i)&"</span>" 'Cl.FormatColor(SqlInfo(16,i),"#ff0033")
			end if
			if ShowDateType>0 then
				if ShowHits=True or ShowAuthor=True then
					sTemp=sTemp & ","
				end if
				if CDate(FormatDateTime(SqlInfo(11,i),2))=date() then
					sTemp = sTemp & "<span style=""color:#ff0033;"">"
				else
					sTemp = sTemp & "<span style=""color:#999999;"">"
				end if
				sTemp = sTemp & Cl.Format_Time(SqlInfo(11,i),ShowDateType) & "</font>"
			end if
			sTemp = sTemp & ")</span>"
		end if
		sTemp = sTemp & "</li>" & VbCrlf
	Next
	ShowPhoto=sTemp & "</ul>"
	SqlInfo=Empty
End Function

'================================================================
'过程名：ShowTopPhoto(sChannelID,sClassID,TopNum,TitleLen,ShowType,ShowHits)
'		sChannelID	----频道ID
'		sClassID	----栏目ID
'		TopNum		----下载TOP
'		TitleLen	----标题最多字符数，一个汉字=两个英文字符
'		ShowType	----- 1(本日)，2(本周),3(本月),4(累计)
'		ShowHits	------	(是否显示点击数，True为是)
'================================================================
Function ShowTopPhoto(Byval sChannelID,Byval sClassID,Byval TopNum, _
	Byval TitleLen,Byval ShowType,Byval ShowHits)
	dim sqlTop,rsTop,LinkUrl
	On Error ReSume Next
	sChannelID	= Clng(sChannelID)	: sClassID = Clng(sClassID)
	TopNum		= Clng(TopNum)		: TitleLen = Clng(TitleLen)
	ShowType	= Clng(ShowType)	: ShowHits = CBool(ShowHits)
	if Err then Err.Clear : ShowTopPhoto="ShowTopPhoto参数错误。" : Exit Function
	On Error GoTo 0
	if TopNum>0 then
		sqlTop="select top " & TopNum & " "
	else
		sqlTop="select top 10 "
	end if
	sqlTop=sqlTop & " InfoID,ChannelID,ChannelDir,ClassID,PhotoName,Prefixion,Author,AuthorEmail,Editor,Hits,UpdateTime,OnTop,Hot,Elite,Stars,IsHtml,HtmlFileUrl from Cl_Photo where Deleted="&FalseType&" and Status=1 "
	if sChannelID>0 then sqlTop=sqlTop & " and ChannelID="&sChannelID&" "
	if sClassID>0 then
		Dim tClass
		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
				sqlTop=sqlTop & " and ClassID in (" & tClass(3) & ")"
			else
				sqlTop=sqlTop & " and ClassID=" & sClassID
			end if
		else
			sqlTop=sqlTop & " and ClassID=" & sClassID
		end if
		Set tClass=Nothing
	end if
	Select Case ShowType
	Case 1
		if IsSqlDataBase=1 then
		sqlTop=sqlTop & " And datediff(D,LastHitTime,getdate())<=0 order by DayHits desc,InfoID desc"
		else
		sqlTop=sqlTop & " And datediff('D',LastHitTime,now())<=0 order by DayHits desc,InfoID desc"
		end if
	Case 2
		if IsSqlDataBase=1 then
		sqlTop=sqlTop & " And datediff(ww,LastHitTime,getdate())<=0 order by WeekHits desc,InfoID desc"
		else
		sqlTop=sqlTop & " And datediff('ww',LastHitTime,now())<=0 order by WeekHits desc,InfoID desc"
		end if
	Case 3
		if IsSqlDataBase=1 then
		sqlTop=sqlTop & " And datediff(m,LastHitTime,getdate())<=0 order by MonthHits desc,InfoID desc"
		else
		sqlTop=sqlTop & " And datediff('m',LastHitTime,now())<=0 order by MonthHits desc,InfoID desc"
		end if
	Case Else
		sqlTop=sqlTop & " order by Hits desc,InfoID desc"
	end Select
	Set rsTop= Cl.Execute(sqlTop)
	if rsTop.bof and rsTop.eof then 
		ShowTopPhoto = "<li>当前没有记录！</li>"
		rsTop.Close : Set rsTop=Nothing : Exit Function
	End if
	Dim i,sTemp
	sqlTop=rsTop.GetRows(-1)
	rsTop.Close:Set rsTop=Nothing
	'sTemp = "<ul>"
	For i=0 to Ubound(sqlTop,2)
		if sqlTop(15,i)=True then
			LinkUrl=Cl.WebDir & sqlTop(16,i)
		else
			LinkUrl=Cl.WebDir & sqlTop(2,i) & "/ShowInfo.asp?InfoID="&sqlTop(0,i)
		end if
		sTemp = sTemp & "<li><span class='title'><a href='" & LinkUrl & "' title='" & sqlTop(4,i) & "' target='_blank'>" & Cl.gotTopic(sqlTop(5,i) & sqlTop(4,i),TitleLen) & "</a></span>"
		if ShowHits=True then
			sTemp=sTemp & "(<span class='hits'>" & sqlTop(9,i) & "</span>)"
		end if
		sTemp=sTemp & "</li>"
	Next
	ShowTopPhoto=sTemp' & "</ul>"
	sqlTop=Empty
End Function
%>