• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    google sitemap.asp
    用于生成sitemap.xml文件的东西,利于google等搜索引擎的抓取。
    复制代码 代码如下:

    %
    Server.ScriptTimeout=50000
    ' sitemap_gen.asp
    ' A simple script to automatically produce sitemaps for a webserver, in the Google Sitemap Protocol (GSP)
    ' by Francesco Passantino
    ' www.iteam5.net/francesco/sitemap
    ' v0.2 released 5 june 2005 (Listing a directory tree recursively improvement)
    '
    ' BSD 2.0 license,
    ' http://www.opensource.org/licenses/bsd-license.php
    ' 收集整理:重庆森林@im286.com
    session("server")="https://www.jb51.net"
    '你的域名
    vDir = "/"
    '制作SiteMap的目录,相对目录(相对于根目录而言)
    set objfso = CreateObject("Scripting.FileSystemObject")
    root = Server.MapPath(vDir)

    'response.ContentType = "text/xml"
    'response.write "?xml version='1.0' encoding='UTF-8'?>"
    'response.write "urlset xmlns='http://www.google.com/schemas/sitemap/0.84'>"

    str = "?xml version='1.0' encoding='UTF-8'?>"  vbcrlf
    str = str  "urlset xmlns='http://www.google.com/schemas/sitemap/0.84'>"  vbcrlf

    Set objFolder = objFSO.GetFolder(root)
    'response.write getfilelink(objFolder.Path,objFolder.dateLastModified)
    Set colFiles = objFolder.Files
    For Each objFile In colFiles
    'response.write getfilelink(objFile.Path,objfile.dateLastModified)
    str = str  getfilelink(objFile.Path,objfile.dateLastModified)  vbcrlf
    Next
    ShowSubFolders(objFolder)

    'response.write "/urlset>"
    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('success!');history.back();/script>")
    Response.End
    End If

    Sub ShowSubFolders(objFolder)
    Set colFolders = objFolder.SubFolders
    For Each objSubFolder In colFolders
    if folderpermission(objSubFolder.Path) then
    'response.write getfilelink(objSubFolder.Path,objSubFolder.dateLastModified)
    str = str  getfilelink(objSubFolder.Path,objSubFolder.dateLastModified)  vbcrlf
    Set colFiles = objSubFolder.Files
    For Each objFile In colFiles
    'response.write getfilelink(objFile.Path,objFile.dateLastModified)
    str = str  getfilelink(objFile.Path,objFile.dateLastModified)  vbcrlf
    Next
    ShowSubFolders(objSubFolder)
    end if
    Next
    End Sub


    Function getfilelink(file,datafile)
    file=replace(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)"-"filedatemmonth(datafile)"-"filedatedday(datafile)
    getfilelink = "url>loc>"server.htmlencode(session("server")file)"/loc>lastmod>"filedate"/lastmod>changefreq>daily/changefreq>priority>1.0/priority>/url>"
    Response.Flush
    End Function


    Function Folderpermission(pathName)
    '需要过滤的目录(不列在SiteMap里面)
    PathExclusion=Array("\da@ta78#9","\member","\admin","\dxyeditor")
    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
    'modify for your file extension (http://www.googleguide.com/file_type.html)
    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")
    '设置列表的文件名,扩展名不在其中的话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
    %>
    您可能感兴趣的文章:
    • CodeIgniter使用phpcms模板引擎
    • CodeIgniter基本配置详细介绍
    • CodeIgniter上传图片成功的全部过程分享
    • PHP生成sitemap.xml地图函数
    • C#生成sitemap站点地图的方法
    • dedecms实现仿downkr的sitemap效果代码
    • 制做Google Sitemap文件的简单方法与图文教程
    • 用Google Sitemaps帮助你SEO
    • CodeIgniter生成网站sitemap地图的方法
    上一篇:atom_js.asp
    下一篇:用ASP读取/写入UTF-8编码格式的文件
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

    google sitemap.asp google,sitemap.asp,google,sitemap.asp,