< %@LANGUAGE = " VBSCRIPT "  CODEPAGE = " 936 " % >
< %
' ========TSYS RSS Feed PAGE OUTPUT ============================
' == Copyright 2006 吟清. All Rights Reserved.
' == Last Update: 06/30/2006 3:17 AM
' ============================================================== %>
< %  Option   explicit  % >  
< % Response.Charset = " gb2312 "  % >
< % Session.CodePage = " 936 "  % >
< ! -- #include file = " TSYS/Include/Config.asp "   -->
< % 
Dim  sSQL, rs, sCrLf, sXmlClear, sRssHead, sRssEnd ,Url
sCrLf  =   chr ( 13 )  &   chr ( 10 )  ' 回车+换行
If  Request.ServerVariables( " HTTPS " )  =   " on "   Then
URL  =   " https:// "
Else
URL  =   " http:// "
End   If
Url = Url & Request.ServerVariables( " SERVER_NAME " ) & " : " & Request.ServerVariables( " SERVER_PORT " )
sXmlClear  =   " <?xml version=""1.0"" encoding=""gb2312""?> "   &  sCrLf 
sRssHead  =   " <rss version=""2.0""> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <channel> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <title><![CDATA[ " &  Def_MySiteTitle  & " ]]></title> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <link> "   & url &   " </link> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <description><![CDATA[ " &  Def_MySiteTitle  & "" &  Def_SysTitle  & " ]]></description> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <language>zh-cn</language> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <copyright><![CDATA[Copyright 2006,  " &  Def_MySiteTitle  & " ]]></copyright> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <webMaster><![CDATA[xingis@gmail.com (吟清)]]></webMaster> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <generator>TSYS based Powered By Aspid.cn</generator> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <pubDate>Fri, 30 Jun 2006 02:46:33 +0800</pubDate> "   &  sCrLf 
sRssHead  =  sRssHead  &   " <ttl>60</ttl> "   &  sCrLf 

sRssEnd  =   " </channel></rss> "  

Response.ContentType = " text/xml "   ' 数据流格式定义 
Response.ContentType = " application/xml "
Response.Expires = 0
Response.write sXmlClear 
Response.write sRssHead 
Dim  Conn
Set  Conn  =  Server.CreateObject( " Adodb.Connection " )
Conn.Open ConnStr
Dim  sql
Sql = " select Top  " &  RssNewsList_PageSize  & "  Title,FilePath,AddTime,KeyWord,Content,Classtitle,EditorTitle From view_NewsInfo where Del=0 Order By addTime DESC "
Set  Rs = Server.CreateObject( " ADODB.RecordSet " )
Rs.open sql,conn, 1 , 2
IF  RS.EOF  AND  RS.BOF  Then
Response.Write( " <item></item> " )
Else
do   while   not  rs.eof 
Response.Write( " <item> " )
Response.Write( " <title><![CDATA[ " & trim (Rs( " Title " )) & " ]]></title> " )
Response.Write( " <link><![CDATA[ "   & url & RS( " FilePath " ) & " ]]></link> " )
Response.Write( " <category><![CDATA[ " & RS( " Classtitle " ) & " ]]></category> " )
Response.Write( " <author><![CDATA[ " & RS( " EditorTitle " ) & " ]]></author> " )
Response.Write( " <pubDate> " &  DateToStr(RS( " addtime " ), " w,d m y H:I:S " )  & " </pubDate> " )
Response.Write( " <description><![CDATA[ " & Show_HText(RS( " Content " ), 300 ) & " ..]]></description> " )
Response.Write( " </item> " )
RS.MoveNext
loop  
end   if  
rs.close 
set  rs = nothing  
Response.write sRssEnd 
% >
< %
' *************************************
' 日期转换函数
' *************************************
Function  DateToStr(DateTime,ShowType)  ' 函数名
   Dim  DateMonth,DateDay,DateHour,DateMinute,DateWeek,DateSecond
   Dim  FullWeekday,shortWeekday,Fullmonth,Shortmonth,TimeZone1,TimeZone2
  TimeZone1 = " +0800 "
  TimeZone2 = " +08:00 "
  FullWeekday = Array ( " Sunday " , " Monday " , " Tuesday " , " Wednesday " , " Thursday " , " Friday " , " Saturday " )
  shortWeekday = Array ( " Sun " , " Mon " , " Tue " , " Wed " , " Thu " , " Fri " , " Sat " )
 Fullmonth = Array ( " January " , " February " , " March " , " April " , " May " , " June " , " July " , " August " , " September " , " October " , " November " , " December " )
 Shortmonth = Array ( " Jan " , " Feb " , " Mar " , " Apr " , " May " , " Jun " , " Jul " , " Aug " , " Sep " , " Oct " , " Nov " , " Dec " )

  DateMonth = Month (DateTime)
  DateDay = Day (DateTime)
  DateHour = Hour (DateTime)
  DateMinute = Minute (DateTime)
  DateWeek = weekday (DateTime)
  DateSecond = Second (DateTime)
   If   Len (DateMonth) < 2   Then  DateMonth = " 0 " & DateMonth
   If   Len (DateDay) < 2   Then  DateDay = " 0 " & DateDay
   If   Len (DateMinute) < 2   Then  DateMinute = " 0 " & DateMinute
   Select   Case  ShowType
   Case   " Y-m-d "  
    DateToStr = Year (DateTime) & " - " & DateMonth & " - " & DateDay
   Case   " Y-m-d H:I A "
     Dim  DateAMPM
     If  DateHour > 12   Then  
      DateHour = DateHour - 12
      DateAMPM = " PM "
     Else
      DateHour = DateHour
      DateAMPM = " AM "
     End   If
     If   Len (DateHour) < 2   Then  DateHour = " 0 " & DateHour  
    DateToStr = Year (DateTime) & " - " & DateMonth & " - " & DateDay & "   " & DateHour & " : " & DateMinute & "   " & DateAMPM
   Case   " Y-m-d H:I:S "
     If   Len (DateHour) < 2   Then  DateHour = " 0 " & DateHour  
     If   Len (DateSecond) < 2   Then  DateSecond = " 0 " & DateSecond
    DateToStr = Year (DateTime) & " - " & DateMonth & " - " & DateDay & "   " & DateHour & " : " & DateMinute & " : " & DateSecond
   Case   " YmdHIS "
    DateSecond = Second (DateTime)
     If   Len (DateHour) < 2   Then  DateHour = " 0 " & DateHour  
     If   Len (DateSecond) < 2   Then  DateSecond = " 0 " & DateSecond
    DateToStr = Year (DateTime) & DateMonth & DateDay & DateHour & DateMinute & DateSecond  
   Case   " ym "
    DateToStr = Right ( Year (DateTime), 2 ) & DateMonth
   Case   " d "
    DateToStr = DateDay
  Case   " ymd "
 DateToStr = Right ( Year (DateTime), 4 ) & DateMonth & DateDay
  Case   " mdy "  
  Dim  DayEnd
  select   Case  DateDay
  Case   1  
 DayEnd = " st "
  Case   2
 DayEnd = " nd "
  Case   3
 DayEnd = " rd "
  Case   Else
 DayEnd = " th "
  End   Select  
 DateToStr = Fullmonth(DateMonth - 1 ) & "   " & DateDay & DayEnd & "   " & Right ( Year (DateTime), 4 )
  Case   " w,d m y H:I:S "  
    DateSecond = Second (DateTime)
     If   Len (DateHour) < 2   Then  DateHour = " 0 " & DateHour  
     If   Len (DateSecond) < 2   Then  DateSecond = " 0 " & DateSecond
 DateToStr = shortWeekday(DateWeek - 1 ) & " , " & DateDay & "   " &   Left (Fullmonth(DateMonth - 1 ), 3 )  & "   " & Right ( Year (DateTime), 4 ) & "   " & DateHour & " : " & DateMinute & " : " & DateSecond & "   " & TimeZone1
  Case   " y-m-dTH:I:S "
     If   Len (DateHour) < 2   Then  DateHour = " 0 " & DateHour  
     If   Len (DateSecond) < 2   Then  DateSecond = " 0 " & DateSecond
    DateToStr = Year (DateTime) & " - " & DateMonth & " - " & DateDay & " T " & DateHour & " : " & DateMinute & " : " & DateSecond & TimeZone2
   Case   Else
     If   Len (DateHour) < 2   Then  DateHour = " 0 " & DateHour
    DateToStr = Year (DateTime) & " - " & DateMonth & " - " & DateDay & "   " & DateHour & " : " & DateMinute
   End   Select
End Function

' *************************************
' 截取 HTML 中的文本函数
' *************************************
Function  Show_HText(xStr,xLen)
   Dim  Nlt,Ngt,iStr,Ncnt
    xStr  =  xStr & ""  
    Nlt  =   inStr (xStr, " < " )
    Ngt  =   inStr (xStr, " > " )
    Ncnt  =  Ngt - Nlt + 1
       if  Nlt > 0   AND  Ngt > Nlt  AND  Ncnt > 0   then
    iStr  =   Mid (xStr,Nlt,Ncnt)
    xStr  =   Replace (xStr,iStr, "" )
   Call  Show_HText(xStr,xLen) 
       end   if
    xStr  =   Replace (xStr, " < " , "" )
    xStr  =   Replace (xStr, " > " , "" )
    xStr  =   Left (xStr,xLen) 
    Show_HText  =  xStr
End Function
% >