Asp生成RSS的类_给网站加上RSS第1/2页(3)

Set Conn=Conn_
Else
Er=true
Errmsg="数据库连接错误"
Exit property
End If
End Property
Public Property Let SetSql(sql_)
Sql=Sql_
End Property
Public Property Get RssHead()
RssHead="<?xml version=""1.0"" encoding=""gb2312"" ?> "
RssHead=RssHead&"<rss>"
RssHead=RssHead&"<channel>"
RssHead=RssHead&"<title>"&WebName&"</title>"
RssHead=RssHead&"<link>"&WebUrl&"</link>"
RssHead=RssHead&"<description>"&WebDes&"</description>"
End Property
Private Property Get RssBottom()
RssBottom="</channel>"
RssBottom=RssBottom&"</rss>"
End Property
Public Sub ShowRss()
On Error resume Next
Dim Rs
Dim ShowInfoUrl,ShowContent,Content
If TypeName(Conn)<>"Connection" Then Er=True:Errmsg="Connection对象有误"
If Sql="" or isnull(Sql)="" or isempty(Sql)="" Then Er=True:Errmsg="没有可执行的Sql语句"
If WebName="" or isnull(WebName)="" or isempty(WebName)="" Then Er=True:Errmsg="请设置RSS标题"
If WebUrl="" or isnull(WebUrl)="" or isempty(WebUrl)="" Then Er=True:Errmsg="请设置网站的链接"
If InfoUrl="" or isnull(InfoUrl)="" or isempty(InfoUrl)="" Then Er=True:Errmsg="请设置链接信息"
If PageType="" or isnull(PageType)="" or isempty(PageType)="" Then Er=True:Errmsg="请设置链接类型"
Set Rs=Server.CreateObject("ADODB.RecordSet")
Rs.Open Sql,Conn,1,1
If Err Then
Er=true
Errmsg="数据库未能打开<br />请检查您的Sql语句是否正确"
Exit Sub
End If

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 = "<\/*[^<>]*>"