完整的动态生成RSS

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Response.Charset="UTF-8"
Session.CodePage=65001

Dim db,Conn,Rs
Set Conn=Server.CreateObject("Adodb.Connection")
db="db1.mdb"
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(db)
'Conn.Open "Driver={Microsoft Access Driver (*.mdb)};DBQ="&Server.MapPath(db)

'//转换时间为GMT(RFC822)格式
Function DateTimeToGMT(sDate)
   Dim dWeek,dMonth
   Dim strZero,strZone
   strZero="00"
   strZone="+0800"
   dWeek=Array("Sun","Mon","Tue","Wes","Thu","Fri","Sat")
   dMonth=Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")
   DateTimeToGMT = dWeek(WeekDay(sDate)-1)&", "&Right(strZero&Day(sDate),2)&" "&dMonth(Month(sDate)-1)&" "&Year(sDate)&" "&Right(strZero&Hour(sDate),2)&":"&Right(strZero&Minute(sDate),2)&":"&Right(strZero&Second(sDate),2)&" "&strZone
End Function
'//截取标题长度
Public Function Cut(Str, StrLen)
 Dim l, t, c, I
 l = Len(Str)
 t = 0
 For I = 1 To l
  c = AscW(Mid(Str, I, 1))
  If c < 0 Or c > 255 Then t = t + 2 Else t = t + 1
  If t >= StrLen Then
   Cut = Left(Str, I) & "..."
   Exit For
  Else
   Cut = Str
  End If
 Next
End Function
%>
<%
Dim sRssHead,sRssBody,sRssEnd,sSql
Response.ContentType = "text/xml"
sRssHead = "<rss version=""2.0"">" & vbNewLine
sRssHead = sRssHead &"<channel>"& vbNewLine
'频道(channel)名称
sRssHead = sRssHead &"<title>Rss频道标题</title>"& vbNewLine
'频道所用语言
sRssHead = sRssHead & "<language>zh-cn</language>" & vbNewLine
'响应该频道的网站的URL
sRssHead = sRssHead &"<link>http://www.pxcy.com/RSS.asp</link>"& vbNewLine
'与频道一起显示的图片地址
sRssHead = sRssHead &"<image>"& vbNewLine
'是GIF、JPEG或PNG图像文件的URL地址,该图像代表整个频道
sRssHead = sRssHead &"<url>http://www.pxcy.com/Rss.png</url>"& vbNewLine
'响应该频道的网站的URL
sRssHead = sRssHead &"<link>http://www.pxcy.com/RSS.asp</link>"& vbNewLine
'频道(channel)名称
sRssHead = sRssHead &"<title>Rss频道标题</title>"& vbNewLine
'图片结束
sRssHead = sRssHead &"</image>"& vbNewLine
 
'内容的发布时间
sRssHead = sRssHead &"<pubDate>"&DateTimeToGMT(Now())&"</pubDate>"& vbNewLine
'指向rss格式文档的url地址?
sRssHead = sRssHead &"<docs>http://www.pxcy.com/Rss.asp</docs>"& vbNewLine
'技术人员的Email
sRssHead = sRssHead &"<webMaster>whgfu@163.com</webMaster> "& vbNewLine
'关于该频道的描述
sRssHead = sRssHead &"<description>频道描述</description>" & vbNewLine
'生成该频道的程序的名称
sRssHead = sRssHead & "<generator>Rss Generator By PxcY</generator>" & vbNewLine
sSql = "Select Top 10 ID,Title,Content,Time,Url From [Article] Order By ID Desc"
Set Rs=Conn.Execute(sSql)

Do While Not Rs.Eof
sRssBody = sRssBody & "<item>" & vbNewLine
'item(节点)的标题
sRssBody = sRssBody & "<title><![CDATA["&Rs("title")&"]]></title>" & vbNewLine
'item(节点)的概要
sRssBody = sRssBody & "<description><![CDATA["&Cut(Rs("content"),150)&"]]></description>" & vbNewLine
'item(节点)的URL
sRssBody = sRssBody & "<link>"&Rs("Url")&"</link>" & vbNewLine
'item(节点)作者的Email
sRssBody = sRssBody & "<author>whgfu@163.com</author>" & vbNewLine
'内容的发布时间
sRssBody = sRssBody &"<pubDate>"&Rs("Time")&"</pubDate>"& vbNewLine
'item(节点)结束
sRssBody = sRssBody &"</item>"
Rs.MoveNext
Loop
Rs.Close
Set Rs=Nothing
sRssEnd = "</channel></rss>"
Response.Write(sRssHead)
Response.Write(sRssBody)
Response.Write(sRssEnd)
Conn.Close
Set Conn=Nothing
%> 

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值