**
有关GOOGLE SITEMAP的文章请看: http://andsky.com/show.php?id=436
**
ASP版 :
1
2' sitemap_gen.asp
3' A simple script to automatically produce sitemaps for a webserver, in the Google Sitemap Protocol (GSP)
4' by Francesco Passantino
5' www.iteam5.net/francesco/sitemap
6' v0.2 released 5 june 2005 (Listing a directory tree recursively improvement)
7'
8' BSD 2.0 license,
9' http://www.opensource.org/licenses/bsd-license.php
10' 收集整理: 重庆森林@im286.com
11
12
13session("server")=" http://www.xxx.com " '你的域名
14vDir = "/blueidea" '制作SiteMap的目录,相对目录(相对于根目录而言)
15
16
17set objfso = CreateObject("Scripting.FileSystemObject")
18root = Server.MapPath(vDir)
19
20response.ContentType = "text/xml"
21response.write "
22<?xml version='1.0' encoding='UTF-8'?>
23"
24response.write "
<urlset xmlns="http://www.google.com/schemas/sitemap/0.84">"
Set objFolder = objFSO.GetFolder(root)
'response.write getfilelink(objFolder.Path,objFolder.dateLastModified)
Set colFiles = objFolder.Files
For Each objFile In colFiles
response.write getfilelink(objFile.Path,objfile.dateLastModified)
Next
ShowSubFolders(objFolder)
response.write "</urlset>
1"
2set fso = nothing
3
4
5Sub ShowSubFolders(objFolder)
6Set colFolders = objFolder.SubFolders
7For Each objSubFolder In colFolders
8if folderpermission(objSubFolder.Path) then
9response.write getfilelink(objSubFolder.Path,objSubFolder.dateLastModified)
10Set colFiles = objSubFolder.Files
11For Each objFile In colFiles
12response.write getfilelink(objFile.Path,objFile.dateLastModified)
13Next
14ShowSubFolders(objSubFolder)
15end if
16Next
17End Sub
18
19
20Function getfilelink(file,datafile)
21file=replace(file,root,"")
22file=replace(file,"\","/")
23If FileExtensionIsBad(file) then Exit Function
24if month(datafile)<10 then filedatem="0"
25if day(datafile)<10 then filedated="0"
26filedate=year(datafile)&"-"&filedatem&month(datafile)&"-"&filedated&day(datafile)
27getfilelink = "
<url><loc>"&server.htmlencode(session("server")&vDir&file)&"</loc><lastmod>"&filedate&"</lastmod><changefreq>daily</changefreq><priority>1.0</priority></url>
1"
2Response.Flush
3End Function
4
5
6Function Folderpermission(pathName)
7
8'需要过滤的目录(不列在SiteMap里面)
9PathExclusion=Array("\temp","\\_vti_cnf","_vti_pvt","_vti_log","cgi-bin")
10Folderpermission =True
11for each PathExcluded in PathExclusion
12if instr(ucase(pathName),ucase(PathExcluded))>0 then
13Folderpermission = False
14exit for
15end if
16next
17End Function
18
19
20Function FileExtensionIsBad(sFileName)
21Dim sFileExtension, bFileExtensionIsValid, sFileExt
22'modify for your file extension ( http://www.googleguide.com/file_type.html )
23Extensions = Array("png","gif","jpg","jpeg","zip","pdf","ps","html","htm","asp","php","wk1","wk2","wk3","wk4","wk5","wki","wks","wku","lwp","mw","xls","ppt","doc","swf","wks","wps","wdb","wri","rtf","ans","txt")
24'设置列表的文件名,扩展名不在其中的话SiteMap则不会收录该扩展名的文件
25
26if len(trim(sFileName)) = 0 then
27FileExtensionIsBad = true
28Exit Function
29end if
30
31sFileExtension = right(sFileName, len(sFileName) - instrrev(sFileName, "."))
32bFileExtensionIsValid = false 'assume extension is bad
33for each sFileExt in extensions
34if ucase(sFileExt) = ucase(sFileExtension) then
35bFileExtensionIsValid = True
36exit for
37end if
38next
39FileExtensionIsBad = not bFileExtensionIsValid
40End Function
注意哦,一次指定太多目录的话可能会造成浏览器假死,服务器资源飚升,还有,复制XML内容的时候不要把作者的注释一起复制进去了,哈哈。