完整的动态生成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.QQView.com/WebRss.Asp</link> " &  vbNewLine
' 与频道一起显示的图片地址
sRssHead  =  sRssHead  & " <image> " &  vbNewLine
' 是GIF、JPEG或PNG图像文件的URL地址，该图像代表整个频道
sRssHead  =  sRssHead  & " <url>/XrssFile/2007-12/8/2007128112855344.png</url> " &  vbNewLine
' 响应该频道的网站的URL
sRssHead  =  sRssHead  & " <link>http://www.QQView.com/WebRss.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.QQView.com/WebRss.Asp</docs> " &  vbNewLine
' 技术人员的Email
sRssHead  =  sRssHead  & " <webMaster>Xbell@163.com</webMaster>  " &  vbNewLine
' 关于该频道的描述
sRssHead  =  sRssHead  & " <description>频道描述</description> "   &  vbNewLine
' 生成该频道的程序的名称
sRssHead  =  sRssHead  &   " <generator>Rss Generator By 网络大本营</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>Xbell@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
%