Asp生成RSS的类_给网站加上RSS第1/2页

摘要：什么是RSS？RSS是站点用来和其他站点之间共享内容的一种简易方式（也叫聚合内容），通常被用于新闻和其他按顺序排列的网站，例如Blog。一段...

什么是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="http://www.jb51.net"

' NewRss.SetMaxInfo=10

' NewRss.SetInfourl="http://www.jb51.net"

' 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="<?xml version=""1.0"" encoding=""gb2312"" ?> "

RssHead=RssHead&"<rss>"

RssHead=RssHead&"<channel>"

RssHead=RssHead&"<title>"&WebName&"</title>"

RssHead=RssHead&"<link>"&WebUrl&"</link>"

RssHead=RssHead&"<description>"&WebDes&"</description>"

End Property

Private Property Get RssBottom()

RssBottom="</channel>"

RssBottom=RssBottom&"</rss>"

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="数据库未能打开<br />请检查您的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("<item>")

Response.Write("<title>")

Response.Write(Rs(1))

Response.Write("</title>")

Response.Write("<link>")

Response.Write(ShowInfoUrl)

Response.Write("</link>")

Response.Write("<description>")

Response.Write(Content)

Response.Write("</description>")

Response.Write("<pubDate>")

Response.Write(return_RFC822_Date(Rs(3),"GMT"))

Response.Write("</pubDate>")

Response.Write("</item>")

If Rs.Eof or i>cint(MaxInfo) Then Exit For

Rs.MoveNext

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

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

byteLen=lenStr

end function

End Class

当前1/2页12下一页阅读全文