1. 论坛系统升级为Xenforo,欢迎大家测试!
    排除公告

求救啊,我的sitemaps.ASP有问题

本帖由 heli82002007-12-15 发布。版面名称:网站运营

  1. heli8200

    heli8200 New Member

    注册:
    2006-09-10
    帖子:
    2
    赞:
    0
    以下是我的sitemaps.ASP文件代码
    代码:
    [<%
    Server.ScriptTimeout=50000
    dim seoDir
    session("server")="http://www.aanaa.com"     '?ַ
    seoDir="/"
    set objfso = CreateObject("Scripting.FileSystemObject")
    root = Server.MapPath(seoDir)
    'response.ContentType = "text/xml"
    'response.write ""
    'response.write ""
    str = "" & vbcrlf
    str = str & "" & vbcrlf
    Set objFolder = objFSO.GetFolder(root)
    'response.write getfilelink(objFolder.Path,objFolder.dateLastModified)
    Set colFiles = objFolder.Files
    For Each objFile In colFiles
    str=str & getfilelink(objFile.Path,objfile.dateLastModified) & vbcrlf
    Next
    ShowSubFolders(objFolder)
    
    str = str & "" & 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 '??ɵ?ML????
    .Close
    End With
    Set objStream = Nothing
    If Not Err Then
    Response.Write("alert('?ɹ???????ͼ!');history.back();")
    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,"")
    file=replace(file,"\","/")
    If FileExtensionIsBad(file) then Exit Function
    if month(datafile)<10 then filedatem="0"
    if day(datafile)0 then
    Folderpermission = False
    exit for
    end if
    next
    End Function
    
    Function FileExtensionIsBad(sFileName)
    Dim sFileExtension, bFileExtensionIsValid, sFileExt
    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","asp")
    '??????????չ???????Ļ?SiteMap??????????չ???ļ?
    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
    end if
    next
    FileExtensionIsBad = not bFileExtensionIsValid
    End Function
    %>
    /CODE]
    
    
    怎么生成的Sitemaps 是有问题的,,如下:
    <?xml version="1.0" encoding="UTF-8" ?> 
    - <urlset xmlns="http://www.google.com/schemas/sitemap/0.84">
    - <url>
      <loc>http://www.aanaa.com/E:/www/aanaa/wwwroot/Default.htm</loc> 
      <lastmod>2007-04-05</lastmod> 
      <changefreq>daily</changefreq> 
      <priority>1.0</priority> 
      </url>
    - <url>
      <loc>http://www.aanaa.com/E:/www/aanaa/wwwroot/rss.asp</loc> 
      <lastmod>2007-04-05</lastmod> 
      <changefreq>daily</changefreq> 
      <priority>1.0</priority> 
      </url>
    - <url>
      <loc>http://www.aanaa.com/E:/www/aanaa/wwwroot/bbs/AccessTopic.asp</loc> 
      <lastmod>2007-04-05</lastmod> 
      <changefreq>daily</changefreq> 
      <priority>1.0</priority> 
      </url>
    - <url>
      <loc>http://www.aanaa.com/E:/www/aanaa/wwwroot/bbs/admin_login.asp</loc> 
      <lastmod>2007-04-05</lastmod> 
      <changefreq>daily</changefreq> 
      <priority>1.0</priority> 
      </url>
    
    ==========================================================
    全部都多出了我的服务器物理路径E:/www/aanaa/wwwroot/
    
    
    求会的帮忙改一下 啊