Google SiteMap 生成工具 (asp )


**

有关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>"&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   

注意哦,一次指定太多目录的话可能会造成浏览器假死,服务器资源飚升,还有,复制XML内容的时候不要把作者的注释一起复制进去了,哈哈。

Published At
Categories with Web编程
Tagged with
comments powered by Disqus