|
对于喜欢网站的内容被各个rss订阅，利于别人快速掌握我们的信息，就需要这个东西，推荐
什么是RSS？
RSS是站点用来和其他站点之间共享内容的一种简易方式（也叫聚合内容），通常被用于新闻和其他按顺序排列的网站，例如Blog。一段项目的介绍可能包含新闻的全部介绍等。或者仅仅是额外的内容或者简短的介绍。这些项目的链接通常都能链接到全部的内容。网络用户可以在客户端借助于支持RSS的新闻聚合软件（如FeedDemon、SharpReader,NewzCrawler），在不打开网站内容页面的情况下阅读支持RSS输出的网站内容。网站提供RSS输出，有利于让用户发现网站内容的更新。
RSS如何工作？
首先您一般需要下载和安装一个RSS新闻阅读器，然后从网站提供的聚合新闻目录列表中订阅您感兴趣的新闻栏目的内容。订阅后，您将会及时获得所订阅新闻频道的最新内容。
阅读RSS新闻的特点？
1.没有广告或者图片来影响标题或者文章概要的阅读。
2.RSS阅读器自动更新你定制的网站内容，保持新闻的及时性。
3.用户可以加入多个定制的RSS提要，从多个来源搜集新闻整合 到单个数据流中。
随着网络的普及，越来越多的人习惯通过网络来获取信息、查询资料。虽然各种各样的门户网站纷纷兴起，但在各个网站之间来回穿梭也的确是十分麻烦，搜索引擎可以帮助我们搜索到任何想要找的东西，但查找起来也比较麻烦。现在网络上出现了一种全新的资讯方式，他可以把我们定阅的各种资讯送到我们的桌面上来，不但可以及时了解最新的新闻资讯，而且免去了浏览网站时恼人的网络广告，这种最新的资讯方式被叫做信息聚合，简称RSS。
通过RSS技术，我们可以把定阅的最新的资讯接收到电脑桌面上，要接收RSS信息，使用RSS阅读器是最好的方法。当网站内容更新时，RSS阅读器就会自动接收，把最新的信息接收到本地电脑桌面上来，同时可以看到最新信息的标题与摘要，点击标题就能够查看全文内容了。自从去年国内“博客”的兴起，使的RSS资源渐渐多了起来，同时各大网站也纷纷推出了RSS服务，通常只要看到网站上有XML标志，就说明该网站提供RSS服务。
FeedDemon、看天下网络资讯浏览器 、新浪点点通阅读器、周博通等是常见的RSS阅读器。
复制代码 代码如下:
<%
Dim Rs,Newrss
Class Rss
'*******************输入参数********************
'***********************************************
'SetConn 必填 网站使用的Connection对象
'SetSql 必填 Sql查询语句。强烈建议使用在Sql语句中使用Top关键字
' Sql语句中包含的字段[新闻Id,标题,内容,时间,静态页名称]
' 注:不要颠倒顺序
' 如果新闻不是生成的静态页，则无最后一项，SetPageType的值则为1
'SetWebName 必填 网站名称
'SetWebUrl 必填 网站的地址
'SetWebDes 非必填 网站的描述信息
'SetPageType 必填 信息显示页的链接类型 1 为动态页面Id 0为静态页面
'SetMaxInfo 非必填 强制显示信息的数目，若取数据>SetMaxInfo 则显示SetMaxInfo条数据。强烈建议使用在Sql语句中使用Top关键字
'setContentShow 非必填 信息简介设置。注意：该参数为数组（ShowContentType,ShowContentLen）
' ShowContentType [数字类型] 为内容显示方式[参数(0,1)0为按百分比就算显示信息,1为按字数]
' ShowContentLen 内容显示的长度 由ShowContentType 决定实际长度
'*****************输出参数********************
'ShowRss 显示Rss
'======================================================
'例如
'Set NewRss=New Rss
' Set NewRss.SetConn=article_conn
' NewRss.SetSql="select top 30 newsid,title,content,dateandtime,N_fname from article where typeid=1 order by newsid Desc"
' NewRss.SetWebName="测试中"
' NewRss.SetWebUrl="//www.jb51.net"
' NewRss.SetMaxInfo=10
' NewRss.SetInfourl="//www.jb51.net"
' NewRss.SetPageType="0"
' NewRss.setContentShow="1,200"
' NewRss.ShowRss()
'Set NewRss=Nothing
'======================================================
Private Conn,Sql,WebName,WebUrl,WebDes,Er,MaxInfo,i,Infourl,PageType
Private ShowContentType,ShowContentLen
Private AllContent,AllContentLen
Private Sub Class_initialize()
MaxInfo=20
'PageType=1
ShowContentType=0
ShowContentLen=20
Er=false
End Sub
Private Sub Class_terminate()
If isObject(Rs) then Set Rs=Nothing
End Sub
Public Property Let Errmsg(msg)
If Er then
Response.Clear()
Response.Write(msg)
Response.End()
End If
End Property
Public Property Let SetWebName(WebName_)
WebName=WebName_
End Property
Public Property Let SetWebUrl(WebUrl_)
WebUrl=WebUrl_
End Property
Public Property Let SetWebDes(webDes_)
WebDes=WebDes_
End Property
Public Property Let SetInfoUrl(Infourl_)
Infourl=Infourl_
End Property
Public Property Let SetPageType(PageType_)
PageType=PageType_
End Property
Public Property Let SetMaxInfo(MaxInfo_)
MaxInfo=MaxInfo_
End Property
Public Property Let setContentShow(ContentShow_)
Dim ArrContentShow
ArrContentShow=Split(ContentShow_,",")
If Ubound(ArrContentShow)<>1 Then Er=True:Errmsg="信息显示参数设置有误!!"
ShowContentType=ArrContentShow(0)
ShowContentLen=ArrContentShow(1)
If Not isnumeric(ShowContentType) or ShowContentType="" Then ShowContentType=0
If Not isnumeric(ShowContentLen) or ShowContentLen="" Then
If ShowContentType=0 Then ShowContentLen=20 Else ShowContentLen=200
Else
If ShowContentType=0 and (ShowContentLen>100 or ShowContentLen<10) Then ShowContentLen=20
End If
End Property
Public Property Set SetConn(Conn_)
If TypeName(Conn_)="Connection" Then
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 = "<\/*[^<>]*>"
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
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=bstrlen then
titleb=left(str,i)
exit for
else
titleb=str&""
end if
next
End If
end function
function byteLen(str)
dim lenStr,lenTemp,i
lenStr=0
lenTemp=len(str)
dim strTemp
for i=1 to lenTemp
strTemp=asc(mid(str,i,1))
if strTemp>255 or strTemp<=0 then
lenStr=lenStr+2
else
lenStr=lenStr+1
end if
next
byteLen=lenStr
end function
End Class
%>
对于喜欢网站的内容被各个rss订阅，利于别人快速掌握我们的信息，就需要这个东西，推荐
一、必须弄清楚最终需要的是什么
我们通过asp或其他动态编程语言，最终需要的是XML格式的数据，这点和XML数据所在的文件载体无关，它可以是实实在在的XML文件，比如：http://blog.knowsky.com/rss_1.xml 。也可以为asp文档，比如：http://www.goodtext.org/Blog/
他们都是XML数据的体现，为了实现XML数据的动态，所以需要使用到动态编程语言，比如ASP来实现生成它。
二、如何生成动态的XML文档
如果是生成XML文件，介于动态文档是ASP格式的，所以必须借助FSO进行XML文件的生成，比如：
以下是引用片段：
<%
xmlfile=server.mappath("test1.xml")
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile(xmlfile,True)
MyFile.WriteLine("<?xml version=""1.0"" encoding=""gb2312""?>")
MyFile.WriteLine("<世界>")
MyFile.WriteLine("<你好>hello,world</你好>")
MyFile.WriteLine("</世界>")
MyFile.Close
%>
<a href="test1.xml">查看XML文件内容</a>
如果按照生成动态的XML数据文件来说，则是将MyFile.WriteLine的相关内容在动态文档中通过程式的手段来控制XML节点的名称和值即可。
三、如何使用动态文档生成XML数据
那如果不是生成XML文件，直接在动态文档上输出XML数据呢，须声明文件的类型（即Response.ContentType）
<%Response.ContentType = "text/XML"%>
比如直接浏览如下的动态ASP文档，在浏览器中下则显示为XML数据树
以下是引用片段：
<%
With Response
.ContentType = "text/XML"
.write("<?xml version=""1.0"" encoding=""gb2312""?>")
.write("<世界>")
.write("<你好>hello,world</你好>")
.write("</世界>")
End with
%>
生成的XML文件，其优势就是处理该XML数据的文档可以是静态文档，比如HTML文件通过javascript、XMLDOM来解析XML，同时也易于数据的保留，而动态文档上的动态XML数据则没有这样有点。不过，在如今动态文档无处不在用的时代，似乎这个优势对于一些应用来说是无甚影响，甚至来说，动态文档的XML数据流反而更具优势：更及时、更动态。
四、生成XML数据就是这样行了吗？
无论是通过生成具体的XML文件，还是动态的XML数据流，只要按照XML的格式输出相关XML节点和值就可以了，这样看来XML似乎很简单。但这并没有真正接触到XML的操作。在我们看来，这些XML无非就是一些成对的标签和相关字符组成的数据记录，毫无生命力可言。然而事实上，通过XMLDOM来操作XML则显示了XML的绝对优势（这点在生成XML时优势不明显，却在添加、删除XML节点时体验无限）。
使用XMLDOM创建XML文档，可使用Save方法生成XML文档，使用createElement方法创建XML元素、createNode创建节点，其实对于XML中的任何标签的创建都可以任意选择其中的一种，不过一般使用createElement创建顶层（根）元素，使用createNode创建子节点（元素），当然createElement和createNode的使用方法也是不同。
以下是引用片段：
<%
Set objXMLdoc = CreateObject("Microsoft.XMLDOM")
Set world=objXMLdoc.createElement("世界")
objXMLdoc.appendChild(world)
Set hello=objXMLdoc.createNode("element", "你好", "")
hello.Text = "hello,world"
objXMLdoc.documentElement.appendChild(hello)
objXMLdoc.Save Server.MapPath("test2.xml")
Set objXMLdoc = Nothing
%>
CreateObject("Microsoft.XMLDOM") 声明使用XMLDOM对象
在元素或节点被建立（createElement、createNode）时，其并没有加到文件树中，若要将节点加到文件树中，则需要插入，如appendChild。
xmlDocument.createNode(type, name, nameSpaceURI) 表示建立一个指定型态、名称，及命名空间的新节点
type 用来确认要被建立的节点型态，name 是一个字符串来确认新节点的名称，命名空间的前缀则是选择性的。nameSpaceURI 是一个定义命名空间URI 的字符串。如果前缀被包含在名称参数中，此节点会在nameSpaceURI 的内文中以指定的前缀建立。如果不包含前缀，指定的命名空间会被视为预设的命名空间。
objXMLdoc.createNode("element", "你好", "") 等同于 objXMLdoc.createElement("你好")
4，objXMLdoc.documentElement.appendChild(hello)其实就是XML文档根元素下建立节点，在本例中等同于 world.appendChild(hello)，world为本例中的节点名，以此类推。
所以可以这样来写：
以下是引用片段：
<%
Set objXMLdoc = CreateObject("Microsoft.XMLDOM")
Set world=objXMLdoc.createElement("世界")
objXMLdoc.appendChild(world)
Set hello=objXMLdoc.createElement("你好")
hello.Text = "hello,world"
world.appendChild(hello)
objXMLdoc.Save Server.MapPath("test2.xml")
Set objXMLdoc = Nothing
%>
需要注意的是，通过XMLDOM生成的XML文件都是UTF-8格式的，这对我们所有应用程序文件的UTF-8化作了很好的推介。
总结
生成XML数据，可以使用FSO，如FSO被禁用，可使用XMLDOM，当然还可以直接使用动态文档。不过如果融会贯通地掌握XML的操作，XMLDOM操作是必须的。
对于喜欢网站的内容被各个rss订阅，利于别人快速掌握我们的信息，就需要这个东西，推荐
什么是RSS？
RSS是站点用来和其他站点之间共享内容的一种简易方式（也叫聚合内容），通常被用于新闻和其他按顺序排列的网站，例如Blog。一段项目的介绍可能包含新闻的全部介绍等。或者仅仅是额外的内容或者简短的介绍。这些项目的链接通常都能链接到全部的内容。网络用户可以在客户端借助于支持RSS的新闻聚合软件（如FeedDemon、SharpReader,NewzCrawler），在不打开网站内容页面的情况下阅读支持RSS输出的网站内容。网站提供RSS输出，有利于让用户发现网站内容的更新。
RSS如何工作？
首先您一般需要下载和安装一个RSS新闻阅读器，然后从网站提供的聚合新闻目录列表中订阅您感兴趣的新闻栏目的内容。订阅后，您将会及时获得所订阅新闻频道的最新内容。
阅读RSS新闻的特点？
1.没有广告或者图片来影响标题或者文章概要的阅读。
2.RSS阅读器自动更新你定制的网站内容，保持新闻的及时性。
3.用户可以加入多个定制的RSS提要，从多个来源搜集新闻整合 到单个数据流中。
随着网络的普及，越来越多的人习惯通过网络来获取信息、查询资料。虽然各种各样的门户网站纷纷兴起，但在各个网站之间来回穿梭也的确是十分麻烦，搜索引擎可以帮助我们搜索到任何想要找的东西，但查找起来也比较麻烦。现在网络上出现了一种全新的资讯方式，他可以把我们定阅的各种资讯送到我们的桌面上来，不但可以及时了解最新的新闻资讯，而且免去了浏览网站时恼人的网络广告，这种最新的资讯方式被叫做信息聚合，简称RSS。
通过RSS技术，我们可以把定阅的最新的资讯接收到电脑桌面上，要接收RSS信息，使用RSS阅读器是最好的方法。当网站内容更新时，RSS阅读器就会自动接收，把最新的信息接收到本地电脑桌面上来，同时可以看到最新信息的标题与摘要，点击标题就能够查看全文内容了。自从去年国内“博客”的兴起，使的RSS资源渐渐多了起来，同时各大网站也纷纷推出了RSS服务，通常只要看到网站上有XML标志，就说明该网站提供RSS服务。
FeedDemon、看天下网络资讯浏览器 、新浪点点通阅读器、周博通等是常见的RSS阅读器。
复制代码 代码如下:
<%
Dim Rs,Newrss
Class Rss
'*******************输入参数********************
'***********************************************
'SetConn 必填 网站使用的Connection对象
'SetSql 必填 Sql查询语句。强烈建议使用在Sql语句中使用Top关键字
' Sql语句中包含的字段[新闻Id,标题,内容,时间,静态页名称]
' 注:不要颠倒顺序
' 如果新闻不是生成的静态页，则无最后一项，SetPageType的值则为1
'SetWebName 必填 网站名称
'SetWebUrl 必填 网站的地址
'SetWebDes 非必填 网站的描述信息
'SetPageType 必填 信息显示页的链接类型 1 为动态页面Id 0为静态页面
'SetMaxInfo 非必填 强制显示信息的数目，若取数据>SetMaxInfo 则显示SetMaxInfo条数据。强烈建议使用在Sql语句中使用Top关键字
'setContentShow 非必填 信息简介设置。注意：该参数为数组（ShowContentType,ShowContentLen）
' ShowContentType [数字类型] 为内容显示方式[参数(0,1)0为按百分比就算显示信息,1为按字数]
' ShowContentLen 内容显示的长度 由ShowContentType 决定实际长度
'*****************输出参数********************
'ShowRss 显示Rss
'======================================================
'例如
'Set NewRss=New Rss
' Set NewRss.SetConn=article_conn
' NewRss.SetSql="select top 30 newsid,title,content,dateandtime,N_fname from article where typeid=1 order by newsid Desc"
' NewRss.SetWebName="测试中"
' NewRss.SetWebUrl="//www.jb51.net"
' NewRss.SetMaxInfo=10
' NewRss.SetInfourl="//www.jb51.net"
' NewRss.SetPageType="0"
' NewRss.setContentShow="1,200"
' NewRss.ShowRss()
'Set NewRss=Nothing
'======================================================
Private Conn,Sql,WebName,WebUrl,WebDes,Er,MaxInfo,i,Infourl,PageType
Private ShowContentType,ShowContentLen
Private AllContent,AllContentLen
Private Sub Class_initialize()
MaxInfo=20
'PageType=1
ShowContentType=0
ShowContentLen=20
Er=false
End Sub
Private Sub Class_terminate()
If isObject(Rs) then Set Rs=Nothing
End Sub
Public Property Let Errmsg(msg)
If Er then
Response.Clear()
Response.Write(msg)
Response.End()
End If
End Property
Public Property Let SetWebName(WebName_)
WebName=WebName_
End Property
Public Property Let SetWebUrl(WebUrl_)
WebUrl=WebUrl_
End Property
Public Property Let SetWebDes(webDes_)
WebDes=WebDes_
End Property
Public Property Let SetInfoUrl(Infourl_)
Infourl=Infourl_
End Property
Public Property Let SetPageType(PageType_)
PageType=PageType_
End Property
Public Property Let SetMaxInfo(MaxInfo_)
MaxInfo=MaxInfo_
End Property
Public Property Let setContentShow(ContentShow_)
Dim ArrContentShow
ArrContentShow=Split(ContentShow_,",")
If Ubound(ArrContentShow)<>1 Then Er=True:Errmsg="信息显示参数设置有误!!"
ShowContentType=ArrContentShow(0)
ShowContentLen=ArrContentShow(1)
If Not isnumeric(ShowContentType) or ShowContentType="" Then ShowContentType=0
If Not isnumeric(ShowContentLen) or ShowContentLen="" Then
If ShowContentType=0 Then ShowContentLen=20 Else ShowContentLen=200
Else
If ShowContentType=0 and (ShowContentLen>100 or ShowContentLen<10) Then ShowContentLen=20
End If
End Property
Public Property Set SetConn(Conn_)
If TypeName(Conn_)="Connection" Then
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 = "<\/*[^<>]*>"
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
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=bstrlen then
titleb=left(str,i)
exit for
else
titleb=str&""
end if
next
End If
end function
function byteLen(str)
dim lenStr,lenTemp,i
lenStr=0
lenTemp=len(str)
dim strTemp
for i=1 to lenTemp
strTemp=asc(mid(str,i,1))
if strTemp>255 or strTemp<=0 then
lenStr=lenStr+2
else
lenStr=lenStr+1
end if
next
byteLen=lenStr
end function
End Class
%>
一、必须弄清楚最终需要的是什么
我们通过asp或其他动态编程语言，最终需要的是XML格式的数据，这点和XML数据所在的文件载体无关，它可以是实实在在的XML文件，比如：http://blog.knowsky.com/rss_1.xml 。也可以为asp文档，比如：http://www.goodtext.org/Blog/
他们都是XML数据的体现，为了实现XML数据的动态，所以需要使用到动态编程语言，比如ASP来实现生成它。
二、如何生成动态的XML文档
如果是生成XML文件，介于动态文档是ASP格式的，所以必须借助FSO进行XML文件的生成，比如：
以下是引用片段：
<%
xmlfile=server.mappath("test1.xml")
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile(xmlfile,True)
MyFile.WriteLine("<?xml version=""1.0"" encoding=""gb2312""?>")
MyFile.WriteLine("<世界>")
MyFile.WriteLine("<你好>hello,world</你好>")
MyFile.WriteLine("</世界>")
MyFile.Close
%>
<a href="test1.xml">查看XML文件内容</a>
如果按照生成动态的XML数据文件来说，则是将MyFile.WriteLine的相关内容在动态文档中通过程式的手段来控制XML节点的名称和值即可。
三、如何使用动态文档生成XML数据
那如果不是生成XML文件，直接在动态文档上输出XML数据呢，须声明文件的类型（即Response.ContentType）
<%Response.ContentType = "text/XML"%>
比如直接浏览如下的动态ASP文档，在浏览器中下则显示为XML数据树
以下是引用片段：
<%
With Response
.ContentType = "text/XML"
.write("<?xml version=""1.0"" encoding=""gb2312""?>")
.write("<世界>")
.write("<你好>hello,world</你好>")
.write("</世界>")
End with
%>
生成的XML文件，其优势就是处理该XML数据的文档可以是静态文档，比如HTML文件通过javascript、XMLDOM来解析XML，同时也易于数据的保留，而动态文档上的动态XML数据则没有这样有点。不过，在如今动态文档无处不在用的时代，似乎这个优势对于一些应用来说是无甚影响，甚至来说，动态文档的XML数据流反而更具优势：更及时、更动态。
四、生成XML数据就是这样行了吗？
无论是通过生成具体的XML文件，还是动态的XML数据流，只要按照XML的格式输出相关XML节点和值就可以了，这样看来XML似乎很简单。但这并没有真正接触到XML的操作。在我们看来，这些XML无非就是一些成对的标签和相关字符组成的数据记录，毫无生命力可言。然而事实上，通过XMLDOM来操作XML则显示了XML的绝对优势（这点在生成XML时优势不明显，却在添加、删除XML节点时体验无限）。
使用XMLDOM创建XML文档，可使用Save方法生成XML文档，使用createElement方法创建XML元素、createNode创建节点，其实对于XML中的任何标签的创建都可以任意选择其中的一种，不过一般使用createElement创建顶层（根）元素，使用createNode创建子节点（元素），当然createElement和createNode的使用方法也是不同。
以下是引用片段：
<%
Set objXMLdoc = CreateObject("Microsoft.XMLDOM")
Set world=objXMLdoc.createElement("世界")
objXMLdoc.appendChild(world)
Set hello=objXMLdoc.createNode("element", "你好", "")
hello.Text = "hello,world"
objXMLdoc.documentElement.appendChild(hello)
objXMLdoc.Save Server.MapPath("test2.xml")
Set objXMLdoc = Nothing
%>
CreateObject("Microsoft.XMLDOM") 声明使用XMLDOM对象
在元素或节点被建立（createElement、createNode）时，其并没有加到文件树中，若要将节点加到文件树中，则需要插入，如appendChild。
xmlDocument.createNode(type, name, nameSpaceURI) 表示建立一个指定型态、名称，及命名空间的新节点
type 用来确认要被建立的节点型态，name 是一个字符串来确认新节点的名称，命名空间的前缀则是选择性的。nameSpaceURI 是一个定义命名空间URI 的字符串。如果前缀被包含在名称参数中，此节点会在nameSpaceURI 的内文中以指定的前缀建立。如果不包含前缀，指定的命名空间会被视为预设的命名空间。
objXMLdoc.createNode("element", "你好", "") 等同于 objXMLdoc.createElement("你好")
4，objXMLdoc.documentElement.appendChild(hello)其实就是XML文档根元素下建立节点，在本例中等同于 world.appendChild(hello)，world为本例中的节点名，以此类推。
所以可以这样来写：
以下是引用片段：
<%
Set objXMLdoc = CreateObject("Microsoft.XMLDOM")
Set world=objXMLdoc.createElement("世界")
objXMLdoc.appendChild(world)
Set hello=objXMLdoc.createElement("你好")
hello.Text = "hello,world"
world.appendChild(hello)
objXMLdoc.Save Server.MapPath("test2.xml")
Set objXMLdoc = Nothing
%>
需要注意的是，通过XMLDOM生成的XML文件都是UTF-8格式的，这对我们所有应用程序文件的UTF-8化作了很好的推介。
总结
生成XML数据，可以使用FSO，如FSO被禁用，可使用XMLDOM，当然还可以直接使用动态文档。不过如果融会贯通地掌握XML的操作，XMLDOM操作是必须的。 |
发表于 2008-10-11 09:43:09
