<% Server.ScriptTimeout=50000 ' sitemap_gen.asp ' A simple script to automatically produce sitemaps for a webserver, in the Google Sitemap Protocol (GSP) ' by Francesco Passantino ' www.iteam5.net/francesco/sitemap ' v0.2 released 5 june 2005 (Listing a directory tree recursively improvement) ' ' BSD 2.0 license, ' http://www.opensource.org/licenses/bsd-license.php ' 收集整理:重庆森林@im286.com session("server")="//www.Vevb.com" '你的域名 vDir = "/" '制作SiteMap的目录,相对目录(相对于根目录而言) set objfso = CreateObject("Scripting.FileSystemObject") root = Server.MapPath(vDir)
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) str = str & getfilelink(objFile.Path,objfile.dateLastModified) & vbcrlf Next ShowSubFolders(objFolder)
Set objStream = Server.CreateObject("ADODB.Stream") With objStream '.Type = adTypeText '.Mode = adModeReadWrite .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('success!');history.back();</script>") Response.End End If
Sub ShowSubFolders(objFolder) Set colFolders = objFolder.SubFolders For Each objSubFolder In colFolders if folderpermission(objSubFolder.Path) then 'response.write getfilelink(objSubFolder.Path,objSubFolder.dateLastModified) str = str & getfilelink(objSubFolder.Path,objSubFolder.dateLastModified) & vbcrlf Set colFiles = objSubFolder.Files For Each objFile In colFiles 'response.write getfilelink(objFile.Path,objFile.dateLastModified) str = str & getfilelink(objFile.Path,objFile.dateLastModified) & vbcrlf Next ShowSubFolders(objSubFolder) end if Next End Sub
