新云管理系统Google地图生成器for v3.0 版
它的好处不用我多说，但有一点需要声明，程序是官方商业版里东西，3.0版之前只对生成了HTML页面的网站有效，并且只能生成文章和下载频道
2.1版演示地址：http://code.feyu.cn/sitemap.xml
3.0版演示地址：http://www.feyu.cn/sitemap.xml
最新修正ASP动态生成地图
演示地址：http://vip.feyu.cn/sitemap.xml
只要解压上传至网站根目录，运行一下就行了，然后去GG网站管理后台(https://www.google.com/accounts/ServiceLogin?service=sitemaps&hl=zh_CN&continue=https%3A%2F%2Fwww.google.com%2Fwebmasters%2Ftools%2Fsiteoverview&nui=1)提交http://你的网址/sitemap.xml就行了
最好是在后台里搞个该程序的连接，等你每次更新后就在后台一起生成就行了
<!--#include file="inc/const.asp"-->
<%
Server.ScriptTimeout = 50000
Dim Rs,SQL,XMLContent,Thisurl
Dim CreateHtml,ChannelRootDir,ChannelID
Dim XMLDOM,node,Cnode,Cnode1,msginfo
Thisurl="http://" & Request.ServerVariables("HTTP_HOST")
'Response.Clear
'Response.CharSet="UTF-8"
'Response.ContentType="text/xml"
Call IndexSiteMap("/")
'Call ChannelSiteMap("./")
'Response.Write XMLContent
'Response.Write Newasp.FormatDate(now,2)
Sub IndexSiteMap(strPath)
XMLContent = "<?xml version='1.0' encoding='UTF-8'?>" & vbNewLine
XMLContent = XMLContent & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbNewLine
XMLContent = XMLContent & "<url>" & vbNewLine
XMLContent = XMLContent & "<loc>" & Thisurl & "/</loc>" & vbNewLine & "<lastmod>" & Newasp.FormatDate(Now(),2) & "</lastmod>" & vbNewLine & "<changefreq>daily</changefreq>" & vbNewLine & "<priority>1.0</priority>" & vbNewLine
XMLContent = XMLContent & "</url>" & vbNewLine
LoadSitemap 2,0
LoadSitemap 1,0
XMLContent = XMLContent & "</urlset>"
strPath = Server.MapPath(strPath) & "\sitemap.xml"
CreateXMLFile XMLContent,strPath
Response.Write "生成站点地图成功！"
End Sub
Sub ChannelSiteMap(strPath)
XMLContent = "<?xml version='1.0' encoding='UTF-8'?>" & vbNewLine
XMLContent = XMLContent & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbNewLine
XMLContent = XMLContent & "<url>" & vbNewLine
XMLContent = XMLContent & "<loc>" & Thisurl & "/code/</loc>" & vbNewLine & "<lastmod>" & Now() & "</lastmod>" & vbNewLine & "<changefreq>daily</changefreq>" & vbNewLine & "<priority>1.0</priority>" & vbNewLine
XMLContent = XMLContent & "</url>" & vbNewLine
LoadSitemap 2,11
XMLContent = XMLContent & "</urlset>"
strPath = Server.MapPath(strPath) & "\sitemap.xml"
CreateXMLFile XMLContent,strPath
Response.Write "生成站点地图成功！"
End Sub
Function LoadSitemap(ByVal sid, ByVal chanid)
chanid = Newasp.ChkNumeric(chanid)
Dim FindOrder,TableName
If sid = 1 Then
TableName = "[NC_Article]"
FindOrder = "ORDER BY A.WriteTime DESC,A.ArticleID DESC"
SQL = " A.ArticleID,A.ClassID,A.ChannelID,A.WriteTime,A.HtmlFileDate,"
Else
TableName = "[NC_SoftList]"
FindOrder = "ORDER BY A.SoftTime DESC ,A.SoftID DESC"
SQL = " A.SoftID,A.ClassID,A.ChannelID,A.SoftTime,A.HtmlFileDate,"
End If
If chanid = 0 Then
SQL = "SELECT TOP 3000 " & SQL & " C.HtmlFileDir,B.ChannelDir,B.IsCreateHtml,B.HtmlExtName FROM (" & TableName & " 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 " & FindOrder
Else
SQL = "SELECT " & SQL & " C.HtmlFileDir,B.ChannelDir,B.IsCreateHtml,B.HtmlExtName FROM (" & TableName & " A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID) INNER JOIN [NC_Channel] B On A.ChannelID=B.ChannelID WHERE A.ChannelID=" & chanid & " And A.isAccept>0 " & FindOrder
End If
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
Else
CreateHtml = 1'Rs("IsCreateHtml")
Do While Not Rs.EOF
Call LoadSoftList()
Rs.MoveNext
Loop
End If
Rs.Close: Set Rs = Nothing
End Function
Sub LoadSoftList()
Dim HtmlFileName,LinksUrl,strLinksUrl
ChannelID = Rs(2)
Newasp.LoadChannel(ChannelID)
ChannelRootDir = Newasp.ChannelPath
CreateHtml = Newasp.ChannelUseHtml
If CInt(CreateHtml) <> 0 Then
LinksUrl = Newasp.ReadDestination(Newasp.m_InfoDestination, Newasp.m_ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs(0),1,"")
Else
If IsURLRewrite Then
LinksUrl = ChannelRootDir & Rs(0) & Newasp.ChannelHtmlExt
Else
LinksUrl = ChannelRootDir & "show.asp?id=" & Rs(0)
End If
End If
strLinksUrl = "<url>" & vbNewLine
strLinksUrl = strLinksUrl & "<loc>" & Thisurl & LinksUrl & "</loc>" & vbNewLine & "<lastmod>" & Newasp.FormatDate(Rs(3),2) & "</lastmod>" & vbNewLine & "<changefreq>daily</changefreq>" & vbNewLine & "<priority>1.0</priority>" & vbNewLine
strLinksUrl = strLinksUrl & "</url>" & vbNewLine
XMLContent = XMLContent & strLinksUrl
End Sub
'================================================
'函数名：CreateXMLFile
'作 用：创建XML文件
'参 数：XmlStr ----XML字符串
' FormPath ----创建的文件路径
'================================================
Function CreateXMLFile(sXML,FilePath)
Dim objXML
If InStr(FilePath, ":") = 0 Then FilePath = Server.MapPath(FilePath)
Set objXML = Server.CreateObject("MSXML2.DOMDocument.3.0")
If objXML.LoadXml(sXML) Then
objXML.Save(FilePath)
End If
Set objXML = Nothing
End Function
%>