cl_function_article.asp

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

Function ShowArticletext(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 CssClassName)
	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)		: CssClassName	= Trim(CssClassName)
	if Err then Err.Clear : ShowArticle="ShowArticle参数错误。" : 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, Title, FontColor, FontType, Author, CopyFrom, Editor, UpdateTime, Censor, Stars, OnTop, Hot, Elite, Hits, InfoPoint, InfoMoney, IsLink, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Article "
	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 '%," & sSpecialID & ",%'"
	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)
	if rsInfo.bof and  rsInfo.eof then
		ShowArticletext="<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_Article " & WhereStr)
		TotalPut = rsTotalPut(0)
		rsTotalPut.Close : Set rsTotalPut=Nothing
		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 = "" 
	For i=0 to Ubound(SqlInfo,2)
		sTitleLen = TitleLen
		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 & "<td><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></td>"
	
				
		if i mod 4 =3 then		
			sTemp =  sTemp & "</tr><tr>"
		end if		
		
	Next	
	
	
	ShowArticletext="<table><tr>" & sTemp & "</tr></table>"
	SqlInfo=Empty
end Function









'================================================================
'过程名：ShowTopArticle(sChannelID,sClassID,TopNum,TitleLen,ShowType,ShowHits)
'		sChannelID	----频道ID
'		sClassID	----栏目ID
'		TopNum		----下载TOP
'		TitleLen	----标题最多字符数，一个汉字=两个英文字符
'		ShowType	----- 1(本日)，2(本周),3(本月),4(累计)
'		ShowHits	------	(是否显示点击数，True为是)
'================================================================
Function ShowTopArticle(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 : ShowTopArticle="ShowTopArticle参数错误。" : 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,Title,Prefixion,Author,UpdateTime,Editor,FontColor,FontType,OnTop,Hot,Elite,Stars,Hits,IsHtml,HtmlFileUrl from Cl_Article where Deleted="&FalseType&" and Status=1 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 
		ShowTopArticle = "<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(16,i)=True then
			LinkUrl=Cl.WebDir & sqlTop(17,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(15,i) & "</span>)"
		end if
		sTemp = sTemp & "</li>"
	Next
	ShowTopArticle=sTemp' & "</ul>"
	sqlTop=Empty
End Function

'===================================================================
'显示上一条或下一条文章
'过程名：ShowNearArticle(sChannelID,sClassID,sInfoID,TitleLen,sType)
'参  数：
'sChannelID		------ sChannelID(频道ID)
'sClassID		------ sClassID(栏目ID)
'sInfoID		------ sInfoID(文章ID)
'TitleLen		------ TitleLen(标题最多字符数)
'sType			------ sType(n为下一条文章)
'===================================================================
Function ShowNearArticle(Byval sChannelID,Byval sClassID,Byval sInfoID,Byval TitleLen,Byval sType)
	dim rsNear,sqlNear
	On Error Resume Next
	sChannelID	=Clng(sChannelID) : sInfoID	= Clng(sInfoID)
	sClassID	=Clng(sClassID)	: TitleLen	= Clng(TitleLen)
	if Err then Err.Clear : ShowNearArticle="ShowNearArticle参数错误。" : Exit Function
	On Error GoTo 0
	sqlNear="Select Top 1 InfoID,ChannelID,ChannelDir,ClassID,Title,Author,UpdateTime,Hits,IsHtml,HtmlFileUrl From Cl_Article Where Deleted="&FalseType&" and Status=1 and ChannelID="&sChannelID&" and ClassID=" & sClassID & " "
	if Lcase(sType)="n" then
		sqlNear=sqlNear & " and InfoID>" & sInfoID & " order by UpdateTime Asc,InfoID Asc"
	else
		sqlNear=sqlNear & " and InfoID<" & sInfoID & " order by UpdateTime Desc,InfoID Desc"
	end if
	Set rsNear= Cl.Execute(sqlNear)
	if rsNear.Eof then
		ShowNearArticle="没有了"
	else
		Dim LinkUrl
		sqlNear = rsNear.GetRows(-1)
		if sqlNear(8,0)=True then
			LinkUrl=Cl.WebDir & sqlNear(9,0)
		elseif CreateHtmlIng=True then
			LinkUrl=Cl.WebDir & Cl.GetItemPath(Cl.CreatePathType,Cl.HtmlDir,Cl.ChannelDir,ParentPath,ClassID,ParentDir,ClassDir) & Cl.GetItemFileName(Cl.CreateFileType,sqlNear(3,0),sqlNear(0,0),sqlNear(6,0)) &"."&Cl.CreateFileExt
		else
			LinkUrl=Cl.WebDir & sqlNear(2,0) & "/ShowInfo.asp?InfoID="&sqlNear(0,0)
		end if
		ShowNearArticle = "<a href='" & LinkUrl & "' title='标题：" & sqlNear(4,0) & vbcrlf & "作者：" & sqlNear(5,0) & vbcrlf & "更新：" & sqlNear(6,0) & vbcrlf & "点击：" & sqlNear(7,0) &"'>" & Cl.GotTopic(sqlNear(4,0),TitleLen) & "</a>"
	end if
	rsNear.Close : Set rsNear=Nothing
	sqlNear = Empty
End Function

'显示文章具体的内容：ShowArticleContent
Function ShowArticleContent()
	if (Cl.ChkUserGroupID(rs("InfoGroup"),5)=False or rs("Receive")=True) and CreateHtmlIng=True then
		ShowArticleContent="<script type='text/Javascript' src='"&Cl.WebDir&"GetContent.asp?InfoID="&rs("InfoID")&"'></script>"
		Exit Function
	end if
	if Not ChkTrueRead Then
		ErrMsg = Cl.Language.selectSingleNode("//ContentPreview").text & ErrMsg
		ErrMsg = Replace(ErrMsg,"{$content}",Cl.NoHtml(rs("Intro")))
		ShowArticleContent = ErrMsg
		Exit Function
	end if
	Dim sTContent
	Set ClUbb = New Cls_UbbCode
	ClUbb.OpenHTML = 1
	Select Case Rs("PaginationType")
	Case 0 : sTContent = Rs("Content")   '不分页显示
	Case 1 : sTContent = AutoPagination   '自动分页显示
	Case 2 : sTContent = ManualPagination   '手动分页显示
	Case Else : sTContent = Rs("Content")   '不分页显示
	End Select
	ShowArticleContent = ErrMsg & ClUbb.UbbCode(sTContent)
	Set ClUbb=Nothing
End Function

'采用手动分页方式
Function ManualPagination()
	Dim strContent, ContentLen, arrContent
	strContent = rs("Content")
	ContentLen = len(strContent)
	if InStr(strContent,"[NextPage]")<=0 then
		ManualPagination = strContent : Exit Function
	else
		Dim sTemp
		arrContent = split(strContent,"[NextPage]")
		pages = Ubound(arrContent)+1
		if CurrentPage<1 then CurrentPage=1
		if CurrentPage>pages then CurrentPage=pages
		sTemp = "<div class='content'>"