📄 admin_createother.asp
字号:
Response.Write "<br> 生成页面（<a href='" & strInstallDir & OutFileName & CurrentPage & ".xml' target='_blank'>" & SiteUrl & 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>， [<a href='http://www.google.com/webmasters/sitemaps/ping?sitemap=" & SiteUrl & "sitemap_index.xml' target='_blank'>点击这里提交到Google</a>]"
End Sub
Sub OutBaiDuMap(OutType)
Dim rsArticle, sqlArticle, rsChannel, strHTML, totalPut, totalPage, CurrentPage, i, j
Dim iChannelDir, ChannelType, LinkUrl, preurl, UseCreateHTML, StructureType, FileNameType, FileExt_Item, CUploadDir, 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,A.Title,A.Author,A.CopyFrom,A.Keyword,A.Content,A.DefaultPicUrl 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,A.SoftName,A.Author,A.CopyFrom,A.Keyword,A.SoftIntro,A.SoftPicUrl 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,A.PhotoName,A.Author,A.CopyFrom,A.Keyword,A.PhotoIntro,A.PhotoThumb 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,A.ProductName,A.ProducerName,A.TrademarkName,A.Keyword,A.ProductIntro,A.ProductThumb 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,ChannelType,LinkUrl,UseCreateHTML,StructureType,FileNameType,FileExt_Item,UploadDir from PE_Channel where ChannelID=" & rsArticle(1))
If Not (rsChannel.bof And rsChannel.EOF) Then
iChannelDir = rsChannel("ChannelDir")
UseCreateHTML = rsChannel("UseCreateHTML")
StructureType = PE_Clng(rsChannel("StructureType"))
FileNameType = rsChannel("FileNameType")
FileExt_Item = rsChannel("FileExt_Item")
ChannelType = rsChannel("ChannelType")
LinkUrl = rsChannel("LinkUrl")
CUploadDir = rsChannel("UploadDir")
End If
rsChannel.Close
If LinkUrl <> "" Then
preurl = LinkUrl
Else
preurl = SiteUrl & iChannelDir
End If
End If
Select Case OutType
Case 1
AspName = "/ShowArticle.asp?ArticleID="
OutFileName = "baidumap_article_"
Case 2
AspName = "/ShowSoft.asp?SoftID="
OutFileName = "baidumap_Soft_"
Case 3
AspName = "/ShowPhoto.asp?PhotoID="
OutFileName = "baidumap_Photo_"
Case 5
AspName = "/ShowProduct.asp?ProductID="
OutFileName = "baidumap_Product_"
End Select
strHTML = strHTML & "<item>" & vbCrLf
strHTML = strHTML & "<title>" & fhtml(rsArticle(11)) & "</title>" & vbCrLf
If OutType < 4 Then
If UseCreateHTML > 0 And ClassPurview = 0 And (rsArticle(5) = 0 Or CMS_Edition < 1) Then
strHTML = strHTML & "<link>" & preurl & GetItemPath(StructureType, ParentDir, ClassDir, rsArticle(3)) & GetItemFileName(FileNameType, iChannelDir, rsArticle(3), rsArticle(0)) & GetFileExt(FileExt_Item) & "</link>" & vbCrLf
Else
strHTML = strHTML & "<link>" & preurl & AspName & rsArticle(0) & "</link>" & vbCrLf
End If
ElseIf OutType = 5 Then
If UseCreateHTML > 0 Then
strHTML = strHTML & "<link>" & preurl & GetItemPath(StructureType, ParentDir, ClassDir, rsArticle(3)) & GetItemFileName(FileNameType, iChannelDir, rsArticle(3), rsArticle(0)) & GetFileExt(FileExt_Item) & "</link>" & vbCrLf
Else
strHTML = strHTML & "<link>" & preurl & AspName & rsArticle(0) & "</link>" & vbCrLf
End If
End If
strHTML = strHTML & "<text>" & fhtml(rsArticle(15)) & "</text>" & vbCrLf
If rsArticle(16) <> "" Then
strHTML = strHTML & "<image>" & preurl & "/" & CUploadDir & "/" & rsArticle(16) & "</image>" & vbCrLf
Else
strHTML = strHTML & "<image/>" & vbCrLf
End If
strHTML = strHTML & "<keywords>" & fhtml(Replace(rsArticle(14), "|", " ")) & "</keywords>" & vbCrLf
strHTML = strHTML & "<author>" & fhtml(rsArticle(12)) & "</author>" & vbCrLf
strHTML = strHTML & "<source>" & fhtml(rsArticle(13)) & "</source>" & vbCrLf
strHTML = strHTML & "<pubDate>" & rsArticle(3) & "</pubDate>" & vbCrLf
strHTML = strHTML & "</item>" & 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=""GB2312""?>" & vbCrLf
strtmp = strtmp & "<document>" & vbCrLf
strtmp = strtmp & "<webSite>" & SiteUrl & "</webSite>" & vbCrLf
strtmp = strtmp & "<webMaster>" & WebmasterEmail & "</webMaster>" & vbCrLf
strtmp = strtmp & "<updatePeri>" & frequency & "</updatePeri>" & vbCrLf
strtmp = strtmp & strHTML
strtmp = strtmp & "</document>" & vbCrLf
hf.Write strtmp
hf.Close
Response.Write "<br> 生成页面（<a href='" & strInstallDir & OutFileName & CurrentPage & ".xml' target='_blank'>" & SiteUrl & 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=""GB2312""?>" & vbCrLf
strtmp = strtmp & "<document>" & vbCrLf
strtmp = strtmp & "<webSite>" & SiteUrl & "</webSite>" & vbCrLf
strtmp = strtmp & "<webMaster>" & WebmasterEmail & "</webMaster>" & vbCrLf
strtmp = strtmp & "<updatePeri>" & frequency & "</updatePeri>" & vbCrLf
strtmp = strtmp & strHTML
strtmp = strtmp & "</document>" & vbCrLf
hf.Write strtmp
hf.Close
Response.Write "<br> 生成页面（<a href='" & strInstallDir & OutFileName & CurrentPage & ".xml' target='_blank'>" & SiteUrl & 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
'**************************************************
'函数名：GetItemPath
'作 用：获得项目路径
'参 数：iStructureType ---- 目录结构方式
' sParentDir ---- 父栏目目录
' sClassDir ---- 当前栏目目录
' UpdateTime ---- 栏目目录
'返回值：获得项目路径
'**************************************************
Public 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" & Da⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -