asp google sitemap生成器代码

<%
' 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:Inetpubwwwroot"

'时区设置，这里设置本地时间同服务器时间的差值
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
%>