<%
Server.ScriptTimeout=50000
'sitemap_gen.asp
'Asimplescripttoautomaticallyproducesitemapsforawebserver,intheGoogleSitemapProtocol(GSP)
'byFrancescoPassantino
'www.iteam5.net/francesco/sitemap
'v0.2released5june2005(Listingadirectorytreerecursivelyimprovement)
'
'BSD2.0license,
'http://www.opensource.org/licenses/bsd-license.php
'收集整理:重庆森林@im286.com
session("server")="//www.Vevb.com"
'你的域名
vDir="/"
'制作SiteMap的目录,相对目录(相对于根目录而言)
setobjfso=CreateObject("Scripting.FileSystemObject")
root=Server.MapPath(vDir)
'response.ContentType="text/xml"
'response.write"<?xmlversion='1.0'encoding='UTF-8'?>"
'response.write"<urlsetxmlns='http://www.google.com/schemas/sitemap/0.84'>"
str="<?xmlversion='1.0'encoding='UTF-8'?>"&vbcrlf
str=str&"<urlsetxmlns='http://www.google.com/schemas/sitemap/0.84'>"&vbcrlf
SetobjFolder=objFSO.GetFolder(root)
'response.writegetfilelink(objFolder.Path,objFolder.dateLastModified)
SetcolFiles=objFolder.Files
ForEachobjFileIncolFiles
'response.writegetfilelink(objFile.Path,objfile.dateLastModified)
str=str&getfilelink(objFile.Path,objfile.dateLastModified)&vbcrlf
Next
ShowSubFolders(objFolder)
'response.write"</urlset>"
str=str&"</urlset>"&vbcrlf
setfso=nothing
SetobjStream=Server.CreateObject("ADODB.Stream")
WithobjStream
'.Type=adTypeText
'.Mode=adModeReadWrite
.Open
.Charset="utf-8"
.Position=objStream.Size
.WriteText=str
.SaveToFileserver.mappath("/sitemap.xml"),2'生成的XML文件名
.Close
EndWith
SetobjStream=Nothing
IfNotErrThen
Response.Write("<script>alert('success!');history.back();</script>")
Response.End
EndIf
SubShowSubFolders(objFolder)
SetcolFolders=objFolder.SubFolders
ForEachobjSubFolderIncolFolders
iffolderpermission(objSubFolder.Path)then
'response.writegetfilelink(objSubFolder.Path,objSubFolder.dateLastModified)
str=str&getfilelink(objSubFolder.Path,objSubFolder.dateLastModified)&vbcrlf
SetcolFiles=objSubFolder.Files
ForEachobjFileIncolFiles
'response.writegetfilelink(objFile.Path,objFile.dateLastModified)
str=str&getfilelink(objFile.Path,objFile.dateLastModified)&vbcrlf
Next
ShowSubFolders(objSubFolder)
endif
Next
EndSub
