📄 admin_createother.asp

📁 静宁成纪中学2006版欢迎使用！
💻 ASP
📖 第 1 页 / 共 4 页
字号:
上一页 1 2 34
    rsArticle.Close
    Set rsArticle = Nothing
End Sub

Sub OutXmlMap(OutType)
    Dim rsArticle, sqlArticle, rsChannel, strHTML, totalPut, totalPage, CurrentPage, i, j
    Dim iChannelDir, UseCreateHTML, StructureType, FileNameType, FileExt_Item, ClassDir, ParentDir, ClassPurview, AspName, OutFileName
    Dim oldChannelID: oldChannelID = 0
  
    Select Case OutType
    Case 1
        sqlArticle = "select top " & XmlOutNum & " A.ArticleID,A.ChannelID,A.ClassID,A.UpdateTime,A.Status,A.InfoPoint,A.Deleted,A.LinkUrl,C.ClassDir,C.ParentDir,C.ClassPurview from PE_Article A inner join PE_Class C on A.ClassID=C.ClassID Where A.Status=3 and A.Deleted=" & PE_False & " order by A.ArticleID Desc"
    Case 2
    sqlArticle = "select top " & XmlOutNum & " A.SoftID,A.ChannelID,A.ClassID,A.UpdateTime,A.Status,A.InfoPoint,A.Deleted,A.Hits,C.ClassDir,C.ParentDir,C.ClassPurview from PE_Soft A inner join PE_Class C on A.ClassID=C.ClassID Where A.Status=3 and A.Deleted=" & PE_False & " order by A.SoftID Desc"
    Case 3
    sqlArticle = "select top " & XmlOutNum & " A.PhotoID,A.ChannelID,A.ClassID,A.UpdateTime,A.Status,A.InfoPoint,A.Deleted,A.Hits,C.ClassDir,C.ParentDir,C.ClassPurview from PE_Photo A inner join PE_Class C on A.ClassID=C.ClassID Where A.Status=3 and A.Deleted=" & PE_False & " order by A.PhotoID Desc"
    Case 5
    sqlArticle = "select top " & XmlOutNum & " A.ProductID,A.ChannelID,A.ClassID,A.UpdateTime,A.EnableSale,A.Stocks,A.Deleted,A.Hits,C.ClassDir,C.ParentDir,C.ClassPurview from PE_Product A inner join PE_Class C on A.ClassID=C.ClassID Where A.Deleted=" & PE_False & " and A.EnableSale=" & PE_True & " order by A.ProductID Desc"
    End Select
    Set rsArticle = Server.CreateObject("adodb.recordset")
    rsArticle.Open sqlArticle, Conn, 1, 1
    If rsArticle.bof And rsArticle.EOF Then
        Response.Write "尚无内容!暂不生成页面!<br>"
    Else
        totalPut = rsArticle.recordcount
        If (totalPut Mod XmlMaxPerPage) = 0 Then
            totalPage = totalPut \ XmlMaxPerPage
        Else
            totalPage = totalPut \ XmlMaxPerPage + 1
        End If
        i = 1
        CurrentPage = 1

        Do While Not rsArticle.EOF

            ClassDir = rsArticle(8)
            ParentDir = rsArticle(9)
            ClassPurview = rsArticle(10)

            If rsArticle(1) <> oldChannelID Then
                Set rsChannel = Conn.Execute("select Top 1 ChannelID,ChannelDir,UseCreateHTML,StructureType,FileNameType,FileExt_Item from PE_Channel where ChannelID=" & rsArticle(1))
                If Not (rsChannel.bof And rsChannel.EOF) Then
                    iChannelDir = rsChannel("ChannelDir")
                    UseCreateHTML = rsChannel("UseCreateHTML")
                    StructureType = rsChannel("StructureType")
                    If CMS_Edition < 1 Then StructureType = 0
                    FileNameType = rsChannel("FileNameType")
                    FileExt_Item = rsChannel("FileExt_Item")
                End If
                rsChannel.Close
            End If
            Select Case OutType
            Case 1
                AspName = "/ShowArticle.asp?ArticleID="
                OutFileName = "sitemap_article_"
            Case 2
                AspName = "/ShowSoft.asp?SoftID="
                OutFileName = "sitemap_Soft_"
            Case 3
                AspName = "/ShowPhoto.asp?PhotoID="
                OutFileName = "sitemap_Photo_"
            Case 5
                AspName = "/ShowProduct.asp?ProductID="
                OutFileName = "sitemap_Product_"
            End Select
            strHTML = strHTML & "<url>" & vbCrLf
            If OutType < 4 Then
                If UseCreateHTML > 0 And ClassPurview = 0 And (rsArticle(5) = 0 Or CMS_Edition < 1) Then
                    strHTML = strHTML & "<loc>" & SiteUrl & iChannelDir & GetItemPath(StructureType, ParentDir, ClassDir, rsArticle(3)) & GetItemFileName(FileNameType, iChannelDir, rsArticle(3), rsArticle(0)) & GetFileExt(FileExt_Item) & "</loc>" & vbCrLf
                Else
                    strHTML = strHTML & "<loc>" & SiteUrl & iChannelDir & AspName & rsArticle(0) & "</loc>" & vbCrLf
                End If
            ElseIf OutType = 5 Then
                If UseCreateHTML > 0 Then
                    strHTML = strHTML & "<loc>" & SiteUrl & iChannelDir & GetItemPath(StructureType, ParentDir, ClassDir, rsArticle(3)) & GetItemFileName(FileNameType, iChannelDir, rsArticle(3), rsArticle(0)) & GetFileExt(FileExt_Item) & "</loc>" & vbCrLf
                Else
                    strHTML = strHTML & "<loc>" & SiteUrl & iChannelDir & AspName & rsArticle(0) & "</loc>" & vbCrLf
                End If
            End If
            strHTML = strHTML & "<lastmod>" & iso8601date(rsArticle(3), UOffset) & "</lastmod>" & vbCrLf
            strHTML = strHTML & "<changefreq>" & frequency & "</changefreq>" & vbCrLf
            strHTML = strHTML & "<priority>" & Priority & "</priority>" & vbCrLf
            strHTML = strHTML & "</url>" & vbCrLf
            i = i + 1

            If i > XmlMaxPerPage Then
                Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & OutFileName & CurrentPage & ".xml"), 2, True)
                strtmp = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
                strtmp = strtmp & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbCrLf
                strtmp = strtmp & strHTML
                strtmp = strtmp & "</urlset>" & vbCrLf
                hf.Write strtmp
                hf.Close
                Response.Write "<br> 生成页面（<a href='" & strInstallDir & OutFileName & CurrentPage & ".xml' target='_blank'>" & strInstallDir & OutFileName & CurrentPage & ".xml</a>）<font color=red>成功!</font>"
                CurrentPage = CurrentPage + 1
                i = 1
                strHTML = ""
            End If
            oldChannelID = rsArticle(1)
            rsArticle.movenext
        Loop
        Set rsChannel = Nothing

        Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & OutFileName & CurrentPage & ".xml"), 2, True)
        strtmp = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
        strtmp = strtmp & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbCrLf
        strtmp = strtmp & strHTML
        strtmp = strtmp & "</urlset>" & vbCrLf
        hf.Write strtmp
        hf.Close
        Response.Write "<br> 生成页面（<a href='" & strInstallDir & OutFileName & CurrentPage & ".xml' target='_blank'>" & strInstallDir & OutFileName & CurrentPage & ".xml</a>)<font color=red>成功!</font>"
        strHTML = strHTML & "<br>" & vbCrLf
    End If
    Select Case OutType
    Case 1
        ArtPage = totalPage
    Case 2
        SoftPage = totalPage
    Case 3
        PhotoPage = totalPage
    Case 5
        ProductPage = totalPage
    End Select
    rsArticle.Close
    Set rsArticle = Nothing
End Sub

Sub OutXmlIndexMap()
    Dim strtmp, j
    Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & "sitemap_index.xml"), 2, True)
    strtmp = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
    strtmp = strtmp & "<sitemapindex xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbCrLf
    If ArtPage > 0 Then
        For j = 1 To ArtPage
            strtmp = strtmp & "<sitemap>" & vbCrLf
            strtmp = strtmp & "<loc>" & SiteUrl & "sitemap_article_" & j & ".xml</loc>" & vbCrLf
            strtmp = strtmp & "<lastmod>" & iso8601date(Now(), UOffset) & "</lastmod>" & vbCrLf
            strtmp = strtmp & "</sitemap>" & vbCrLf
        Next
    End If
    If SoftPage > 0 Then
        For j = 1 To SoftPage
            strtmp = strtmp & "<sitemap>" & vbCrLf
            strtmp = strtmp & "<loc>" & SiteUrl & "sitemap_Soft_" & j & ".xml</loc>" & vbCrLf
            strtmp = strtmp & "<lastmod>" & iso8601date(Now(), UOffset) & "</lastmod>" & vbCrLf
            strtmp = strtmp & "</sitemap>" & vbCrLf
        Next
    End If
    If PhotoPage > 0 Then
        For j = 1 To PhotoPage
            strtmp = strtmp & "<sitemap>" & vbCrLf
            strtmp = strtmp & "<loc>" & SiteUrl & "sitemap_Photo_" & j & ".xml</loc>" & vbCrLf
            strtmp = strtmp & "<lastmod>" & iso8601date(Now(), UOffset) & "</lastmod>" & vbCrLf
            strtmp = strtmp & "</sitemap>" & vbCrLf
        Next
    End If
    If ProductPage > 0 And CMS_Edition > 0 Then
        For j = 1 To ProductPage
            strtmp = strtmp & "<sitemap>" & vbCrLf
            strtmp = strtmp & "<loc>" & SiteUrl & "sitemap_Product_" & j & ".xml</loc>" & vbCrLf
            strtmp = strtmp & "<lastmod>" & iso8601date(Now(), UOffset) & "</lastmod>" & vbCrLf
            strtmp = strtmp & "</sitemap>" & vbCrLf
        Next
    End If
    strtmp = strtmp & "</sitemapindex>" & vbCrLf
    hf.Write strtmp
    hf.Close
    Response.Write "<br> 生成页面（<a href='" & strInstallDir & "sitemap_index.xml' target='_blank'>" & strInstallDir & "sitemap_index.xml</a>）<font color=red>成功!</font>，&nbsp;[<a href='http://www.google.com/webmasters/sitemaps/ping?sitemap=" & SiteUrl & "sitemap_index.xml' target='_blank'>点击这里提交到Google</a>]"
End Sub

Function GetItemPath(iStructureType, sParentDir, sClassDir, UpdateTime)
    Select Case iStructureType
    Case 0      '频道/大类/小类/月份/文件（栏目分级，再按月份保存）
        GetItemPath = "/" & sParentDir & sClassDir & "/" & Year(UpdateTime) & Right("0" & Month(UpdateTime), 2) & "/"
    Case 1      '频道/大类/小类/日期/文件（栏目分级，再按日期分，每天一个目录）
        GetItemPath = "/" & sParentDir & sClassDir & "/" & Year(UpdateTime) & "-" & Right("0" & Month(UpdateTime), 2) & "-" & Right("0" & Day(UpdateTime), 2) & "/"
    Case 2      '频道/大类/小类/文件（栏目分级，不再按月份）
        GetItemPath = "/" & sParentDir & sClassDir & "/"
    Case 3      '频道/栏目/月份/文件（栏目平级，再按月份保存）
        GetItemPath = "/" & sClassDir & "/" & Year(UpdateTime) & Right("0" & Month(UpdateTime), 2) & "/"
    Case 4      '频道/栏目/日期/文件（栏目平级，再按日期分，每天一个目录）
        GetItemPath = "/" & sClassDir & "/" & Year(UpdateTime) & "-" & Right("0" & Month(UpdateTime), 2) & "-" & Right("0" & Day(UpdateTime), 2) & "/"
    Case 5      '频道/栏目/文件（栏目平级，不再按月份）
        GetItemPath = "/" & sClassDir & "/"
    Case 6      '频道/文件（直接放在频道目录中）
        GetItemPath = "/"
    Case 7      '频道/HTML/文件（直接放在指定的“HTML”文件夹中）
        GetItemPath = "/HTML/"
    Case 8      '频道/年份/文件（直接按年份保存，每年一个目录）
        GetItemPath = "/" & Year(UpdateTime) & "/"
    Case 9      '频道/月份/文件（直接按月份保存，每月一个目录）
        GetItemPath = "/" & Year(UpdateTime) & Right("0" & Month(UpdateTime), 2) & "/"
    Case 10     '频道/日期/文件（直接按日期保存，每天一个目录）
        GetItemPath = "/" & Year(UpdateTime) & "-" & Right("0" & Month(UpdateTime), 2) & "-" & Right("0" & Day(UpdateTime), 2) & "/"
    Case 11     '频道/年份/月份/文件（先按年份，再按月份保存，每月一个目录）
        GetItemPath = "/" & Year(UpdateTime) & "/" & Year(UpdateTime) & Right("0" & Month(UpdateTime), 2) & "/"
    Case 12     '频道/年份/日期/文件（先按年份，再按日期分，每天一个目录）
        GetItemPath = "/" & Year(UpdateTime) & "/" & Year(UpdateTime) & "-" & Right("0" & Month(UpdateTime), 2) & "-" & Right("0" & Day(UpdateTime), 2) & "/"
    Case 13     '频道/月份/日期/文件（先按月份，再按日期分，每天一个目录）
        GetItemPath = "/" & Year(UpdateTime) & Right("0" & Month(UpdateTime), 2) & "/" & Year(UpdateTime) & "-" & Right("0" & Month(UpdateTime), 2) & "-" & Right("0" & Day(UpdateTime), 2) & "/"
    Case 14     '频道/年份/月份/日期/文件（先按年份，再按日期分，每天一个目录）
        GetItemPath = "/" & Year(UpdateTime) & "/" & Year(UpdateTime) & Right("0" & Month(UpdateTime), 2) & "/" & Year(UpdateTime) & "-" & Right("0" & Month(UpdateTime), 2) & "-" & Right("0" & Day(UpdateTime), 2) & "/"
    End Select
    GetItemPath = Replace(GetItemPath, "//", "/")
End Function

Function GetItemFileName(iFileNameType, sChannelDir, UpdateTime, iArticleID)
    Select Case iFileNameType
    Case 0
        GetItemFileName = iArticleID
    Case 1
        GetItemFileName = Year(UpdateTime) & Right("0" & Month(UpdateTime), 2) & Right("0" & Day(UpdateTime), 2) & Right("0" & Hour(UpdateTime), 2) & Right("0" & Minute(UpdateTime), 2) & Right("0" & Second(UpdateTime), 2)
    Case 2
        GetItemFileName = sChannelDir & "_" & iArticleID
    Case 3
        GetItemFileName = sChannelDir & "_" & Year(UpdateTime) & Right("0" & Month(UpdateTime), 2) & Right("0" & Day(UpdateTime), 2) & Right("0" & Hour(UpdateTime), 2) & Right("0" & Minute(UpdateTime), 2) & Right("0" & Second(UpdateTime), 2)
    End Select
End Function

Function GetFileExt(FileExtType)
    Select Case FileExtType
    Case 0
        GetFileExt = ".html"
    Case 1
        GetFileExt = ".htm"
    Case 2
        GetFileExt = ".shtml"
    Case 3
        GetFileExt = ".shtm"
    Case 4
        GetFileExt = ".asp"
    End Select
End Function

Function iso8601date(dLocal, utcOffset)
    Dim d, d1
    d = DateAdd("H", -1 * utcOffset, dLocal)
    If Len(utcOffset) < 2 Then
        d1 = "0" & utcOffset
    Else
        d1 = utcOffset
    End If
    iso8601date = Year(d) & "-" & Right("0" & Month(d), 2) & "-" & Right("0" & Day(d), 2) & "T"
    iso8601date = iso8601date & (Right("0" & Hour(d), 2) & ":" & Right("0" & Minute(d), 2) & ":" & Right("0" & Second(d), 2))
    If utcOffset < 0 Then
        iso8601date = iso8601date & ("-" & d1 & ":00")
    Else
        iso8601date = iso8601date & ("+" & d1 & ":00")
    End If
End Function
%>
上一页 1 2 34
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -