用ASP生成的网站地图聚到问题,请教高人解决。
我用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.
这样的结果,请高人指教,应该如何设置。
谢谢了。