网站地图
【www.gdgbn.com--Dom教程】
代码如下
<%
Dim Rs,SQL,foundstr
Dim classid,ChildStr
Dim RssBody,RssTitle,RssHomePageUrl
Dim XMLDOM,node,Cnode,Cnode1,msginfo
Set XMLDOM = Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
XMLDOM.appendChild(XMLDOM.createElement("rss"))
XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"version","")).text="2.0"
Set node = XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"channel",""))
RssHomePageUrl = Newasp.SiteUrl
RssTitle = "获取文章列表"
classid = Newasp.CheckNumeric(Request("classid"))
Dim ChannelRootDir
ChannelRootDir = Newasp.InstallDir & Newasp.ChannelDir
Sub XMLArticleList()
Dim specialID,stype
If Trim(Request("specialID")) <> "" Then
specialID = Newasp.CheckNumeric(Request("SpecialID"))
specialID = CLng(specialID)
If specialID = 0 Then
foundstr = "And A.specialID>0 ORDER BY A.WriteTime DESC ,A.ArticleID DESC"
Else
foundstr = "And A.specialID=" & specialID & " ORDER BY A.WriteTime DESC ,A.ArticleID DESC"
End If
Else
If classid > 0 Then
SQL = "SELECT ClassName,ChildStr FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & CLng(classid)
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
Set Cnode=node.appendChild(XMLDOM.createNode(1,"item",""))
Cnode.appendChild(XMLDOM.createNode(1,"title","")).text="没有找到文章分类"
Cnode.appendChild(XMLDOM.createNode(1,"link","")).text=RssHomePageUrl
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text=Newasp.SiteName
Cnode.appendChild(XMLDOM.createNode(1,"pubDate","")).text=Now()
Set Cnode1=Cnode.appendChild(XMLDOM.createNode(1,"description",""))
msginfo= "没有找到文章分类！"
Cnode1.appendChild(XMLDOM.createCDATASection(msginfo))
Rs.Close: Set Rs = Nothing
Exit Sub
Else
RssTitle = Rs("ClassName")
ChildStr = Rs("ChildStr")
End If
Rs.Close:Set Rs = Nothing
foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.WriteTime DESC ,A.ArticleID DESC"
Else
RssTitle = "全部文章列表"
foundstr = "ORDER BY A.WriteTime DESC ,A.ArticleID DESC"
End If
End If
If Trim(Request("type")) <> "" Then
stype = Newasp.CheckNumeric(Request("type"))
stype = CInt(stype)
If stype = 0 Then
foundstr = Replace(foundstr, "A.WriteTime", "A.AllHits")
Else
foundstr = "And IsBest>0 " & foundstr
End If
End If
node.appendChild(XMLDOM.createNode(1,"title","")).text=Newasp.SiteName&"--"&RssTitle
node.appendChild(XMLDOM.createNode(1,"link","")).text=Newasp.SiteUrl
node.appendChild(XMLDOM.createNode(1,"language","")).text="zh-cn"
node.appendChild(XMLDOM.createNode(1,"description","")).text=Newasp.SiteName
node.appendChild(XMLDOM.createNode(1,"copyright","")).text=Newasp.SiteUrl
node.appendChild(XMLDOM.createNode(1,"generator","")).text="Rss Generator By Newasp.Net"
Dim HtmlFileName,HtmlFileUrl
SQL = " A.ArticleID,A.ClassID,A.title,A.Content,A.WriteTime,A.HtmlFileDate,A.author,"
SQL = "SELECT TOP 100 " & SQL & " C.ClassName,C.HtmlFileDir,C.UseHtml,B.ChannelDir,B.StopChannel,B.ModuleName,B.IsCreateHtml,B.HtmlExtName,B.HtmlPath,B.HtmlForm,B.HtmlPrefix FROM ([NC_Article] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID) INNER JOIN [NC_Channel] B On A.ChannelID=B.ChannelID WHERE A.isAccept>0 And A.ChannelID=" & CLng(ChannelID) & " " & foundstr & ""
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
Set Cnode=node.appendChild(XMLDOM.createNode(1,"item",""))
Cnode.appendChild(XMLDOM.createNode(1,"title","")).text="没有找到文章"
Cnode.appendChild(XMLDOM.createNode(1,"link","")).text=RssHomePageUrl
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text=Newasp.SiteName
Cnode.appendChild(XMLDOM.createNode(1,"pubDate","")).text=Now()
Set Cnode1=Cnode.appendChild(XMLDOM.createNode(1,"description",""))
msginfo= "没有找到文章！"
Cnode1.appendChild(XMLDOM.createCDATASection(msginfo))
Rs.Close: Set Rs = Nothing
Exit Sub
Else
Do While Not Rs.EOF
HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ArticleID"), Rs("HtmlExtName"), Rs("HtmlPrefix"), Rs("HtmlForm"), "")
If Rs("IsCreateHtml") <> 0 Then
HtmlFileUrl = ShowChannelPath(ChannelRootDir,Rs("HtmlFileDir")) & Newasp.ShowDatePath(Rs("HtmlFileDate"), Rs("HtmlPath")) & HtmlFileName
Else
HtmlFileUrl = Newasp.GetChannelDir(ChannelID) & "show.asp?id=" & Rs("ArticleID")
End If
If LCase(Left(HtmlFileUrl,7)) <> "http://" Then HtmlFileUrl = RssHomePageUrl & HtmlFileUrl
Set Cnode=node.appendChild(XMLDOM.createNode(1,"item",""))
Cnode.appendChild(XMLDOM.createNode(1,"title","")).text=Replace(Rs("title"), " ", " ")
Cnode.appendChild(XMLDOM.createNode(1,"link","")).text=HtmlFileUrl
Cnode.appendChild(XMLDOM.createNode(1,"category","")).text=Rs("ClassName")
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text=Rs("author")
Cnode.appendChild(XMLDOM.createNode(1,"pubDate","")).text=Rs("WriteTime")
Set Cnode1=Cnode.appendChild(XMLDOM.createNode(1,"description",""))
msginfo= Newasp.CutString(Rs("Content"), 300)
Cnode1.appendChild(XMLDOM.createCDATASection(msginfo))
Rs.MoveNext
Loop
End If
Rs.Close: Set Rs = Nothing
End Sub
Sub ShowXML()
Response.Clear
Response.CharSet="gb2312"
Response.ContentType="text/xml"
Response.Write ""&vbNewLine
Response.Write XMLDOM.xml
Set XMLDOM=Nothing
End Sub
XMLArticleList()
ShowXML()
CloseConn
%>