cl_function_soft.asp

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

'							---- 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 ShowSoft(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 : ShowSoft="ShowSoft参数错误。" : 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, SoftName, FontColor, FontType, SoftVersion, Author, Editor, UpdateTime, Censor, Stars, OnTop, Hot, Elite, Hits, InfoPoint, InfoMoney, SoftSize, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Soft "
	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
		ShowSoft="<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_Soft " & 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 tClassName
	Dim i,sTemp,TitleStr,sTitleLen,LinkUrl
	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) & " " & SqlInfo(8,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, SoftName, FontColor, FontType, SoftVersion, Author, Editor, UpdateTime=11, Censor, Stars, OnTop, Hot, Elite, Hits=17, InfoPoint, InfoMoney, SoftSize, 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
	ShowSoft=sTemp & "</ul>"
	SqlInfo=Empty
End Function

'==============================================================
'过程名：ShowTopSoft(sChannelID,sClassID,TopNum,TitleLen,ShowType,ShowHits)
'		sChannelID	----频道ID
'		sClassID	----栏目ID
'		TopNum		----下载TOP
'		TitleLen	----标题最多字符数，一个汉字=两个英文字符
'		ShowType	----- 1(本日)，2(本周),3(本月),4(累计)
'		ShowHits	------	(是否显示点击数，True为是)
'================================================================
Function ShowTopSoft(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 : ShowTopSoft="ShowTopSoft参数错误。" : 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,SoftName,Prefixion,SoftVersion,Author,Editor,Hits,UpdateTime,SoftSize,IsHTML,HTMLfileUrl from Cl_Soft 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 
		ShowTopSoft = "<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(11,i)=True then
			LinkUrl=Cl.WebDir & sqlTop(12,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) & " " & sqlTop(6,i),TitleLen) & "</a></span>"
		if ShowHits=True then
			sTemp=sTemp & "(<span class='hits'>" & sqlTop(9,i) & "</span>)"
		end if
		sTemp=sTemp & "</li>"
	Next
	ShowTopSoft = sTemp' & "</ul>"
	sqlTop=Empty : sTemp = Empty
End Function

Public Function ShowDownLoadUrl()
	Dim sTemp,sUrl,DownUrlStr,TempUrl
	Dim LoopStr,ReplaceStr
	sTemp = Cl.Language.selectSingleNode("//Soft/DownLoadUrl").text
	LoopStr = Template.GetPartContent(sTemp,"[Cl_Loop]","[/Cl_Loop]")
	ReplaceStr = "[Cl_Loop]" & LoopStr & "[/Cl_Loop]"
	if rs("UseServer") then
		Dim rsServer
		Set rsServer=Cl.Execute("Select ServerID,ServerName From Cl_Server Where ProjectID="&Cl.GetClng(Cl.Channel.selectSingleNode("@serverprojectid").text)&" and IsDisabled="&FalseType&" order by OrderID Asc")
		Do while Not rsServer.Eof
			sUrl = LoopStr
			sUrl = Replace(sUrl,"{$urlid}",rsServer(0))
			sUrl = Replace(sUrl,"{$downloadname}",rsServer(1))
			TempUrl = TempUrl & sUrl
			rsServer.MoveNext
		Loop
		rsServer.Close : Set rsServer=Nothing
	else
		DownUrlStr=rs("DownloadUrl")
		On Error Resume Next
		if InStr(DownUrlStr,"@@@")>0 then
			DownUrlStr=Split(DownUrlStr,"@@@")
			for i=0 to Ubound(DownUrlStr)
				sUrl = LoopStr
				sUrl = Replace(sUrl,"{$urlid}",i)
				sUrl = Replace(sUrl,"{$downloadname}",Split(DownUrlStr(i),"|")(0))
				TempUrl = TempUrl & sUrl
			Next
			DownUrlStr = Empty
		else
			sUrl = LoopStr
			sUrl = Replace(sUrl,"{$urlid}",0)
			sUrl = Replace(sUrl,"{$downloadname}",Split(DownUrlStr,"|")(0))
			TempUrl = TempUrl & sUrl
		end if
		On Error GoTo 0
	end If
	sTemp=Replace(sTemp,ReplaceStr,TempUrl)
	sTemp=Replace(sTemp,"{$infoid}",rs("InfoID"))
	sTemp=Replace(sTemp,"{$channeldir}",Cl.Channel.selectSingleNode("@channeldir").text)
	ShowDownLoadUrl = sTemp
	sTemp=Empty
End Function
%>