新云管理系统3.0版 Google地图生成器提供了，测试了，好用

新云管理系统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就行了

最好是在后台里搞个该程序的连接，等你每次更新后就在后台一起生成就行了

复制代码 代码如下:

<%
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 = "" & vbNewLine
    XMLContent = XMLContent & "" & vbNewLine
    XMLContent = XMLContent & "" & vbNewLine
    XMLContent = XMLContent & "" & Thisurl & "/" & vbNewLine & "" & Newasp.FormatDate(Now(),2) & "" & vbNewLine & "daily" & vbNewLine & "1.0" & vbNewLine
    XMLContent = XMLContent & "" & vbNewLine
    LoadSitemap 2,0
    LoadSitemap 1,0
    XMLContent = XMLContent & ""
    strPath = Server.MapPath(strPath) & "\sitemap.xml"
    CreateXMLFile XMLContent,strPath
    Response.Write "生成站点地图成功！"
End Sub 

Sub ChannelSiteMap(strPath)
    XMLContent = "" & vbNewLine
    XMLContent = XMLContent & "" & vbNewLine
    XMLContent = XMLContent & "" & vbNewLine
    XMLContent = XMLContent & "" & Thisurl & "/code/" & vbNewLine & "" & Now() & "" & vbNewLine & "daily" & vbNewLine & "1.0" & vbNewLine
    XMLContent = XMLContent & "" & vbNewLine
    LoadSitemap 2,11
    XMLContent = XMLContent & ""
    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 = "" & vbNewLine
    strLinksUrl = strLinksUrl & "" & Thisurl & LinksUrl & "" & vbNewLine & "" & Newasp.FormatDate(Rs(3),2) & "" & vbNewLine & "daily" & vbNewLine & "1.0" & vbNewLine
    strLinksUrl = strLinksUrl & "" & 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 
%>

本地下载