SITEMAP生成程序的ASP实现

这是一个完整的ASP生成SITEMAP程序,只要将该程序放在站点目录任何一个位置调动一下即可在站点根目录生成sitemap.xml文件。程序生成的SITEMAP.XML会自动根据目录的深度递减priority（优先级）值

<%
flag=Trim(Request("flag"))
If flag="BUILD" Then
 response.write "SITEMAP生成程序,作者:晶友软件,网站:www.cfsoft.com.cn" & "<br>"
 Server.ScriptTimeout=500000
 'on error resume next

 session("server")= "http://"&Trim(Request.ServerVariables("SERVER_NAME"))'
 vDir = "/" '制作SiteMap的目录,相对目录(相对于根目录而言)
 set objfso = CreateObject("Scripting.FileSystemObject")
 root = Server.MapPath(vDir)

 str = "<?xml version=""1.0"" encoding=""UTF-8""?>"
 str = str & "<urlset xmlns=""http://www.sitemaps.org/schemas/sitemap/0.9"">" & vbcrlf

 Set objFolder = objFSO.GetFolder(root)

 Set colFiles = objFolder.Files

 For Each objFile In colFiles
  str = str & getfilelink(objFile.Path,objfile.dateLastModified,1.0)
 Next
 Call ShowSubFolders(objFolder,0.9)
 str = str & "</urlset>" & vbcrlf
 set fso = nothing

 Set objStream = Server.CreateObject("ADODB.Stream")
 With objStream
  '.Type = adTypeText
  '.Mode = adModeReadWrite
  .Open
  .Charset = "utf-8"
  .Position = objStream.Size
  .WriteText=str
  .SaveToFile server.mappath("/sitemap.xml"),2 '生成的XML文件名
  .Close
 End With

 Set objStream = Nothing

 If Not Err Then
  Response.Write("<script>alert('...............成功生成站点地图..................');</script>")
  Response.End
 End If

 Sub ShowSubFolders(objFolder,priority)
  Dim temppriority
  Set colFolders = objFolder.SubFolders
  For Each objSubFolder In colFolders
   if folderpermission(objSubFolder.Path) then
    str = str & getfilelink(objSubFolder.Path,objSubFolder.dateLastModified,priority)
    Set colFiles = objSubFolder.Files
    For Each objFile In colFiles
     str = str & getfilelink(objFile.Path,objFile.dateLastModified,priority)
    Next
    If priority>0.5 Then
     temppriority=priority-0.1
    Else
     temppriority=0.5
    End if
    Call ShowSubFolders(objSubFolder,temppriority)

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有