<%@language=vbscript codepage=936 %> <% Option Explicit Response.Buffer = False Const PurviewLevel = 1 Const PurviewLevel_Channel = 0 Const PurviewLevel_Others = "" Server.ScriptTimeOut = 99999999 %> <% Dim strtmp, hf, fso, ObjInstalled_FSO, MaxPerPage, MaxPageCol, OutNum, XmlMaxPerPage, XmlOutNum, frequency, Priority, ArtPage, SoftPage, PhotoPage, ProductPage Dim EnableRss, UOffset, Action2 Action2 = Trim(Request("Action2")) Dim rsConfig Set rsConfig = Conn.Execute("select EnableRss from PE_Config") If rsConfig.bof And rsConfig.EOF Then rsConfig.Close Set rsConfig = Nothing Response.Write "网站配置数据丢失！系统无法正常运行！" Response.End Else EnableRss = rsConfig("EnableRss") End If rsConfig.Close Set rsConfig = Nothing If Right(SiteUrl, 1) <> "/" Then SiteUrl = SiteUrl & "/" %>

生成网站综合数据
生成说明：	生成操作比较消耗系统资源及费时，每次生成时，请尽量减少要生成的文件量。

<% If Action2 = "" Then %>

RSS生成操作

生成网站首页的ＲＳＳ页面，当您禁用ＲＳＳ或网站首页为动态ＡＳＰ格式时，本功能无效。

XML生成操作

生成ＸＭＬ数据交换页，地址为<% =SiteUrl %>xml/xml.xml 生成频道数据 生成留言数据 生成作者数据 生成会员数据 生成友情站点 生成公告列表

HTML地图生成操作

生成HTML格式的全站地图页面。 总输出数量 ＨＴＭＬ地图总输出数量 每页连接数 每页输出数量，不能大于１００ 分页换行数 地图分页连接每行显示数

XML地图生成操作

生成符合GOOGLE规范的XML格式地图页面 总输出数量 ＸＭＬ地图总输出数量 每页连接数 每页连接数,GOOGLE规范要求不得大于５０００   时区偏移 默认中国大陆为８   更新频率 随时更新 每 小 时 每天更新 每周更新 每月更新 每年更新 从不更新 根据站点内容更新情况自行选择   权    重 0-1.0之间,推荐使用默认值

<% Else Select Case Action2 Case "CreateRss" If EnableRss = True Then Call GetRssIndex_file Response.Write "

<< 返回生成管理" Else Response.Write "

您已经禁用了RSS功能,页面未生成..........<< 返回生成管理" End If Case "CreateXml" Call PE_CreateXml Response.Write "

<< 返回生成管理" Case "CreateMap" ObjInstalled_FSO = IsObjInstalled(objName_FSO) If ObjInstalled_FSO = True Then Set fso = Server.CreateObject(objName_FSO) OutNum = Trim(Request("OutNum")) If OutNum = "" Or Not IsNumeric(OutNum) Then OutNum = 500 Else OutNum = Int(OutNum) End If MaxPerPage = Int(Trim(Request("MaxPerPage"))) If MaxPerPage = "" Or Not IsNumeric(MaxPerPage) Then MaxPerPage = 100 Else MaxPerPage = Int(MaxPerPage) End If MaxPageCol = Int(Trim(Request("MaxPageCol"))) If MaxPageCol = "" Or Not IsNumeric(MaxPageCol) Then MaxPageCol = 27 Else MaxPageCol = Int(MaxPageCol) End If Response.Write "

正在生成文章类Map页面.........." Call OutArticleMap Response.Write "" Response.Write "

正在生成软件类Map页面.........." Call OutSoftMap Response.Write "" Response.Write "

正在生成图片类Map页面.........." Call OutPhotoMap Response.Write "" If SystemVersion > 0 Then Response.Write "

正在生成商品类Map页面.........." Call OutProductMap Response.Write "" End If Response.Write "

<< 返回生成管理" Case "CreateXmlMap" ObjInstalled_FSO = IsObjInstalled(objName_FSO) If ObjInstalled_FSO = True Then Set fso = Server.CreateObject(objName_FSO) XmlOutNum = Trim(Request("XmlOutNum")) If XmlOutNum = "" Or Not IsNumeric(XmlOutNum) Then XmlOutNum = 500 Else XmlOutNum = Int(XmlOutNum) End If XmlMaxPerPage = Trim(Request("XmlMaxPerPage")) If XmlMaxPerPage = "" Or Not IsNumeric(XmlMaxPerPage) Then XmlMaxPerPage = 27 Else XmlMaxPerPage = Int(XmlMaxPerPage) End If UOffset = Trim(Request("UOffset")) If UOffset = "" Or Not IsNumeric(UOffset) Then UOffset = 8 Else UOffset = Int(UOffset) End If frequency = Trim(Request("frequency")) If frequency = "" Then frequency = "Monthly" Priority = Trim(Request("Priority")) If Priority = "" Then Priority = "0.5" Response.Write "

正在生成GOOGLE规范XML地图文章页面.........." Call OutXmlMap(1) Response.Write "" Response.Write "

正在生成GOOGLE规范XML地图软件页面.........." Call OutXmlMap(2) Response.Write "" Response.Write "

正在生成GOOGLE规范XML地图图片页面.........." Call OutXmlMap(3) Response.Write "" If SystemVersion > 0 Then Response.Write "

正在生成GOOGLE规范XML地图商品页面.........." Call OutXmlMap(5) Response.Write "" End If Response.Write "

正在生成GOOGLE规范XML地图索引页面.........." Call OutXmlIndexMap Response.Write "" Response.Write "

<< 返回生成管理" Case Else Response.Write "

参数错误..........<< 返回生成管理" End Select Set hf = Nothing End If %> <% Sub GetRssIndex_file() On Error Resume Next Dim PE_Rss Set PE_Rss = Server.CreateObject("PE_Common.ShowRss") If Err Then Err.Clear Response.Write "对不起，你的服务器没有安装动易组件（PE_Common.dll），所以不能使用动易系统。请和你的空间商联系以安装动易组件。" Exit Sub End If Call PE_Rss.GetRssIndex_file Set PE_Rss = Nothing If Err Then Response.Write "错 误 号：" & Err.Number & "
" Response.Write "错误描述：" & Err.Description & "
" Response.Write "错误来源：" & Err.Source & "
" Err.Clear End If End Sub Sub PE_CreateXml() On Error Resume Next Dim PE_Xml Set PE_Xml = Server.CreateObject("PE_Common.Xml") If Err Then Err.Clear Response.Write "对不起，你的服务器没有安装动易组件（PE_Common.dll），所以不能使用动易系统。请和你的空间商联系以安装动易组件。" Exit Sub End If Call PE_Xml.main Set PE_Xml = Nothing If Err Then Response.Write "错 误 号：" & Err.Number & "
" Response.Write "错误描述：" & Err.Description & "
" Response.Write "错误来源：" & Err.Source & "
" Err.Clear End If End Sub Sub OutArticleMap() Dim rsArticle, sqlArticle, rsChannel, strHTML, totalPut, totalPage, CurrentPage, i, j Dim iChannelDir, UseCreateHTML, StructureType, FileNameType, FileExt_Item, ClassDir, ParentDir, ClassPurview, iAuthor Dim oldChannelID: oldChannelID = 0 sqlArticle = "select top " & OutNum & " A.ArticleID,A.ChannelID,A.ClassID,A.Title,A.Author,A.UpdateTime,A.Elite,A.Passed,A.ReadPoint,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.Passed=" & PE_True & " and A.Deleted=" & PE_False & " order by A.ArticleID Desc" Set rsArticle = Server.CreateObject("adodb.recordset") rsArticle.Open sqlArticle, Conn, 1, 1 If rsArticle.bof And rsArticle.EOF Then Response.Write "尚无内容!暂不生成页面!
" Else totalPut = rsArticle.recordcount If (totalPut Mod MaxPerPage) = 0 Then totalPage = totalPut \ MaxPerPage Else totalPage = totalPut \ MaxPerPage + 1 End If i = 1 CurrentPage = 1 Do While Not rsArticle.EOF ClassDir = rsArticle(11) ParentDir = rsArticle(12) ClassPurview = rsArticle(13) 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 SystemVersion < 1 Then StructureType = 0 FileNameType = rsChannel("FileNameType") FileExt_Item = rsChannel("FileExt_Item") End If rsChannel.Close End If If Right(rsArticle(4), 1) = "|" Then iAuthor = Left(rsArticle(4), Len(rsArticle(4)) - 1) Else iAuthor = rsArticle(4) End If If UseCreateHTML > 0 And ClassPurview = 0 And (rsArticle(8) = 0 Or SystemVersion < 1) Then strHTML = strHTML & "

" & rsArticle(3) & " - [" & iAuthor & "]

" & vbCrLf Else strHTML = strHTML & "

" & rsArticle(3) & " - [" & iAuthor & "]

" & vbCrLf End If i = i + 1 If i > MaxPerPage Then Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & "SiteMap/Article" & CurrentPage & ".htm"), 2, True) strtmp = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteName & " >> 网站地图 >> 第" & CurrentPage & "页:
" & vbCrLf strtmp = strtmp & strHTML & "

分页:" For j = 1 To totalPage If CurrentPage = j Then If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " [" & j & "]
" Else strtmp = strtmp & " [" & j & "] " End If Else If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " " & j & "
" Else strtmp = strtmp & " " & j & " " End If End If Next strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & "SiteMap/Article" & CurrentPage & ".htm）成功!" CurrentPage = CurrentPage + 1 i = 1 strHTML = "" End If oldChannelID = rsArticle(1) rsArticle.movenext Loop Set rsChannel = Nothing Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & "SiteMap/Article" & CurrentPage & ".htm"), 2, True) strtmp = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteName & " >> 网站地图 >> 第" & CurrentPage & "页:
" & vbCrLf strtmp = strtmp & strHTML & "

分页:" For j = 1 To totalPage If CurrentPage = j Then If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " [" & j & "]
" Else strtmp = strtmp & " [" & j & "] " End If Else If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " " & j & "
" Else strtmp = strtmp & " " & j & " " End If End If Next strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & "SiteMap/Article" & CurrentPage & ".htm）成功!" strHTML = strHTML & "
" & vbCrLf End If rsArticle.Close Set rsArticle = Nothing End Sub Sub OutSoftMap() Dim rsArticle, sqlArticle, rsChannel, strHTML, totalPut, totalPage, CurrentPage, i, j Dim iChannelDir, UseCreateHTML, StructureType, FileNameType, FileExt_Item, ClassDir, ParentDir, ClassPurview, iAuthor Dim oldChannelID: oldChannelID = 0 sqlArticle = "select top " & OutNum & " A.SoftID,A.ChannelID,A.ClassID,A.SoftName,A.Author,A.UpdateTime,A.Elite,A.Passed,A.Deleted,A.SoftPoint,C.ClassDir,C.ParentDir,C.ClassPurview from PE_Soft A inner join PE_Class C on A.ClassID=C.ClassID Where A.Passed=" & PE_True & " and A.Deleted=" & PE_False & " order by A.SoftID Desc" Set rsArticle = Server.CreateObject("adodb.recordset") rsArticle.Open sqlArticle, Conn, 1, 1 If rsArticle.bof And rsArticle.EOF Then Response.Write "尚无内容!暂不生成页面!
" Else totalPut = rsArticle.recordcount If (totalPut Mod MaxPerPage) = 0 Then totalPage = totalPut \ MaxPerPage Else totalPage = totalPut \ MaxPerPage + 1 End If i = 1 CurrentPage = 1 Do While Not rsArticle.EOF ClassDir = rsArticle(10) ParentDir = rsArticle(11) ClassPurview = rsArticle(12) 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 SystemVersion < 1 Then StructureType = 0 FileNameType = rsChannel("FileNameType") FileExt_Item = rsChannel("FileExt_Item") End If rsChannel.Close End If If Right(rsArticle(4), 1) = "|" Then iAuthor = Left(rsArticle(4), Len(rsArticle(4)) - 1) Else iAuthor = rsArticle(4) End If If UseCreateHTML > 0 And ClassPurview = 0 And (rsArticle(9) = 0 Or SystemVersion < 1) Then strHTML = strHTML & "

" & rsArticle(3) & " - [" & iAuthor & "]

" & vbCrLf Else strHTML = strHTML & "

" & rsArticle(3) & " - [" & iAuthor & "]

" & vbCrLf End If i = i + 1 If i > MaxPerPage Then Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & "SiteMap/Soft" & CurrentPage & ".htm"), 2, True) strtmp = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteName & " >> 网站地图 >> 第" & CurrentPage & "页:
" & vbCrLf strtmp = strtmp & strHTML & "

分页:" For j = 1 To totalPage If CurrentPage = j Then If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " [" & j & "]
" Else strtmp = strtmp & " [" & j & "] " End If Else If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " " & j & "
" Else strtmp = strtmp & " " & j & " " End If End If Next strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & "SiteMap/Soft" & CurrentPage & ".htm）成功!" CurrentPage = CurrentPage + 1 i = 1 strHTML = "" End If oldChannelID = rsArticle(1) rsArticle.movenext Loop Set rsChannel = Nothing Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & "SiteMap/Soft" & CurrentPage & ".htm"), 2, True) strtmp = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteName & " >> 网站地图 >> 第" & CurrentPage & "页:
" & vbCrLf strtmp = strtmp & strHTML & "

分页:" For j = 1 To totalPage If CurrentPage = j Then If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " [" & j & "]
" Else strtmp = strtmp & " [" & j & "] " End If Else If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " " & j & "
" Else strtmp = strtmp & " " & j & " " End If End If Next strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & "SiteMap/Soft" & CurrentPage & ".htm）成功!" strHTML = strHTML & "
" & vbCrLf End If rsArticle.Close Set rsArticle = Nothing End Sub Sub OutPhotoMap() Dim rsArticle, sqlArticle, rsChannel, strHTML, totalPut, totalPage, CurrentPage, i, j Dim iChannelDir, UseCreateHTML, StructureType, FileNameType, FileExt_Item, ClassDir, ParentDir, ClassPurview, iAuthor Dim oldChannelID: oldChannelID = 0 sqlArticle = "select top " & OutNum & " A.PhotoID,A.ChannelID,A.ClassID,A.PhotoName,A.Author,A.UpdateTime,A.Passed,A.Deleted,A.PhotoPoint,C.ClassDir,C.ParentDir,C.ClassPurview from PE_Photo A inner join PE_Class C on A.ClassID=C.ClassID Where A.Passed=" & PE_True & " and A.Deleted=" & PE_False & " order by A.PhotoID Desc" Set rsArticle = Server.CreateObject("adodb.recordset") rsArticle.Open sqlArticle, Conn, 1, 1 If rsArticle.bof And rsArticle.EOF Then Response.Write "尚无内容!暂不生成页面!
" Else totalPut = rsArticle.recordcount If (totalPut Mod MaxPerPage) = 0 Then totalPage = totalPut \ MaxPerPage Else totalPage = totalPut \ MaxPerPage + 1 End If i = 1 CurrentPage = 1 Do While Not rsArticle.EOF ClassDir = rsArticle(9) ParentDir = rsArticle(10) ClassPurview = rsArticle(11) 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 SystemVersion < 1 Then StructureType = 0 FileNameType = rsChannel("FileNameType") FileExt_Item = rsChannel("FileExt_Item") End If rsChannel.Close End If If Right(rsArticle(4), 1) = "|" Then iAuthor = Left(rsArticle(4), Len(rsArticle(4)) - 1) Else iAuthor = rsArticle(4) End If If UseCreateHTML > 0 And ClassPurview = 0 And (rsArticle(8) = 0 Or SystemVersion < 1) Then strHTML = strHTML & "

" & rsArticle(3) & " - [" & iAuthor & "]

" & vbCrLf Else strHTML = strHTML & "

" & rsArticle(3) & " - [" & iAuthor & "]

" & vbCrLf End If i = i + 1 If i > MaxPerPage Then Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & "SiteMap/Photo" & CurrentPage & ".htm"), 2, True) strtmp = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteName & " >> 网站地图 >> 第" & CurrentPage & "页:
" & vbCrLf strtmp = strtmp & strHTML & "

分页:" For j = 1 To totalPage If CurrentPage = j Then If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " [" & j & "]
" Else strtmp = strtmp & " [" & j & "] " End If Else If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " " & j & "
" Else strtmp = strtmp & " " & j & " " End If End If Next strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & "SiteMap/Photo" & CurrentPage & ".htm）成功!" CurrentPage = CurrentPage + 1 i = 1 strHTML = "" End If oldChannelID = rsArticle(1) rsArticle.movenext Loop Set rsChannel = Nothing Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & "SiteMap/Photo" & CurrentPage & ".htm"), 2, True) strtmp = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteName & " >> 网站地图 >> 第" & CurrentPage & "页:
" & vbCrLf strtmp = strtmp & strHTML & "

分页:" For j = 1 To totalPage If CurrentPage = j Then If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " [" & j & "]
" Else strtmp = strtmp & " [" & j & "] " End If Else If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " " & j & "
" Else strtmp = strtmp & " " & j & " " End If End If Next strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & "SiteMap/Photo" & CurrentPage & ".htm）成功!" strHTML = strHTML & "
" & vbCrLf End If rsArticle.Close Set rsArticle = Nothing End Sub Sub OutProductMap() Dim rsArticle, sqlArticle, rsChannel, strHTML, totalPut, totalPage, CurrentPage, i, j Dim iChannelDir, UseCreateHTML, StructureType, FileNameType, FileExt_Item, ClassDir, ParentDir, ClassPurview, iAuthor Dim oldChannelID: oldChannelID = 0 sqlArticle = "select top " & OutNum & " A.ProductID,A.ChannelID,A.ClassID,A.ProductName,A.ProducerName,A.UpdateTime,A.EnableSale,A.Deleted,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" Set rsArticle = Server.CreateObject("adodb.recordset") rsArticle.Open sqlArticle, Conn, 1, 1 If rsArticle.bof And rsArticle.EOF Then Response.Write "尚无内容!暂不生成页面!
" Else totalPut = rsArticle.recordcount If (totalPut Mod MaxPerPage) = 0 Then totalPage = totalPut \ MaxPerPage Else totalPage = totalPut \ MaxPerPage + 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 SystemVersion < 1 Then StructureType = 0 FileNameType = rsChannel("FileNameType") FileExt_Item = rsChannel("FileExt_Item") End If rsChannel.Close End If If Right(rsArticle(4), 1) = "|" Then iAuthor = Left(rsArticle(4), Len(rsArticle(4)) - 1) Else iAuthor = rsArticle(4) End If If UseCreateHTML > 0 Then strHTML = strHTML & "

" & rsArticle(3) & " - [" & iAuthor & "]

" & vbCrLf Else strHTML = strHTML & "

" & rsArticle(3) & " - [" & iAuthor & "]

" & vbCrLf End If i = i + 1 If i > MaxPerPage Then Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & "SiteMap/Product" & CurrentPage & ".htm"), 2, True) strtmp = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteName & " >> 网站地图 >> 第" & CurrentPage & "页:
" & vbCrLf strtmp = strtmp & strHTML & "

分页:" For j = 1 To totalPage If CurrentPage = j Then If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " [" & j & "]
" Else strtmp = strtmp & " [" & j & "] " End If Else If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " " & j & "
" Else strtmp = strtmp & " " & j & " " End If End If Next strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & "SiteMap/Product" & CurrentPage & ".htm）成功!" CurrentPage = CurrentPage + 1 i = 1 strHTML = "" End If oldChannelID = rsArticle(1) rsArticle.movenext Loop Set rsChannel = Nothing Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & "SiteMap/Product" & CurrentPage & ".htm"), 2, True) strtmp = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteName & " >> 网站地图 >> 第" & CurrentPage & "页:
" & vbCrLf strtmp = strtmp & strHTML & "

分页:" For j = 1 To totalPage If CurrentPage = j Then If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " [" & j & "]
" Else strtmp = strtmp & " [" & j & "] " End If Else If (j Mod MaxPageCol) = 0 Then strtmp = strtmp & " " & j & "
" Else strtmp = strtmp & " " & j & " " End If End If Next strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & "SiteMap/Product" & CurrentPage & ".htm）成功!" strHTML = strHTML & "
" & vbCrLf End If 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.Passed,A.ReadPoint,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.Passed=" & PE_True & " 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.Passed,A.SoftPoint,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.Passed=" & PE_True & " 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.Passed,A.PhotoPoint,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.Passed=" & PE_True & " 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 "尚无内容!暂不生成页面!
" 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 SystemVersion < 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 & "" & vbCrLf If OutType < 4 Then If UseCreateHTML > 0 And ClassPurview = 0 And (rsArticle(5) = 0 Or SystemVersion < 1) Then strHTML = strHTML & "" & SiteUrl & iChannelDir & GetItemPath(StructureType, ParentDir, ClassDir, rsArticle(3)) & GetItemFileName(FileNameType, iChannelDir, rsArticle(3), rsArticle(0)) & GetFileExt(FileExt_Item) & "" & vbCrLf Else strHTML = strHTML & "" & SiteUrl & iChannelDir & AspName & rsArticle(0) & "" & vbCrLf End If ElseIf OutType = 5 Then If UseCreateHTML > 0 Then strHTML = strHTML & "" & SiteUrl & iChannelDir & GetItemPath(StructureType, ParentDir, ClassDir, rsArticle(3)) & GetItemFileName(FileNameType, iChannelDir, rsArticle(3), rsArticle(0)) & GetFileExt(FileExt_Item) & "" & vbCrLf Else strHTML = strHTML & "" & SiteUrl & iChannelDir & AspName & rsArticle(0) & "" & vbCrLf End If End If strHTML = strHTML & "" & iso8601date(rsArticle(3), UOffset) & "" & vbCrLf strHTML = strHTML & "" & frequency & "" & vbCrLf strHTML = strHTML & "" & Priority & "" & vbCrLf strHTML = strHTML & "" & vbCrLf i = i + 1 If i > XmlMaxPerPage Then Set hf = fso.OpenTextFile(Server.MapPath(strInstallDir & OutFileName & CurrentPage & ".xml"), 2, True) strtmp = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & strHTML strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & OutFileName & CurrentPage & ".xml）成功!" 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 = "" & vbCrLf strtmp = strtmp & "" & vbCrLf strtmp = strtmp & strHTML strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & OutFileName & CurrentPage & ".xml)成功!" strHTML = strHTML & "
" & 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 = "" & vbCrLf strtmp = strtmp & "" & vbCrLf If ArtPage > 0 Then For j = 1 To ArtPage strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteUrl & "sitemap_article_" & j & ".xml" & vbCrLf strtmp = strtmp & "" & iso8601date(Now(), UOffset) & "" & vbCrLf strtmp = strtmp & "" & vbCrLf Next End If If SoftPage > 0 Then For j = 1 To SoftPage strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteUrl & "sitemap_Soft_" & j & ".xml" & vbCrLf strtmp = strtmp & "" & iso8601date(Now(), UOffset) & "" & vbCrLf strtmp = strtmp & "" & vbCrLf Next End If If PhotoPage > 0 Then For j = 1 To PhotoPage strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteUrl & "sitemap_Photo_" & j & ".xml" & vbCrLf strtmp = strtmp & "" & iso8601date(Now(), UOffset) & "" & vbCrLf strtmp = strtmp & "" & vbCrLf Next End If If ProductPage > 0 And SystemVersion > 0 Then For j = 1 To ProductPage strtmp = strtmp & "" & vbCrLf strtmp = strtmp & "" & SiteUrl & "sitemap_Product_" & j & ".xml" & vbCrLf strtmp = strtmp & "" & iso8601date(Now(), UOffset) & "" & vbCrLf strtmp = strtmp & "" & vbCrLf Next End If strtmp = strtmp & "" & vbCrLf hf.Write strtmp hf.Close Response.Write "
生成页面（" & strInstallDir & "sitemap_index.xml）成功!， [点击这里提交到Google]" 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 d = DateAdd("H", -1 * utcOffset, dLocal) iso8601date = Year(d) & "-" & Right("0" & Month(d), 2) & "-" & Right("0" & Day(d), 2) & "T" & _ Right("0" & Hour(d), 2) & ":" & Right("0" & Minute(d), 2) & ":" & Right("0" & Second(d), 2) & "Z" End Function %>