Asp生成RSS的类_给网站加上RSS第1/2页 什么是RSS？ RSS是站点用来和其他站点之间共享内容的一种简易方式（也叫聚合内容），通常被用于新闻和其他按顺序排列的网站，例如Blog。一段项目的介绍可能包含新闻的全部介绍等。或者仅仅是额外的内容或者简短的介绍。这些项目的链接通常都能链接到全部的内容。网络用户可以在客户端借助于支持RSS的新闻聚合软件（如FeedDemon、SharpReader,NewzCrawler），在不打开网站内容页面的情况下阅读支持RSS输出的网站内容。网站提供RSS输出，有利于让用户发现网站内容的更新。 RSS如何工作？ 首先您一般需要下载和安装一个RSS新闻阅读器，然后从网站提供的聚合新闻目录列表中订阅您感兴趣的新闻栏目的内容。订阅后，您将会及时获得所订阅新闻频道的最新内容。 阅读RSS新闻的特点？ 1.没有广告或者图片来影响标题或者文章概要的阅读。 2.RSS阅读器自动更新你定制的网站内容，保持新闻的及时性。 3.用户可以加入多个定制的RSS提要，从多个来源搜集新闻整合 到单个数据流中。 随着网络的普及，越来越多的人习惯通过网络来获取信息、查询资料。虽然各种各样的门户网站纷纷兴起，但在各个网站之间来回穿梭也的确是十分麻烦，搜索引擎可以帮助我们搜索到任何想要找的东西，但查找起来也比较麻烦。现在网络上出现了一种全新的资讯方式，他可以把我们定阅的各种资讯送到我们的桌面上来，不但可以及时了解最新的新闻资讯，而且免去了浏览网站时恼人的网络广告，这种最新的资讯方式被叫做信息聚合，简称RSS。 通过RSS技术，我们可以把定阅的最新的资讯接收到电脑桌面上，要接收RSS信息，使用RSS阅读器是最好的方法。当网站内容更新时，RSS阅读器就会自动接收，把最新的信息接收到本地电脑桌面上来，同时可以看到最新信息的标题与摘要，点击标题就能够查看全文内容了。自从去年国内“博客”的兴起，使的RSS资源渐渐多了起来，同时各大网站也纷纷推出了RSS服务，通常只要看到网站上有XML标志，就说明该网站提供RSS服务。 FeedDemon、看天下网络资讯浏览器 、新浪点点通阅读器、周博通等是常见的RSS阅读器。 复制代码 代码如下: <% Dim Rs,Newrss Class Rss '*******************输入参数******************** '*********************************************** 'SetConn 必填 网站使用的Connection对象 'SetSql 必填 Sql查询语句。强烈建议使用在Sql语句中使用Top关键字 ' Sql语句中包含的字段[新闻Id,标题,内容,时间,静态页名称] ' 注:不要颠倒顺序 ' 如果新闻不是生成的静态页，则无最后一项，SetPageType的值则为1 'SetWebName 必填 网站名称 'SetWebUrl 必填 网站的地址 'SetWebDes 非必填 网站的描述信息 'SetPageType 必填 信息显示页的链接类型 1 为动态页面Id 0为静态页面 'SetMaxInfo 非必填 强制显示信息的数目，若取数据>SetMaxInfo 则显示SetMaxInfo条数据。强烈建议使用在Sql语句中使用Top关键字 'setContentShow 非必填 信息简介设置。注意：该参数为数组（ShowContentType,ShowContentLen） ' ShowContentType [数字类型] 为内容显示方式[参数(0,1)0为按百分比就算显示信息,1为按字数] ' ShowContentLen 内容显示的长度 由ShowContentType 决定实际长度 '*****************输出参数******************** 'ShowRss 显示Rss '====================================================== '例如 'Set NewRss=New Rss ' Set NewRss.SetConn=article_conn ' NewRss.SetSql="select top 30 newsid,title,content,dateandtime,N_fname from article where typeid=1 order by newsid Desc" ' NewRss.SetWebName="测试中" ' NewRss.SetWebUrl="//www.zwyuanma.com" ' NewRss.SetMaxInfo=10 ' NewRss.SetInfourl="//www.zwyuanma.com" ' NewRss.SetPageType="0" ' NewRss.setContentShow="1,200" ' NewRss.ShowRss() 'Set NewRss=Nothing '====================================================== Private Conn,Sql,WebName,WebUrl,WebDes,Er,MaxInfo,i,Infourl,PageType Private ShowContentType,ShowContentLen Private AllContent,AllContentLen Private Sub Class_initialize() MaxInfo=20 'PageType=1 ShowContentType=0 ShowContentLen=20 Er=false End Sub Private Sub Class_terminate() If isObject(Rs) then Set Rs=Nothing End Sub Public Property Let Errmsg(msg) If Er then Response.Clear() Response.Write(msg) Response.End() End If End Property Public Property Let SetWebName(WebName_) WebName=WebName_ End Property Public Property Let SetWebUrl(WebUrl_) WebUrl=WebUrl_ End Property Public Property Let SetWebDes(webDes_) WebDes=WebDes_ End Property Public Property Let SetInfoUrl(Infourl_) Infourl=Infourl_ End Property Public Property Let SetPageType(PageType_) PageType=PageType_ End Property Public Property Let SetMaxInfo(MaxInfo_) MaxInfo=MaxInfo_ End Property Public Property Let setContentShow(ContentShow_) Dim ArrContentShow ArrContentShow=Split(ContentShow_,",") If Ubound(ArrContentShow)<>1 Then Er=True:Errmsg="信息显示参数设置有误!!" ShowContentType=ArrContentShow(0) ShowContentLen=ArrContentShow(1) If Not isnumeric(ShowContentType) or ShowContentType="" Then ShowContentType=0 If Not isnumeric(ShowContentLen) or ShowContentLen="" Then If ShowContentType=0 Then ShowContentLen=20 Else ShowContentLen=200 Else If ShowContentType=0 and (ShowContentLen>100 or ShowContentLen<10) Then ShowContentLen=20 End If End Property Public Property Set SetConn(Conn_) If TypeName(Conn_)="Connection" Then Set Conn=Conn_ Else Er=true Errmsg="数据库连接错误" Exit property End If End Property Public Property Let SetSql(sql_) Sql=Sql_ End Property Public Property Get RssHead() RssHead=" " RssHead=RssHead&"" RssHead=RssHead&"" RssHead=RssHead&""&WebName&"" RssHead=RssHead&""&WebUrl&"" RssHead=RssHead&""&WebDes&"" End Property Private Property Get RssBottom() RssBottom="" RssBottom=RssBottom&"" End Property Public Sub ShowRss() On Error resume Next Dim Rs Dim ShowInfoUrl,ShowContent,Content If TypeName(Conn)<>"Connection" Then Er=True:Errmsg="Connection对象有误" If Sql="" or isnull(Sql)="" or isempty(Sql)="" Then Er=True:Errmsg="没有可执行的Sql语句" If WebName="" or isnull(WebName)="" or isempty(WebName)="" Then Er=True:Errmsg="请设置RSS标题" If WebUrl="" or isnull(WebUrl)="" or isempty(WebUrl)="" Then Er=True:Errmsg="请设置网站的链接" If InfoUrl="" or isnull(InfoUrl)="" or isempty(InfoUrl)="" Then Er=True:Errmsg="请设置链接信息" If PageType="" or isnull(PageType)="" or isempty(PageType)="" Then Er=True:Errmsg="请设置链接类型" Set Rs=Server.CreateObject("ADODB.RecordSet") Rs.Open Sql,Conn,1,1 If Err Then Er=true Errmsg="数据库未能打开 请检查您的Sql语句是否正确" Exit Sub End If Response.Charset = "gb2312" Response.ContentType="text/xml" Response.Write(RssHead) For i =1 to MaxInfo '***************************** ShowInfoUrl=InfoUrl If ShowInfoUrl="" or isnull(ShowInfoUrl) or isempty(ShowInfoUrl) Then ShowInfoUrl="#" Else If PageType Then ShowInfoUrl=ShowInfoUrl&Rs(0) Else ShowInfoUrl=ShowInfoUrl&Rs(4) End If '***************************** AllContent=LoseHtml(Rs(2)) AllContentLen=byteLen(AllContent) ShowContent=int(ShowContentLen) If ShowContentType=0 Then ShowContent=AllContentLen*ShowContent/100 Content=Server.HTMLEncode(titleb(AllContent,ShowContent)) Response.Write("") Response.Write("") Response.Write(Rs(1)) Response.Write("") Response.Write("") Response.Write(ShowInfoUrl) Response.Write("") Response.Write("") Response.Write(Content) Response.Write("") Response.Write("") Response.Write(return_RFC822_Date(Rs(3),"GMT")) Response.Write("") Response.Write("") If Rs.Eof or i>cint(MaxInfo) Then Exit For Rs.MoveNext Next Response.Write(RssBottom) End Sub Function LoseHtml(ContentStr) Dim ClsTempLoseStr,regEx ClsTempLoseStr = Cstr(ContentStr) Set regEx = New RegExp regEx.Pattern = "<\/*[^<>]*>" regEx.IgnoreCase = True regEx.Global = True ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"") LoseHtml = ClsTempLoseStr End function Function return_RFC822_Date(byVal myDate, byVal TimeZone) Dim myDay, myDays, myMonth, myYear Dim myHours, myMinutes, mySeconds myDate = CDate(myDate) myDay = EnWeekDayName(myDate) myDays = Right("00" & Day(myDate),2) myMonth = EnMonthName(myDate) myYear = Year(myDate) myHours = Right("00" & Hour(myDate),2) myMinutes = Right("00" & Minute(myDate),2) mySeconds = Right("00" & Second(myDate),2) return_RFC822_Date = myDay&", "& _ myDays&" "& _ myMonth&" "& _ myYear&" "& _ myHours&":"& _ myMinutes&":"& _ mySeconds&" "& _ " " & TimeZone End Function Function EnWeekDayName(InputDate) Dim Result Select Case WeekDay(InputDate,1) Case 1:Result="Sun" Case 2:Result="Mon" Case 3:Result="Tue" Case 4:Result="Wed" Case 5:Result="Thu" Case 6:Result="Fri" Case 7:Result="Sat" End Select EnWeekDayName = Result End Function Function EnMonthName(InputDate) Dim Result Select Case Month(InputDate) Case 1:Result="Jan" Case 2:Result="Feb" Case 3:Result="Mar" Case 4:Result="Apr" Case 5:Result="May" Case 6:Result="Jun" Case 7:Result="Jul" Case 8:Result="Aug" Case 9:Result="Sep" Case 10:Result="Oct" Case 11:Result="Nov" Case 12:Result="Dec" End Select EnMonthName = Result End Function function titleb(str,strlen) Dim Bstrlen bstrlen=strlen If isempty(str) or isnull(str) or str="" Then titleb=str exit function Else dim l,t,c,i l=len(str) t=0 for i=1 to l c=Abs(Asc(Mid(str,i,1))) if c>255 then t=t+2 else t=t+1 end if if t>=bstrlen then titleb=left(str,i) exit for else titleb=str&"" end if next End If end function function byteLen(str) dim lenStr,lenTemp,i lenStr=0 lenTemp=len(str) dim strTemp for i=1 to lenTemp strTemp=asc(mid(str,i,1)) if strTemp>255 or strTemp<=0 then lenStr=lenStr+2 else lenStr=lenStr+1 end if next byteLen=lenStr end function End Class %> 12下一页阅读全文
