cl_function_soft.asp

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

	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

Function getTime()
	getTime = DateDiff("s", "1970-01-01 08:00:00", Date()) * 1000 + Int(CDbl(Timer()) * 1000)
End Function

Function ThunderDownloadUrl(url)
	Response.Write "<script src='http://pstatic.xunlei.com/js/webThunderDetect.js'></script>" & vbNewLine
	Response.Write "<script>OnDownloadClick('" & url & "','',location.href,'" & Cl.Web_Setting(55) & "',false)</script>" & vbNewLine
	Response.Write "<script>window.setInterval(""window.close()"",3600);</script>" & vbCrLf
End Function

Function FlashGetDownloadUrl(url)
	Dim m_strFlashGetUrl,m_strDownUrl
	'--此处为文件实际下载地址
	m_strDownUrl = url