cl_function_article.asp

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

		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, Title=5, FontColor, FontType, Author, CopyFrom, Editor=10, UpdateTime, Censor, Stars, OnTop=14, Hot, Elite=16, Hits=17, InfoPoint, InfoMoney, IsLink=20, IsHtml, HtmlFileUrl=22, LastHitTime, CommentCount
		if ShowAuthor=True or ShowHits=True or ShowDateType>0 then
			sTemp = sTemp & "<span class=""other"">("
			if ShowAuthor=True Then
			if InStr(SqlInfo(8,i),"|")>0 then
				Author=Split(SqlInfo(8,i),"|")
				AuthorName=Author(0)
				AuthorEmail=Author(1)
			else
				AuthorName=SqlInfo(8,i)
				AuthorEmail="[e-mail]"
			end if
				sTemp=sTemp & "<a href=""mailto:" & AuthorEmail & """>" & AuthorName & "</a>"
			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) & "</span>"
			end if
			sTemp = sTemp & ")</span>"
		end if
		sTemp = sTemp & "</li>" & VbCrlf
	Next
	ShowArticle=sTemp & "</ul>"
	SqlInfo=Empty
end Function

Function getHTTPPage(url) 
	On Error Resume Next
	dim http 
	set http=Server.createobject("Microsoft.XMLHTTP") 
	Http.open "GET",url,false 
	Http.send() 
	if Http.readystate<>4 then
		exit function 
	end if 
	getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
	set http=nothing
	If Err.number<>0 then 
		Response.Write "<p align='center'><font color='red'><b>服务器获取文件内容出错</b></font></p>" 
		Err.Clear
	End If  
End function
		
Function BytesToBstr(body,Cset)
	dim objstream
	set objstream = Server.CreateObject("adodb.stream")
	objstream.Type = 1
	objstream.Mode =3
	objstream.Open
	objstream.Write body
	objstream.Position = 0
	objstream.Type = 2
	objstream.Charset = Cset
	BytesToBstr = objstream.ReadText 
	objstream.Close
	set objstream = nothing
End Function

'截取字符串,1.包括起始和终止字符，2.不包括
Function strCut(strContent,StartStr,EndStr,CutType)
	Dim strHtml,S1,S2
	strHtml = strContent
	On Error Resume Next
	Select Case CutType
	Case 1
		S1 = InStr(strHtml,StartStr)
		S2 = InStr(S1,strHtml,EndStr)+Len(EndStr)
	Case 2
		S1 = InStr(strHtml,StartStr)+Len(StartStr)
		S2 = InStr(S1,strHtml,EndStr)
	End Select
	If Err Then
		strCute = "<p align='center'>没有找到需要的内容。</p>"
		Err.Clear
		Exit Function
	Else
		strCut = Mid(strHtml,S1,S2-S1)
	End If
End Function


Function ShowArticlezuixin(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,imgs,links,strs
	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,content  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
		ShowArticle2="<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)				
		strs=split(SqlInfo(25,i),"</DIV>")
		imgs=strCut(strs(0),"http://img0","sum.jpg",1)
		links=strCut(strs(0),"href=""","""",2)		
		'sTemp = sTemp &  SqlInfo(25,i) & "<br>"	
		'response.write imgs  &"<br>"	& links &"<br>"	
		sTemp=sTemp & "<a href='" & links &"' target='_blank'>&nbsp;<img width='82' height='82' src='"&imgs&"'>&nbsp;</a>"
		if i mod 7 =6 then
		sTemp = sTemp & "<br>"
		end if
		
	Next
	ShowArticlezuixin=sTemp 
	SqlInfo=Empty
end Function


Function ShowArticlezhuti(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,content  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
		ShowArticle2="<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)				
				
		sTemp = sTemp &  SqlInfo(25,i) & "<br>"		
		
		
	Next
	ShowArticlezhuti=sTemp 
	SqlInfo=Empty
end Function