SITEMAP生成程序的ASP实现

欢迎您访问我爱IT技术网，今天小编为你分享的编程技术是：【SITEMAP生成程序的ASP实现】，下面是详细的分享！

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)
   end if
  Next
 End Sub

 Function getfilelink(file,datafile,priority)
  Dim temppriority
  If priority=1.0 Then
   temppriority=priority&".0"
  End If
  If Left(CStr(priority),1)="." Then
   temppriority="0"&priority
  End if
  root=replace(root,"\","/")
  root=LCase(root)
  file=replace(file,"\","/")
  file=LCase(file)

  file=replace(file,root,"")

  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="  <url>"&vbcrlf
   getfilelink=getfilelink&"    <loc>"&server.htmlencode(session("server")&file)&"</loc>"&vbcrlf
   getfilelink=getfilelink&"    <lastmod>"&filedate&"</lastmod>"&vbcrlf
   getfilelink=getfilelink&"    <changefreq>daily</changefreq>"&vbcrlf
   getfilelink=getfilelink&"    <priority>"&temppriority&"</priority>"&vbcrlf
   getfilelink=getfilelink&"  </url>"&vbcrlf
   response.write "成功生成地址："& server.htmlencode(session("server")&file) & "<br>"

   Response.Flush
 End Function

 Function Folderpermission(pathName)

  '需要过滤的目录(不列在SiteMap里面)
  PathExclusion=Array("\admin","\_vti_cnf","_vti_pvt","_vti_log","cgi-bin","\bizadmin","\bookpic","\css","\data","\eWebEditor","\footprint","\images","\images_remote","\Inc","\js","\myimg","\netfootimg","\netheadimg","\netimg","\picture","\css","\conn""\Skin","\skin_Mesky","\uploadfile","\uploadfiles","\uploadpic")
  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 Extension, bFileExtensionIsValid, sFileExt
  Extensions=Array("html","htm")
  '设置列表的文件名,扩展名不在其中的话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
End if
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link href=http://www.chinaz.com/program/2008/0917/"images/css.css" rel="stylesheet" type="text/css">
<title>SITEMAP生成-晶友软件http://www.cfsoft.com.cn</title>
</head>

<body>

<br>
<br>
<br>
<br>
<br>
<form action="sitemap.asp?flag=BUILD" method="post" name="fm1" id="fm1">
  <table width="99%" border="0" align="center" class="tableBorder">
    <tr bgcolor="#E8F1FF">
      <td colspan="6" align="center"  class="td">
          <input type="submit" name="Submit" value="生成">
        </td>
    </tr>
 
  </table>
  <br>

</form>

</body>
</html>

以上所分享的是关于SITEMAP生成程序的ASP实现，下面是编辑为你推荐的有价值的用户互动：

　　相关问题：怎么知道一个网站是用什么程序做的呢

　　答：看他的程序语言就这样看 www.baidu.com/xx.asp?xx=xx [ASP脚本] www.baidu.com/?xx.html?=xx [ASP脚本] www.baidu.com/xx.php?xx=xx [PHP脚本] www.baidu.com/xx/xx [PHP脚本比较高的几率]判断CMS责得对CMS要了解些，一般的判断方法就是看默认布... >>详细

　　相关问题：比较ASP生成静态HTML文件的几种方法

　　答：将动态页面转换生成静态Html文件有许多好处，比如生成html网页有利于被搜索引擎收录（特别是对接受动态参数的页面）。前台访问时，脱离了数据访问，减轻对数据库访问的压力，加快网页打开速度。 当然，凡事有利必有弊，生成HTML页面无形中也耗费... >>详细

　　相关问题：asp.net如何通过数据库生成Sitemap.xml

　　答：sitemap.xml 一般都是通过软件生成的。。。。 >>详细