新云管理系统Google地图生成器forv3.0版

它的好处不用我多说，但有一点需要声明，程序是官方商业版里东西，3.0版之前只对生成了HTML页面的网站有效，并且只能生成文章和下载频道

2.1版演示地址：http://code.feyu.cn/sitemap.xml

3.0版演示地址：http:///accounts/ServiceLogin?service=sitemaps&hl=zh_CN&continue=https%3A%2F%2F%2Fwebmasters%2Ftools%2Fsiteoverview&nui=1)提交http://你的网址/sitemap.xml就行了

最好是在后台里搞个该程序的连接，等你每次更新后就在后台一起生成就行了
复制代码 代码如下:
<!--#includefile="conn.asp"-->
<!--#includefile="inc/const.asp"-->
<%
Server.ScriptTimeout=50000

DimRs,SQL,XMLContent,Thisurl
DimCreateHtml,ChannelRootDir,ChannelID
DimXMLDOM,node,Cnode,Cnode1,msginfo

Thisurl="http://"&Request.ServerVariables("HTTP_HOST")

'Response.Clear
'Response.CharSet="UTF-8"
'Response.ContentType="text/xml"


CallIndexSiteMap("/")
'CallChannelSiteMap("./")


'Response.WriteXMLContent
'Response.WriteNewasp.FormatDate(now,2)

SubIndexSiteMap(strPath)
XMLContent="<?xmlversion='1.0'encoding='UTF-8'?>"&vbNewLine
XMLContent=XMLContent&"<urlsetxmlns=""http:///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
LoadSitemap2,0
LoadSitemap1,0
XMLContent=XMLContent&"</urlset>"
strPath=Server.MapPath(strPath)&"\sitemap.xml"
CreateXMLFileXMLContent,strPath
Response.Write"生成站点地图成功！"
EndSub

SubChannelSiteMap(strPath)
XMLContent="<?xmlversion='1.0'encoding='UTF-8'?>"&vbNewLine
XMLContent=XMLContent&"<urlsetxmlns=""http:///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
LoadSitemap2,11
XMLContent=XMLContent&"</urlset>"
strPath=Server.MapPath(strPath)&"\sitemap.xml"
CreateXMLFileXMLContent,strPath
Response.Write"生成站点地图成功！"
EndSub

FunctionLoadSitemap(ByValsid,ByValchanid)
chanid=Newasp.ChkNumeric(chanid)
DimFindOrder,TableName
Ifsid=1Then
TableName="[NC_Article]"
FindOrder="ORDERBYA.WriteTimeDESC,A.ArticleIDDESC"
SQL="A.ArticleID,A.ClassID,A.ChannelID,A.WriteTime,A.HtmlFileDate,"
Else
TableName="[NC_SoftList]"
FindOrder="ORDERBYA.SoftTimeDESC,A.SoftIDDESC"
SQL="A.SoftID,A.ClassID,A.ChannelID,A.SoftTime,A.HtmlFileDate,"
EndIf
Ifchanid=0Then
SQL="SELECTTOP3000"&SQL&"C.HtmlFileDir,B.ChannelDir,B.IsCreateHtml,B.HtmlExtNameFROM("&TableName&"AINNERJOIN[NC_Classify]COnA.ClassID=C.ClassID)INNERJOIN[NC_Channel]BOnA.ChannelID=B.ChannelIDWHEREA.isAccept>0"&FindOrder
Else
SQL="SELECT"&SQL&"C.HtmlFileDir,B.ChannelDir,B.IsCreateHtml,B.HtmlExtNameFROM("&TableName&"AINNERJOIN[NC_Classify]COnA.ClassID=C.ClassID)INNERJOIN[NC_Channel]BOnA.ChannelID=B.ChannelIDWHEREA.ChannelID="&chanid&"AndA.isAccept>0"&FindOrder
EndIf
SetRs=Newasp.Execute(SQL)
IfRs.BOFAndRs.EOFThen
Else
CreateHtml=1'Rs("IsCreateHtml")
DoWhileNotRs.EOF
CallLoadSoftList()
Rs.MoveNext
Loop
EndIf
Rs.Close:SetRs=Nothing
EndFunction

SubLoadSoftList()
DimHtmlFileName,LinksUrl,strLinksUrl
ChannelID=Rs(2)
Newasp.LoadChannel(ChannelID)
ChannelRootDir=Newasp.ChannelPath
CreateHtml=Newasp.ChannelUseHtml
IfCInt(CreateHtml)<>0Then
LinksUrl=Newasp.ReadDestination(Newasp.m_InfoDestination,Newasp.m_ChannelDir,Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs(0),1,"")
Else
IfIsURLRewriteThen
LinksUrl=ChannelRootDir&Rs(0)&Newasp.ChannelHtmlExt
Else
LinksUrl=ChannelRootDir&"show.asp?id="&Rs(0)
EndIf
EndIf
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
EndSub
'================================================
'函数名：CreateXMLFile
'作用：创建XML文件
'参数：XmlStr----XML字符串
'FormPath----创建的文件路径
'================================================
FunctionCreateXMLFile(sXML,FilePath)
DimobjXML
IfInStr(FilePath,":")=0ThenFilePath=Server.MapPath(FilePath)
SetobjXML=Server.CreateObject("MSXML2.DOMDocument.3.0")
IfobjXML.LoadXml(sXML)Then
objXML.Save(FilePath)
EndIf
SetobjXML=Nothing
EndFunction
%>

本地下载