Google SiteMap 生成工具

 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
11  
12session("server")="http://www.xxx.com" '你的域名   
13vDir = "/blueidea" '制作SiteMap的目录,相对目录(相对于根目录而言) 
14
15  
16set objfso = CreateObject("Scripting.FileSystemObject")   
17root = Server.MapPath(vDir) 
18
19response.ContentType = "text/xml"   
20response.write "
21<?xml version='1.0' encoding='UTF-8'?>
22"   
23response.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>"&amp;server.htmlencode(session("server")&amp;vDir&amp;file)&amp;"</loc><lastmod>"&amp;filedate&amp;"</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   
Published At
Categories with Web编程
Tagged with
comments powered by Disqus