迷城网络 - 专注于中小企业Linux运维服务

当前位置: 迷城网络 > 建站程序 >

新云管理系统3.0版 Google地图生成器提供了,测试

时间:2019-02-25 11:56来源: 作者: 点击:
新云管理系统3.0版 Google地图生成器提供了,测试了,好用
新云管理系统Google地图生成器for v3.0 版

它的好处不用我多说,但有一点需要声明,程序是官方商业版里东西,3.0版之前只对生成了HTML页面的网站有效,并且只能生成文章和下载频道

2.1版演示地址:http://code.feyu.cn/sitemap.xml

3.0版演示地址:http://www.feyu.cn/sitemap.xml

最新修正ASP动态生成地图

演示地址:http://vip.feyu.cn/sitemap.xml


只要解压上传至网站根目录,运行一下就行了,然后去GG网站管理后台(https://www.google.com/accounts/ServiceLogin?service=sitemaps&hl=zh_CN&continue=https%3A%2F%2Fwww.google.com%2Fwebmasters%2Ftools%2Fsiteoverview&nui=1)提交http://你的网址/sitemap.xml就行了

最好是在后台里搞个该程序的连接,等你每次更新后就在后台一起生成就行了
代码如下:
<!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<%
Server.ScriptTimeout = 50000

Dim Rs,SQL,XMLContent,Thisurl
Dim CreateHtml,ChannelRootDir,ChannelID
Dim XMLDOM,node,Cnode,Cnode1,msginfo

Thisurl="http://" & Request.ServerVariables("HTTP_HOST")

'Response.Clear
'Response.CharSet="UTF-8"
'Response.ContentType="text/xml"


Call IndexSiteMap("/")
'Call ChannelSiteMap("./")


'Response.Write XMLContent
'Response.Write Newasp.FormatDate(now,2)

Sub IndexSiteMap(strPath)
    XMLContent = "<?xml version='1.0' encoding='UTF-8'?>" & vbNewLine
    XMLContent = XMLContent & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbNewLine
    XMLContent = XMLContent & "<url>" & vbNewLine
    XMLContent = XMLContent & "<loc>" & Thisurl & "/</loc>" & vbNewLine & "<lastmod>" & Newasp.FormatDate(Now(),2) & "</lastmod>" & vbNewLine & "<changefreq>daily</changefreq>" & vbNewLine & "<priority>1.0</priority>" & vbNewLine
    XMLContent = XMLContent & "</url>" & vbNewLine
    LoadSitemap 2,0
    LoadSitemap 1,0
    XMLContent = XMLContent & "</urlset>"
    strPath = Server.MapPath(strPath) & "\sitemap.xml"
    CreateXMLFile XMLContent,strPath
    Response.Write "生成站点地图成功!"
End Sub 

Sub ChannelSiteMap(strPath)
    XMLContent = "<?xml version='1.0' encoding='UTF-8'?>" & vbNewLine
    XMLContent = XMLContent & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbNewLine
    XMLContent = XMLContent & "<url>" & vbNewLine
    XMLContent = XMLContent & "<loc>" & Thisurl & "/code/</loc>" & vbNewLine & "<lastmod>" & Now() & "</lastmod>" & vbNewLine & "<changefreq>daily</changefreq>" & vbNewLine & "<priority>1.0</priority>" & vbNewLine
    XMLContent = XMLContent & "</url>" & vbNewLine
    LoadSitemap 2,11
    XMLContent = XMLContent & "</urlset>"
    strPath = Server.MapPath(strPath) & "\sitemap.xml"
    CreateXMLFile XMLContent,strPath
    Response.Write "生成站点地图成功!"
End Sub 

Function LoadSitemap(ByVal sid, ByVal chanid)
    chanid = Newasp.ChkNumeric(chanid)
    Dim FindOrder,TableName
    If sid = 1 Then
        TableName = "[NC_Article]"
        FindOrder = "ORDER BY A.WriteTime DESC,A.ArticleID DESC"
        SQL = " A.ArticleID,A.ClassID,A.ChannelID,A.WriteTime,A.HtmlFileDate,"
    Else
        TableName = "[NC_SoftList]"
        FindOrder = "ORDER BY A.SoftTime DESC ,A.SoftID DESC"
        SQL = " A.SoftID,A.ClassID,A.ChannelID,A.SoftTime,A.HtmlFileDate,"
    End If
    If chanid = 0 Then
        SQL = "SELECT TOP 3000 " & SQL & " C.HtmlFileDir,B.ChannelDir,B.IsCreateHtml,B.HtmlExtName FROM (" & TableName & " A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID) INNER JOIN [NC_Channel] B On A.ChannelID=B.ChannelID WHERE A.isAccept>0 " & FindOrder
    Else
        SQL = "SELECT " & SQL & " C.HtmlFileDir,B.ChannelDir,B.IsCreateHtml,B.HtmlExtName FROM (" & TableName & " A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID) INNER JOIN [NC_Channel] B On A.ChannelID=B.ChannelID WHERE A.ChannelID=" & chanid & " And A.isAccept>0 " & FindOrder
    End If
    Set Rs = Newasp.Execute(SQL)
    If Rs.BOF And Rs.EOF Then
    Else
        CreateHtml = 1'Rs("IsCreateHtml")
        Do While Not Rs.EOF
            Call LoadSoftList()
            Rs.MoveNext
        Loop
    End If
    Rs.Close: Set Rs = Nothing
End Function

Sub LoadSoftList()
    Dim HtmlFileName,LinksUrl,strLinksUrl
    ChannelID = Rs(2)
    Newasp.LoadChannel(ChannelID)
    ChannelRootDir = Newasp.ChannelPath
    CreateHtml = Newasp.ChannelUseHtml
    If CInt(CreateHtml) <> 0 Then
        LinksUrl = Newasp.ReadDestination(Newasp.m_InfoDestination, Newasp.m_ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs(0),1,"")
    Else
        If IsURLRewrite Then
            LinksUrl = ChannelRootDir & Rs(0) & Newasp.ChannelHtmlExt
        Else
            LinksUrl = ChannelRootDir & "show.asp?id=" & Rs(0)
        End If
    End If
    strLinksUrl = "<url>" & vbNewLine
    strLinksUrl = strLinksUrl & "<loc>" & Thisurl & LinksUrl & "</loc>" & vbNewLine & "<lastmod>" & Newasp.FormatDate(Rs(3),2) & "</lastmod>" & vbNewLine & "<changefreq>daily</changefreq>" & vbNewLine & "<priority>1.0</priority>" & vbNewLine
    strLinksUrl = strLinksUrl & "</url>" & vbNewLine
    XMLContent = XMLContent & strLinksUrl
End Sub
'================================================
'函数名:CreateXMLFile
'作  用:创建XML文件
'参  数:XmlStr   ----XML字符串
'        FormPath    ----创建的文件路径
'================================================
Function CreateXMLFile(sXML,FilePath)
    Dim objXML
    If InStr(FilePath, ":") = 0 Then FilePath = Server.MapPath(FilePath)
    Set objXML = Server.CreateObject("MSXML2.DOMDocument.3.0") 
    If objXML.LoadXml(sXML) Then
        objXML.Save(FilePath)
    End If
    Set objXML = Nothing
End Function 
%>

(责任编辑:迷城网络科技)
织梦二维码生成器
顶一下
(0)
0%
踩一下
(0)
0%
------分隔线----------------------------
发表评论
请自觉遵守互联网相关的政策法规,严禁发布色情、暴力、反动的言论。
评价:
表情:
用户名: 验证码:点击我更换图片
栏目列表
推荐内容