Google Sitemap更快更全面收录网站

Google新推出的sitemap，是对原来robots.txt的扩展，sitemap使用xml格式来记录整个网站的信息并供google读取，使搜索引擎能更快更全面的收录网站的内容。
sitemap的作用就好像为网站提供了整站的rss，而google就是这些rss的订阅者，只要网站有更新就会自动通知google。这样一来，搜索引擎的收录由被动的pull变成了主动的push，辛苦的google爬虫们终于可以松一口气了。
快来尝试下： https://www.google.com/webmasters/sitemaps/login
有Gmail的可以用Gmail直接登录。登录后把生成的xml文件地址提交就可以了。
下面提供生成XML的google新推出的sitemap，是对原来robots.txt的扩展，sitemap使用xml格式来记录整个网站的信息并供google读取，使搜索引擎能更快更全面的收录网站的内容。
sitemap的作用就好像为网站提供了整站的rss，而google就是这些rss的订阅者，只要网站有更新就会自动通知google。这样一来，搜索引擎的收录由被动的pull变成了主动的push，辛苦的google爬虫们终于可以松一口气了。
下面提供生成XML的Google SiteMap代码[ASP版本]。

< %
Server.ScriptTimeout = 50000
dim  seoDir
session( " server " ) = " http://www.seo165.com "       ' 网址
seoDir = " / "

set  objfso  =   CreateObject ( " Scripting.FileSystemObject " )
root  =  Server.MapPath(seoDir)

' response.ContentType = "text/xml"
' response.write "<?xml version='1.0' encoding='UTF-8'?>"
' response.write "<urlset xmlns='http://www.google.com/schemas/sitemap/0.84'>"

str  =   " <?xml version='1.0' encoding='UTF-8'?> "   &  vbcrlf
str  =  str  &   " <urlset xmlns='http://www.google.com/schemas/sitemap/0.84'> "   &  vbcrlf

Set  objFolder  =  objFSO.GetFolder(root)
' response.write getfilelink(objFolder.Path,objFolder.dateLastModified)
Set  colFiles  =  objFolder.Files
For   Each  objFile In colFiles
str = str  &  getfilelink(objFile.Path,objfile.dateLastModified)  &  vbcrlf
Next
ShowSubFolders(objFolder)


str  =  str  &   " </urlset> "   &  vbcrlf
set  fso  =   nothing

Set  objStream  =  Server.CreateObject( " ADODB.Stream " )
With  objStream
.Open
.Charset  =   " utf-8 "
.Position  =  objStream.Size
.WriteText = str
.SaveToFile server.mappath( " /sitemap.xml " ), 2   ' 生成的XML文件名
.Close
End   With

Set  objStream  =   Nothing
If   Not  Err  Then
Response.Write( " <script>alert('成功生成站点地图!');history.back();</script> " )
Response.End
End   If

Sub  ShowSubFolders(objFolder)
Set  colFolders  =  objFolder.SubFolders
For   Each  objSubFolder In colFolders
if  folderpermission(objSubFolder.Path)  then
str  =  str  &  getfilelink(objSubFolder.Path,objSubFolder.dateLastModified)  &  vbcrlf
Set  colFiles  =  objSubFolder.Files
For   Each  objFile In colFiles
str  =  str  &  getfilelink(objFile.Path,objFile.dateLastModified)  &  vbcrlf
Next
ShowSubFolders(objSubFolder)
end   if
Next
End Sub


Function  getfilelink(file,datafile)
file = replace (file,root, "" )
file = replace (file, " " , " / " )
If  FileExtensionIsBad(file)  then   Exit   Function
if   month (datafile) < 10   then  filedatem = " 0 "
if   day (datafile) < 10   then  filedated = " 0 "
filedate = year (datafile) & " - " & filedatem & month (datafile) & " - " & filedated & day (datafile)
getfilelink  =   " <url><loc> " & server.htmlencode(session( " server " ) & seoDir & file) & " </loc><lastmod> " & filedate & " </lastmod><changefreq>daily</changefreq><priority>1.0</priority></url> "
Response.Flush
End Function


Function  Folderpermission(pathName)
PathExclusion = Array ( " emp " , " _vti_cnf " , " _vti_pvt " , " _vti_log " , " cgi-bin " , " admin " , " edu " )
Folderpermission  = True
for   each  PathExcluded in PathExclusion
if   instr ( ucase (pathName), ucase (PathExcluded)) > 0   then
Folderpermission  =   False
exit   for
end   if
next
End Function


Function  FileExtensionIsBad(sFileName)
Dim  sFileExtension, bFileExtensionIsValid, sFileExt
Extensions  =   Array ( " png " , " gif " , " jpg " , " jpeg " , " zip " , " pdf " , " ps " , " html " , " htm " , " php " , " wk1 " , " wk2 " , " wk3 " , " wk4 " , " wk5 " , " wki " , " wks " , " wku " , " lwp " , " mw " , " xls " , " ppt " , " doc " , " swf " , " wks " , " wps " , " wdb " , " wri " , " rtf " , " ans " , " txt " , " asp " )
' 设置列表的文件名,扩展名不在其中的话SiteMap则不会收录该扩展名的文件

if   len ( trim (sFileName))  =   0   then
FileExtensionIsBad = true
Exit   Function
end   if

sFileExtension  =   right (sFileName,  len (sFileName)  -   instrrev (sFileName,  " . " ))
bFileExtensionIsValid = false
for   each  sFileExt in extensions
if   ucase (sFileExt) = ucase (sFileExtension)  then
bFileExtensionIsValid = True
exit   for
end   if
next
FileExtensionIsBad  =   not  bFileExtensionIsValid
End Function
% >