首页 › 资源下载 › 其他 › 1.支持文章 › 源码查看
rss.asp

来自「1.支持文章」· ASP 代码 · 共 228 行
ASP
228 行
<!--#include file="Conn.asp"-->
<!--#include file="SysCls/KS_CommonCls.asp" -->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 0628 Free
'Copyright (C) 2006-2008 Kesion.Com  All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407 
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail  :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com  
'演示站点：http://test.kesion.com 
'郑重声明:
'    ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
'    ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
'    ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New RSSCls
KSCls.Execute()
Set KSCls = Nothing

Class RSSCls
        Private KSCMS
		Private sRssBody
		Private sTitle, sDeScriptIon, sLogo
		Private ChannelID, sClassID,sElite,sHot,RssBody
		Private RssTF,RssCode,RssTemplateTF,RssHomeNum,RssChannelNum,RssDescriptNum,CodeChar,CodeNum

		Private Sub Class_Initialize()
		  Set KSCMS=New CommonCls
		End Sub
        Private Sub Class_Terminate()
		 Call KSCMS.CloseConn()
		 Set KSCMS=Nothing
		End Sub
       Sub Execute()
	    With Response
		ChannelID	= KSCMS.G("ChannelID")
		if ChannelID="" Then ChannelID=0
		
		RSSTF          = KSCMS.GetConfig("RSSTF")
		RssCode        = KSCMS.GetConfig("RssCode")
		RssTemplateTF  = KSCMS.GetConfig("RssTemplateTF")
		RssHomeNum     = KSCMS.GetConfig("RssHomeNum")
		RssChannelNum  = KSCMS.GetConfig("RssChannelNum")
		RssDescriptNum = KSCMS.GetConfig("RssDescriptNum")
		If Cint(RssCode)=1 Then
			CodeChar="UTF-8"
			CodeNum=65001
		Else
		  CodeChar="GB2312"
		  CodeNum=936
		End If
		WebUrl	    = KSCMS.GetDomain
		sClassID	= KSCMS.G("ClassID"):IF sClassID="" Then sClassID=0
		sElite      = KSCMS.G("Elite"):IF sElite="" Then sElite=0
		sHot        = KSCMS.G("Hot"):IF sHot="" Then sHot=0
		sTitle		= KSCMS.GetConfig("WebTitle")
		sDeScriptIon= KSCMS.GetConfig("WebTitle")
		sLogo		= Replace(KSCMS.GetConfig("WebLogo"),"{$GetInstallDir}",WebUrl)
		sLogo		= Replace(sLogo,"{$GetSiteUrl}",WebUrl)
	
		If RssTF=0 Then .Write "<br/><div align=center>对不起。本站点没有提供RSS订阅功能，请与网站管理员联系!</div>":.End
	  	.Expires=0
		.CodePage=CodeNum
		.ContentType="application/xml"
		.Charset=CodeChar
		RssBody     =GetRssBody
		.Write GetShowRssBody(RssTemplateTF)
	End With
End Sub

Function GetShowRssBody(RssTemplateTF)
	GetShowRssBody	=GetShowRssBody & "<?xml version=""1.0"" encoding=""" & CodeChar & """?>"
	If RssTemplateTF=1 Then
	GetShowRssBody	=GetShowRssBody & "<?xml-stylesheet type=""text/xsl"" href=""rss.xsl"" version=""1.0""?>"
	End If
	GetShowRssBody	=GetShowRssBody & "<rss version=""2.0"">"
	GetShowRssBody	=GetShowRssBody & "<channel>"
	GetShowRssBody	=GetShowRssBody & "<title>" & sTitle & "</title>"
	GetShowRssBody	=GetShowRssBody & "<description>" & sDeScriptIon & "</description> "
	GetShowRssBody	=GetShowRssBody & "<link>" & WebUrl & "</link>"
	GetShowRssBody	=GetShowRssBody & "<generator>Rss Generator By Kesion.Com</generator>"
	GetShowRssBody	=GetShowRssBody & "<language>zh-cn</language>"
	GetShowRssBody	=GetShowRssBody & "<copyright>Copyright 2006-2008 KeSion.Com .All Rights Reserved</copyright>"
	GetShowRssBody	=GetShowRssBody & "<webMaster>" & KSCMS.GetConfig("WebMaster")  & "</webMaster>"
	GetShowRssBody	=GetShowRssBody & "<email>" & KSCMS.GetConfig("WebMasterEmail") & "</email>"
	GetShowRssBody	=GetShowRssBody & "<image>"
	GetShowRssBody	=GetShowRssBody & "	<title>" & sTitle & "</title> "
	GetShowRssBody	=GetShowRssBody & "	<url>" & sLogo & "</url> "
	GetShowRssBody	=GetShowRssBody & "	<link>" & WebUrl & "</link> "
	GetShowRssBody	=GetShowRssBody & "	<description>" & sDeScriptIon & "</description> "
	GetShowRssBody	=GetShowRssBody & "</image>"
	GetShowRssBody	=GetShowRssBody & RssBody
	GetShowRssBody	=GetShowRssBody & "</channel>"
	GetShowRssBody	=GetShowRssBody & "</rss>"
End Function

Function GetRssBody()

	Select Case ChannelID
	Case 0
		sTitle		= sTitle
		GetRssBody	= GetChannelNewInfo(1,sClassID,RssHomeNum,RssDescriptNum) & GetChannelNewInfo(2,sClassID,RssHomeNum,RssDescriptNum) & GetChannelNewInfo(3,sClassID,RssHomeNum,RssDescriptNum) & GetChannelNewInfo(4,sClassID,RssHomeNum,RssDescriptNum)
	Case 1
	    IF sElite<>"0" Then
		  sTitle = sTitle & "-最新推荐文章"
		ElseIF sHot<>"0" Then
		  sTitle = sTitle & "-最新热门文章"
		Else
		  sTitle = sTitle & "-文章中心"
		End If
		GetRssBody	= GetChannelNewInfo(1,sClassID,RssChannelNum,RssDescriptNum)
	Case 2
	    IF sElite<>"0" Then
		  sTitle = sTitle & "-最新推荐图片"
		ElseIF sHot<>"0" Then
		  sTitle = sTitle & "-最新热门图片"
		Else
		  sTitle = sTitle & "-图片中心"
		End If
		GetRssBody	= GetChannelNewInfo(2,sClassID,RssChannelNum,RssDescriptNum)
	Case 3
	    IF sElite<>"0" Then
		  sTitle = sTitle & "-最新推荐下载"
		ElseIF sHot<>"0" Then
		  sTitle = sTitle & "-最新热门下载"
		Else
		  sTitle = sTitle & "-下载中心"
		End If
		GetRssBody	= GetChannelNewInfo(3,sClassID,RssChannelNum,RssDescriptNum)
	Case 4
	    IF sElite<>"0" Then
		  sTitle = sTitle & "-最新推荐动漫"
		ElseIF sHot<>"0" Then
		  sTitle = sTitle & "-最新热门动漫"
		Else
		  sTitle = sTitle & "-动漫中心"
		End If
		GetRssBody	= GetChannelNewInfo(4,sClassID,RssChannelNum,RssDescriptNum)
	Case Else
		GetRssBody	= "<item></item>"
	End Select
End Function
       '分别取得各个模块的最新更新信息
	   '参数：	InfoNum-设定每个模块取得的最新信息数量, DescriptNum 设定每条信息介绍文字字数

       Function GetChannelNewInfo(ChannelID,sClassID,InfoNum,DescriptNum)
	     If ChannelID="" Then GetChannelNewInfo = GetChannelNewInfo & "<item></item>":Exit Function
		 Dim SqlStr,SQL,Rs,i,Param
		  Param=" Where 1=1 "
		 If SclassID<>"0" Then 
		  Param= Param & " And Tid in (" & GetFolderTid(sClassID) & ")"
		 End If
		 IF sElite<>"0" Then
		  Param= Param & " And Recommend=1"
		 End IF
		 IF sHot<>"0" Then
		  Param= Param & " And Popular=1"
		 End IF

		 Select Case ChannelID
		  Case 1
		   SqlStr="Select Top " &InfoNum & " ID,Tid,Title,Fname,ArticleContent,Author,AddDate,InfoPurview,ReadPoint From KS_Article " & Param &" And DelTF=0 And Verific=1 Order By ID Desc"    
		  Case 2
		   SqlStr="Select Top " &InfoNum & " ID,Tid,Title,Fname,PictureContent,Author,AddDate,InfoPurview,ReadPoint From KS_Photo " & Param &" And DelTF=0 And Verific=1 Order By ID Desc"    
		  Case 3
		   SqlStr="Select Top " &InfoNum & " ID,Tid,Title,Fname,DownContent,Author,AddDate From KS_DownLoad " & Param &" And DelTF=0 And Verific=1 Order By ID Desc"    
		  Case 4
		   SqlStr="Select Top " &InfoNum & " ID,Tid,Title,Fname,FlashContent,Author,AddDate,InfoPurview,ReadPoint From KS_Flash " & Param &" And DelTF=0 And Verific=1 Order By ID Desc"    
		 End Select
		Set Rs=Conn.Execute(SqlStr)
		if Rs.Bof and Rs.Eof then
			GetChannelNewInfo = GetChannelNewInfo & "<item></item>"
			Rs.Close : Set Rs = Nothing
		Else
			'SQL = Rs.GetRows(-1)
			'Rs.Close : Set Rs = Nothing
			'For i = 0 to UBound(SQL,2)
			'	GetChannelNewInfo = GetChannelNewInfo & "<item>"
			'	GetChannelNewInfo = GetChannelNewInfo & "<title><![CDATA[[" & KSCMS.ReturnClassName(SQL(1,i)) & "] " & SQL(2,i) & "]]></title>"
			'	GetChannelNewInfo = GetChannelNewInfo & "<link>" & KSCMS.GetFolderPath(SQL(1,i),false) & SQL(3,i) & "</link>"
			'	If RssDescriptNum<>0 Then
			'	GetChannelNewInfo = GetChannelNewInfo & "<description><blockquote><![CDATA[" & KSCMS.GotTopic(Replace(Replace(Replace(KSCMS.LoseHtml(SQL(4,i)), vbCrLf, ""), "[NextPage]", ""), "&nbsp;", ""),DescriptNum) & "......]]></blockquote></description>"
			'	End IF
			'	GetChannelNewInfo = GetChannelNewInfo & "<author>" & SQL(5,i) & "</author>"
			'	GetChannelNewInfo = GetChannelNewInfo & "<pubDate><![CDATA[" & SQL(6,i) & "]]></pubDate>"
			'	GetChannelNewInfo = GetChannelNewInfo & "</item>"
			'Next
			Do While Not RS.Eof 
				GetChannelNewInfo = GetChannelNewInfo & "<item>"
				GetChannelNewInfo = GetChannelNewInfo & "<title><![CDATA[[" & KSCMS.ReturnClassName(RS(1)) & "] " & RS(2) & "]]></title>"
				GetChannelNewInfo = GetChannelNewInfo & "<link>" & KSCMS.GetInfoUrl(ChannelID,RS) & "</link>"
				If RssDescriptNum<>0 Then
				GetChannelNewInfo = GetChannelNewInfo & "<description><blockquote><![CDATA[" & KSCMS.GotTopic(Replace(Replace(Replace(KSCMS.LoseHtml(RS(4)), vbCrLf, ""), "[NextPage]", ""), "&nbsp;", ""),DescriptNum) & "......]]></blockquote></description>"
				End IF
				GetChannelNewInfo = GetChannelNewInfo & "<author>" & RS(5) & "</author>"
				GetChannelNewInfo = GetChannelNewInfo & "<pubDate><![CDATA[" & RS(6) & "]]></pubDate>"
				GetChannelNewInfo = GetChannelNewInfo & "</item>"
              RS.MoveNext
		   Loop
		   Rs.Close : Set Rs = Nothing
		End if
	
	   End Function
	   '----------------------------------------------------------------------------------------------------------------------------
		'函数名:GetFolderTid
		'功 能:取得子目录的ID集合
		'参 数:  FolderID父目录ID
		'返回值: 形如 1255555,111111,4444的ID集合
'----------------------------------------------------------------------------------------------------------------------------
		Function GetFolderTid(FolderID)
			Dim Tid
			Dim FolderRS:Set FolderRS=Server.CreateObject("ADODB.RECORDSET")
				  FolderRS.Open "Select ID From KS_Class Where DelTF=0 AND TS LIKE '%" & FolderID & "%'", Conn, 1, 1
				 Do While Not FolderRS.EOF
				  Tid = Tid & "'" & Trim(FolderRS(0)) & "',"
				  FolderRS.MoveNext
				 Loop
				  FolderRS.Close:Set FolderRS = Nothing
			Tid = Left(Trim(Tid), Len(Trim(Tid)) - 1) '去掉最后一个逗号
			GetFolderTid = Tid
		End Function
End Class
%>
⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?
rss.asp

rss.asp - 源码说明

⌨️ 快捷键说明
