Response.Charset = "gb2312"
Response.ContentType="text/xml"
Response.Write(RssHead)
For i =1 to MaxInfo
'*****************************
ShowInfoUrl=InfoUrl
If ShowInfoUrl="" or isnull(ShowInfoUrl) or isempty(ShowInfoUrl) Then
ShowInfoUrl="#"
Else
If PageType Then ShowInfoUrl=ShowInfoUrl&Rs(0) Else ShowInfoUrl=ShowInfoUrl&Rs(4)
End If
'*****************************
AllContent=LoseHtml(Rs(2))
AllContentLen=byteLen(AllContent)
ShowContent=int(ShowContentLen)
If ShowContentType=0 Then ShowContent=AllContentLen*ShowContent/100
Content=Server.HTMLEncode(titleb(AllContent,ShowContent))
Response.Write("<item>")
Response.Write("<title>")
Response.Write(Rs(1))
Response.Write("</title>")
Response.Write("<link>")
Response.Write(ShowInfoUrl)
Response.Write("</link>")
Response.Write("<description>")
Response.Write(Content)
Response.Write("</description>")
Response.Write("<pubDate>")
Response.Write(return_RFC822_Date(Rs(3),"GMT"))
Response.Write("</pubDate>")
Response.Write("</item>")
If Rs.Eof or i>cint(MaxInfo) Then Exit For
Rs.MoveNext
Next
Response.Write(RssBottom)
End Sub
Function LoseHtml(ContentStr)
Dim ClsTempLoseStr,regEx
ClsTempLoseStr = Cstr(ContentStr)
Set regEx = New RegExp
regEx.Pattern = "</*[^<>]*>"
regEx.IgnoreCase = True
regEx.Global = True
ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")
LoseHtml = ClsTempLoseStr
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
function titleb(str,strlen)
Dim Bstrlen
bstrlen=strlen
If isempty(str) or isnull(str) or str="" Then
titleb=str
exit function
Else
dim l,t,c,i
l=len(str)
t=0
