cl_function_movie.asp

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

'	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 ShowMovie(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 : ShowMovie="ShowMovie参数错误。" : 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, MovieName, FontColor, FontType, Director, ActName, Editor, UpdateTime, Censor, Stars, OnTop, Hot, Elite, Hits, InfoPoint, InfoMoney, MovieLanguage, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Movie "
	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
		ShowMovie="<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_Movie " & 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
		'InfoID, ChannelID, ChannelDir, ClassID, Prefixion, MovieName, FontColor, FontType, Director, ActName, Editor, UpdateTime=11, Censor, Stars, OnTop, Hot, Elite, Hits=17, InfoPoint, InfoMoney, MovieLanguage, IsHtml, HtmlFileUrl=22, LastHitTime, CommentCount
		if ShowAuthor=True or ShowHits=True or ShowDateType>0 then
			sTemp = sTemp & "<span class=""other"">("
			if ShowAuthor=True Then
				sTemp=sTemp & SqlInfo(9,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
	ShowMovie=sTemp & "</ul>"
	SqlInfo=Empty
End Function

'================================================================
'过程名：ShowTopMovie(sChannelID,sClassID,TopNum,TitleLen,ShowType,ShowHits)
'		sChannelID	----频道ID
'		sClassID	----栏目ID
'		TopNum		----下载TOP
'		TitleLen	----标题最多字符数，一个汉字=两个英文字符
'		ShowType	----- 1(本日)，2(本周),3(本月),4(累计)
'		ShowHits	------	(是否显示点击数，True为是)
'================================================================
Function ShowTopMovie(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 : ShowTopMovie="ShowTopMovie参数错误。" : 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,MovieName,Prefixion,Director,ActName,MovieFormat,MovieLong,MovieCorner,MovieLanguage,Stars,OnTop,Hot,Elite,Hits,DownNums,UpdateTime,IsHtml,HtmlFileUrl from Cl_Movie 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 
		ShowTopMovie = "<li>没有任何记录</li>"
		rsTop.Close:Set rsTop=Nothing:Exit Function
	End if
	Dim sTemp
	sqlTop=rsTop.GetRows(-1)
	rsTop.Close:Set rsTop=Nothing
	'sTemp = "<ul>"
	For i=0 to Ubound(sqlTop,2)
		if sqlTop(19,i)=True then
			LinkUrl=Cl.WebDir & sqlTop(20,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(16,i) & "</span>)"
		end if
		sTemp=sTemp & "</li>"
	Next
	ShowTopMovie=sTemp' & "</ul>"
	sqlTop=Empty
End Function

Public Function GetMovieUrl(Byval tMovieUrl,Byval LinkPage)
	dim sHTML,stMovieUrl
	On Error Resume Next
	if Instr(tMovieUrl,"@@@")>0 then
		tMovieUrl=Split(tMovieUrl,"@@@")
		for i=0 to Ubound(tMovieUrl)
			stMovieUrl=Split(tMovieUrl(i),"|")
			sHTML = sHTML & "<a href='"&Cl.WebDir & Cl.ChannelDir & "/"&LinkPage&"?UrlID="&i&"&InfoID=" & rs("InfoID") & "'>" & stMovieUrl(0) & "</a><br />"
		Next
		'&Type="&GetMoviePlayType(stMovieUrl(1))&"
	else
		stMovieUrl=Split(tMovieUrl,"|")
		sHTML = "<a href='"&Cl.WebDir & Cl.ChannelDir & "/"&LinkPage&"?UrlID=0&InfoID=" & rs("InfoID") & "'>" & stMovieUrl(0) & "</a>"
	end if
	GetMovieUrl=sHTML
End Function
Function GetMoviePlayType(Byval sMovieUrl)
	Dim sFileExt
	GetMoviePlayType="R"
	if IsNull(sMovieUrl) or sMovieUrl="" then Exit Function
	if Instr(sMovieUrl,".")>0 then
		sMovieUrl=Split(sMovieUrl,".")
		sFileExt = sMovieUrl(Ubound(sMovieUrl))
	else
		sFileExt = sMovieUrl
	end if
	Select Case Lcase(Trim(sFileExt))
	Case "avi", "wav", "asf", "asx", "wpl", "wm", "wmx", "wmd", "wmz", "wma", "wax", "wmv", "wvx", "cda", "mpeg", "mpg", "mpe", "mp2", "mpv2", "mp2v", "mpa", "mp3", "m3u", "mid", "midi", "rmi", "aif", "aifc", "aiff"
		GetMoviePlayType="M"
	Case "swf"
		GetMoviePlayType="F"
	Case Else
		GetMoviePlayType="R"
	End Select
End Function
%>