前段时间为了给本人的电影站增加Rss订阅功能,动手写了个动态生成Rss Feed的ASP代码,没法上传附件,就直接贴代码吧,反正也不长,用马克斯做电影站的朋友直接拿去用吧,其它类型的站点修改一下也能用。生成的Rss Feed采用UTF-8编码,经过feedvalidator.org校验,兼容Rss 2.0和Atom。
使用方法:将下面的代码存为rss.asp(记得以UTF-8格式保存)并上传到网站根目录,剩下的工作就是找Rss提交入口去提交你的Feed地址http://你的域名/rss.asp
演示:http://www.366mv.cn
代码如下,请根据注释修改相应的信息,版权信息还望各位能够保留 ^_^
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Session.CodePage=65001
Response.Charset="UTF-8"
'========================================================================
'Copyright (c) 2005-2007, 酸溜溜影视([url]www.366mv.cn[/url]) All rights reserved.
'========================================================================
'名称: rss.asp
'描述: 动态生成Rss Feed。
'========================================================================
%>
<%
title="酸溜溜影视" '改成你自己的名称
response.write""&chr(13)
response.write" "&Chr(13)
response.write"最近更新影片 - "&title&" "&chr(13)
response.write" http://"&maxz_2&""&Chr(13)
response.write""&title&" - 万部影片在线观看。免费电影,在线电影,TVB,日剧,韩剧,动漫,科幻,恐怖,言情,连续剧,大片,贺岁片…… "&Chr(13)
response.write get_left(15,0) '显示前15部影片,按更新日期排序
response.write" "&chr(13)
Function re(str)
If Not IsNull(str) then
re=Replace(str,"&","&")
re=Replace(re,"<","<")
re=Replace(re,">",">")
re=Replace(re,"'","'")
re=Replace(re,"""",""")
End if
End Function
Function get_left(n,m)
n=CInt(n):m=CInt(m)
If m=1 Then
mm=" order by zt_hits desc" '按点击量排序
Else
mm=" order by zt_date desc" '按更新日期排序
End If
set rs1=conn.execute("select top "&n&" zt_id,zt_name,zt_zy,zt_dy,zt_type,zt_date,zt_hits,zt_content from zt_data"&mm)
get_left_i=0
Do while not rs1.eof
get_left_i=get_left_i+1
get_left=get_left&"- "&Chr(13)
get_left=get_left&""&re(rs1("zt_name"))&" "&Chr(13)
get_left=get_left&" http://"&maxz_2&"/"&get_classenname(rs1("zt_type"))&"/"&rs1("zt_id")&""&Chr(13)
get_left=get_left&"类别:"&get_classname(rs1("zt_type"))&" "&Chr(13)
get_left=get_left&"http://"&maxz_2&"/"&get_classenname(rs1("zt_type"))&"/"&rs1("zt_id")&" "&Chr(13)
get_left=get_left&" "&Chr(13)
get_left=get_left&""&DateToRFC822(rs1("zt_date"))&" "&Chr(13)
get_left=get_left&" "&Chr(13)
If get_left_i>=n Then Exit Do
rs1.movenext
Loop
rs1.close
End Function
Function DateToRFC822(byVal dtaVal)
Dim strCurLocale : strCurLocale = GetLocale()
SetLocale("en-gb")
dtaVal = CDate(dtaVal)
DateToRFC822 = WeekdayName(Weekday(dtaVal),True)&", "& _
Right("0"&Day(dtaVal),2)&" "& _
MonthName(Month(dtaVal),True)&" "& _
Year(dtaVal)&" "& _
Right("0"&Hour(dtaVal),2)&":"& _
Right("0"&Minute(dtaVal),2)&":"& _
Right("0"&Second(dtaVal),2)&" "& _
Www~Chinaz~com
"+0800"
SetLocale(strCurLocale)
End Function
%>
演示:http://www.366mv.cn
代码如下,请根据注释修改相应的信息,版权信息还望各位能够保留 ^_^
复制代码 代码如下:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Session.CodePage=65001
Response.Charset="UTF-8"
'========================================================================
'Copyright (c) 2005-2007, 酸溜溜影视([url]www.366mv.cn[/url]) All rights reserved.
'========================================================================
'名称: rss.asp
'描述: 动态生成Rss Feed。
'========================================================================
%>
<%
title="酸溜溜影视" '改成你自己的名称
response.write"
response.write"
response.write"
response.write" http://"&maxz_2&""&Chr(13)
response.write"
response.write get_left(15,0) '显示前15部影片,按更新日期排序
response.write"
Function re(str)
If Not IsNull(str) then
re=Replace(str,"&","&")
re=Replace(re,"<","<")
re=Replace(re,">",">")
re=Replace(re,"'","'")
re=Replace(re,"""",""")
End if
End Function
Function get_left(n,m)
n=CInt(n):m=CInt(m)
If m=1 Then
mm=" order by zt_hits desc" '按点击量排序
Else
mm=" order by zt_date desc" '按更新日期排序
End If
set rs1=conn.execute("select top "&n&" zt_id,zt_name,zt_zy,zt_dy,zt_type,zt_date,zt_hits,zt_content from zt_data"&mm)
get_left_i=0
Do while not rs1.eof
get_left_i=get_left_i+1
get_left=get_left&"
get_left=get_left&"
get_left=get_left&" http://"&maxz_2&"/"&get_classenname(rs1("zt_type"))&"/"&rs1("zt_id")&""&Chr(13)
get_left=get_left&"
主演:"&rs1("zt_zy")&"
剧情:"&re(rs1("zt_content"))&"
]]>get_left=get_left&"
get_left=get_left&"
get_left=get_left&"
get_left=get_left&"
If get_left_i>=n Then Exit Do
rs1.movenext
Loop
rs1.close
End Function
Function DateToRFC822(byVal dtaVal)
Dim strCurLocale : strCurLocale = GetLocale()
SetLocale("en-gb")
dtaVal = CDate(dtaVal)
DateToRFC822 = WeekdayName(Weekday(dtaVal),True)&", "& _
Right("0"&Day(dtaVal),2)&" "& _
MonthName(Month(dtaVal),True)&" "& _
Year(dtaVal)&" "& _
Right("0"&Hour(dtaVal),2)&":"& _
Right("0"&Minute(dtaVal),2)&":"& _
Right("0"&Second(dtaVal),2)&" "& _
Www~Chinaz~com
"+0800"
SetLocale(strCurLocale)
End Function
%>
以上就是可以应用到马克斯电影站生成Rss Feed的代码的详细内容,更多请关注0133技术站其它相关文章!