<% ' asp-google-sitemaps.asp ' by David Yin ' http://seo.g2soft.net/online-tools/google_sitemaps_gen.php ' v0.1 08.30.06 ' ' BSD 2.0 license, ' http://www.opensource.org/licenses/bsd-license.php '修改下面的三个设置参数，网址，物理目录和虚拟目录 session("server")="http://www.yourdomain.net/" vDir = "/" phisicalDir="C:\Inetpub\wwwroot\" '时区设置，这里设置本地时间同服务器时间的差值 utcOffset=1 set objfso = CreateObject("Scripting.FileSystemObject") root = Server.MapPath(vDir) response.ContentType = "text/xml" response.write "" response.write "" response.write "" Set objFolder = objFSO.GetFolder(root) 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,data) file=replace(file,phisicalDir,"") file=replace(file,"\","/") If FileExtensionIsBad(file) then Exit Function If FileNameIsBad(file) then Exit Function filelmdate=iso8601date(data,utcOffset) getfilelink = ""&server.htmlencode(session("server")&file)&""&filelmdate&"1.0" session("URLS")=session("URLS")+1 Response.Flush End Function Function Folderpermission(pathName) '设置不想包括在sitemaps里的目录 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 'http://www.googleguide.com/file_type.html Extensions = Array("png","gif","jpg","zip","pdf","ps","html","htm","asp","wk1","wk2","wk3","wk4","wk5","wki","wks","wku","lwp","mw","xls","ppt","doc","wks","wps","wdb","wri","rtf","ans","txt") 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 Function FileNameIsBad(sFileName) if len(trim(sFileName)) = 0 then FileNameIsBad = true Exit Function end if Filename = Array("/alive.asp","/404.asp","/500.asp","/sitemap_gen.asp") FileNameNumber = ubound(Filename) for i=0 to FileNameNumber if Filename(i) = sFileName then FileNameIsBad = True end if next End Function Function iso8601date(dLocal,utcOffset) Dim d ' 根据时区设置来转换本地时间 d = DateAdd("H",-1 * utcOffset,dLocal) ' compose the date iso8601date = Year(d) & "-" & Right("0" & Month(d),2) & "-" & Right("0" & Day(d),2) & "T" & _ Right("0" & Hour(d),2) & ":" & Right("0" & Minute(d),2) & ":" & Right("0" & Second(d),2) & "Z" End Function %>