<%
' 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")="http://www.xxx.com"           '你的域名
vDir = "/blueidea"                             '制作SiteMap的目录,相对目录(相对于根目录而言)


set objfso = CreateObject("Scripting.FileSystemObject")
root = Server.MapPath(vDir)

response.ContentType = "text/xml"
response.write ""
response.write "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 ""
set fso = nothing


Sub ShowSubFolders(objFolder)
    Set colFolders = objFolder.SubFolders
    For Each objSubFolder In colFolders
        if folderpermission(objSubFolder.Path) then
              response.write getfilelink(objSubFolder.Path,objSubFolder.dateLastModified)
              Set colFiles = objSubFolder.Files
              For Each objFile In colFiles
                  response.write getfilelink(objFile.Path,objFile.dateLastModified)
              Next
              ShowSubFolders(objSubFolder)
        end if
    Next
End Sub


Function getfilelink(file,datafile)
    file=replace(file,root,"")
    file=replace(file,"\","/")
    If FileExtensionIsBad(file) then Exit Function
    if month(datafile)<10 then filedatem="0"
    if day(datafile)<10 then filedated="0"
    filedate=year(datafile)&"-"&filedatem&month(datafile)&"-"&filedated&day(datafile)
    getfilelink = ""&server.htmlencode(session("server")&vDir&file)&""&filedate&"daily1.0"
    Response.Flush
End Function


Function Folderpermission(pathName)

    '需要过滤的目录(不列在SiteMap里面)
    PathExclusion=Array("\temp","\_vti_cnf","_vti_pvt","_vti_log","cgi-bin")
    Folderpermission =True
    for each PathExcluded in PathExclusion
        if instr(ucase(pathName),ucase(PathExcluded))>0 then
              Folderpermission = False
              exit for
        end if
    next
End Function


Function FileExtensionIsBad(sFileName)
    Dim sFileExtension, bFileExtensionIsValid, sFileExt
    'modify for your file extension (http://www.googleguide.com/file_type.html)
    Extensions = 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")
'设置列表的文件名,扩展名不在其中的话SiteMap则不会收录该扩展名的文件

    if len(trim(sFileName)) = 0 then
        FileExtensionIsBad = true
        Exit Function
    end if

    sFileExtension = right(sFileName, len(sFileName) - instrrev(sFileName, "."))
    bFileExtensionIsValid = false     'assume extension is bad
    for each sFileExt in extensions
        if ucase(sFileExt) = ucase(sFileExtension) then
              bFileExtensionIsValid = True
              exit for
        end if
    next
    FileExtensionIsBad = not bFileExtensionIsValid
End Function
%>