<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%dataStr="../"%>
<!--#include file="../inc/conn.asa"-->
<!--#include file="../inc/zzjyz.asp"-->
<%
'使用说明：直接访问rss.asp是动态访问。
'如果隐藏访问rss.asp?act=1就是强制生成一个rss.xml文件，可以管理原来做这个，然后让用户访问rss.xml
'rss.xml文件名可以修改，具体见底部。
'调用条数可以修改，具体见中部注视。
'站长加油站2012-3-21制作。
   Dim act,sSQL, rs, sCrLf, sXmlClear, sRssHead, sRssEnd ,body
   act=CheckNum(Request.QueryString("act"))
   boardid=CheckNum(Request.QueryString("boardid"))
   If boardid="" Or boardid=0 Then 
		sqlStr=""
   Else
		sqlStr=" and boardid="&boardid&" "
   End If 

   sCrLf = chr(13) & chr(10)   '回车+换行 
   sXmlClear = "<?xml version='1.0' encoding='gb2312'?>" & sCrLf 
   sRssHead = "<rss version='2.0'>" & sCrLf 
   sRssHead = sRssHead & "<channel>" & sCrLf 
   sRssHead = sRssHead & "<title>"&TieBa_Name&"</title>" & sCrLf 
   sRssHead = sRssHead & "<description>"&Page_Description&"</description>" & sCrLf 
   sRssHead = sRssHead & "<link>"&TieBa_Url&"</link>" & sCrLf 
   sRssHead = sRssHead & "<language>zh-cn</language>" & sCrLf 
   sRssHead = sRssHead & "<docs>"&Page_Keywords&"</docs>" & sCrLf 
   sRssHead = sRssHead & "<pubDate>"&Now()&"</pubDate>" & sCrLf 
  sRssHead = sRssHead & "<generator>Rss Generator By "&Page_Author&"</generator>" & sCrLf 
   sRssEnd = "</channel></rss>" 
   Response.CharSet="gb2312"   '数据集 
   Response.ContentType="text/xml"   '数据流格式定义
   sSQL="select top 100 * from "&bbstable&" where isCheck=1 "&sqlStr&" order by addtime desc"  '--------------- 需要修改数目自己从这里修改。
   Set rs = Server.CreateObject("ADODB.Recordset") 
   rs.Open sSQL, Conn, 1, 1 
   if not (rs.eof and rs.bof) then 
     do while not rs.eof 
   sRssHead = sRssHead & "<item>" & sCrLf 
   sRssHead = sRssHead & "<title><![CDATA[" & rs("title") & "]]></title>" & sCrLf 
   sRssHead = sRssHead & "<link>" & TieBa_Url&"ShowNews.asp?id=" & rs("id") & "</link>" & sCrLf 
   sRssHead = sRssHead & "<author>" & rs("username") & "</author>" & sCrLf 
   sRssHead = sRssHead & "<pubDate>"& return_RFC822_Date(rs("addtime"),"+0800")  & "</pubDate>" & sCrLf 
   sRssHead = sRssHead & "<category>" &GetBoardName( rs("boardid")) & "</category>" & sCrLf 
   sRssHead = sRssHead & "<description><![CDATA["&TitleLeft(RemoveUBB(rs("content")),320)&"]]></description>" & sCrLf 
   sRssHead = sRssHead & "</item>" & sCrLf
       rs.movenext 
     loop 
   end if 
   rs.close 
   set rs=nothing 

   '输出： 
   body=sXmlClear & sRssHead & sRssEnd 
   Response.write body 
If act<>"" Then 
	writexml "../rss.xml",body 
End If 

function writexml(filename,bodytext) 
	Set fso = Server.CreateObject("Scripting.FileSystemObject") 
	Set fout = fso.CreateTextFile(Server.MapPath(filename),true) 
	fout.WriteLine bodytext 
	fout.close 
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 
%>  
