asp產生xml檔案代碼

代碼如下

複製代碼

<!--#include file="config.asp"--> <% 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"), "&nbsp;", " ")    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 "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine  Response.Write XMLDOM.xml  Set XMLDOM=Nothing End Sub XMLArticleList() ShowXML() CloseConn %>