google sitemap.asp

　　用于生成sitemap.xml文件的东西，利于google等搜索引擎的抓取。
复制代码 代码如下:
<%
Server.ScriptTimeout=50000
sitemap_gen.asp
Asimplescripttoautomaticallyproducesitemapsforawebserver,intheGoogleSitemapProtocol(GSP)
byFrancescoPassantino

v0.2released5june2005(Listingadirectorytreerecursivelyimprovement)

BSD2.0license,

收集整理:重庆森林
session(server)=//
你的域名
vDir=/
制作SiteMap的目录,相对目录(相对于根目录而言)
setobjfso=CreateObject(Scripting.FileSystemObject)
root=Server.MapPath(vDir)

response.write<?xmlversion=1.0encoding=UTF-8?>
response.write<urlsetxmlns=

str=<?xmlversion=1.0encoding=UTF-8?>&vbcrlf
str=str&<urlsetxmlns=

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


Functiongetfilelink(file,datafile)
file=replace(file,\,/)
file=replace(file,root,)
IfFileExtensionIsBad(file)thenExitFunction
ifmonth(datafile)<10thenfiledatem=0
ifday(datafile)<10thenfiledated=0
filedate=year(datafile)&-&filedatem&month(datafile)&-&filedated&day(datafile)
getfilelink=<url><loc>&server.htmlencode(session(server)&file)&</loc><lastmod>&filedate&</lastmod><changefreq>daily</changefreq><priority>1.0</priority></url>
Response.Flush
EndFunction


FunctionFolderpermission(pathName)
需要过滤的目录(不列在SiteMap里面)
PathExclusion=Array(\da@ta78#9,\member,\admin,\dxyeditor)
Folderpermission=True
foreachPathExcludedinPathExclusion
ifinstr(ucase(pathName),ucase(PathExcluded))>0then
Folderpermission=False
exitfor
endif
next
EndFunction


FunctionFileExtensionIsBad(sFileName)
DimsFileExtension,bFileExtensionIsValid,sFileExt
modifyforyourfileextension(
Extensions=Array(png,gif,jpg,jpeg,zip,pdf,ps,html,htm,php,wk1,wk2,wk3,wk4,wk5,wki,wks,wku,lwp,mw,xls,ppt,doc,swf,wks,wps,wdb,wri,rtf,ans,txt)
设置列表的文件名,扩展名不在其中的话SiteMap则不会收录该扩展名的文件

iflen(trim(sFileName))=0then
FileExtensionIsBad=true
ExitFunction
endif

sFileExtension=right(sFileName,len(sFileName)-instrrev(sFileName,.))
bFileExtensionIsValid=falseassumeextensionisbad
foreachsFileExtinextensions
ifucase(sFileExt)=ucase(sFileExtension)then
bFileExtensionIsValid=True
exitfor
endif
next
FileExtensionIsBad=notbFileExtensionIsValid
EndFunction
%>