注册 登录
编程论坛 ASP技术论坛

用ASP生成的网站地图聚到问题,请教高人解决。

cnneal 发布于 2010-09-17 18:12, 642 次点击
我用ASP代码来生成网站代码,asp代码如下:
<%@ CODEPAGE=65001 %>
<% Response.CharSet="UTF-8" %>
<% Response.Buffer=True %>
<%
' For www. sitemaps xml

Server.ScriptTimeout = 50000
session(“server”) = “www.” ’域名
vDir = “/”‘制作SiteMap的目录,相对根目录 全站为”/”

Set objfso = CreateObject(“Scripting.FileSystemObject”)
root = Server.MapPath(vDir)’”D:\askmyself“‘Server.MapPath(vDir)
str = ”<?xml version=”"1.0″” encoding=”"UTF-8″”?>” & vbcrlf
str = str & ”<urlset xmlns=”"http://www.″”>” & vbcrlf
str = str & ”<!–Google Site Map File Generated by http://www. ”& now() &”–>” & vbcrlf

Set objFolder = objFSO.GetFolder(root)
Set colFiles = objFolder.Files
For Each objFile In colFiles
  str = str & getfilelink(objFile.Path,objfile.dateLastmodified) & vbcrlf
Next
ShowSubFolders(objFolder)

str = str & ”</urlset>” & vbcrlf
Set fso = Nothing

Set objStream = Server.CreateObject(“ADODB.Stream”)
With objStream
  .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(‘成功生成站点地图!’);history.back();</script>”)
  Response.End
End If

Sub ShowSubFolders(objFolder)
  Set colFolders = objFolder.SubFolders
  For Each objSubFolder In colFolders
    If Folderpermission(objSubFolder.Path) Then
      str = str & getfilelink(objSubFolder.Path,objSubFolder.dateLastmodified) & vbcrlf
      Set colFiles = objSubFolder.Files
      For Each objFile In colFiles
        str = str & getfilelink(objFile.Path,objFile.dateLastmodified) & vbcrlf
      Next
      ShowSubFolders(objSubFolder)
    End If
  Next
End Sub

Function getfilelink(File,datafile)
  File = Replace(File,root,”",1,-1,1)
  File = Replace(File,”\”,”/”)
  If FileExtensionIsBad(File) Then Exit Function
  nfile = Session(“server”) & vDir & File
  nfile = ”http://” & Replace(nfile,”//”,”/”) ’替换根目录链接的双斜杠
  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(nfile) & ”</loc>” & vbcrlf
  getfilelink = getfilelink & ” <lastmod>” & filedate & ”</lastmod>” & vbcrlf
  getfilelink = getfilelink & ” <changefreq>daily</changefreq> ” & vbcrlf
  getfilelink = getfilelink & ” <priority>1.0</priority>” & vbcrlf
  getfilelink = getfilelink & ”</url>” & vbcrlf ’& root
  Response.Flush
End Function

Function Folderpermission(pathName) ’需要过滤的目录(不列在SiteMap里面)
  PathExclusion = Array(“\ADMIN”,”\CACHE”,”\cert”,”\CSS”,”\DATA”,”\FUNCTION”,”\IMAGE”,”\INCLUDE”,”\LANGUAGE”,”\PLUGIN”,”\SCRIPT”,”\THEMES”,”\UPLOAD”,”\XML-RPC”)
  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, sPass
  Extensions = Array(“html”,”htm”) ’设置列表的文件名,扩展名不在其中的话SiteMap则不会收录该扩展名的文件
  PassFileNames = Array(“default.asp”,”guestbook.asp”,”tags.asp”,”search.asp”,”catalog.asp”) ’设置例外,其他扩展名的少数文件
  If Len(Trim(sFileName)) = 0 Then
    FileExtensionIsBad = True
    Exit Function
  End If

  sFileExtension = Right(sFileName, Len(sFileName) - Instrrev(sFileName, ”.”))
  bFileExtensionIsValid = False
  For Each sFileExt In Extensions
    If UCase(sFileExt) = UCase(sFileExtension) Then
        bFileExtensionIsValid = true
        Exit For
    Else
      For Each sPass In PassFileNames
        If Instr(UCase(sFileName),UCase(sPass)) > 0 Then
          bFileExtensionIsValid = True
          Exit For
        Else
          bFileExtensionIsValid = False
        End If
      Next
    End If
  Next
  FileExtensionIsBad = Not bFileExtensionIsValid
End Function
%>
-----------------------------------------------------
vDir = “/”‘制作SiteMap的目录,相对根目录 全站为”/”
我直接用了这个斜杠后,制作的地图是非法的:
http://www.
这样的结果,请高人指教,应该如何设置。
谢谢了。
3 回复
#2
cnneal2010-09-17 19:01
哪位高手帮帮吗啊。谢谢了。
#3
gupiao1752010-09-18 17:11
能否详细描述下,你的要求功能感觉好象非常复杂!
#4
hebss2010-09-22 21:25
你看下这个: https://bbs.bccn.net/thread-321128-1-1.html 下载附件就可以用,直接生成,但稍微有点缺陷
1