<%
CheckLogin()
Server.ScriptTimeOut=36000
dim action : action=getForm("action","get")
dim actType : actType=getform("actType","get")
select case action
case "day" : checkRunMode : makeByDay
case "all" : checkRunMode : makeAll
case "index" : checkRunMode : makeIndex
case "about" : checkRunMode : makeAllAbout
case "alllist" : checkRunMode : makeAllList
case "allcontent" : checkRunMode : makeAllContent
case "list" : checkRunMode : makeListBySort
case "content" : checkRunMode : makeContentBySortID
case "baidu" : checkRunMode : makeBaiduMap
case "google" : checkRunMode : makeGoogleMap
case "site" : checkRunMode : makeSiteMap
case "ditu" : checkRunMode : makeditu
case "ditu2" : checkRunMode : makeditu2
end select
Sub checkRunMode
End Sub
Sub makeAll()
makeAllContent()
makeAllAbout()
makeAllList()
makeIndex()
makeditu2()
alertMsgAndGo "生成全站成功","AspCms_MakeHtml.asp?actType="&actType
End Sub
Sub makeditu()
makeBaiduMap()
makeSiteMap()
alertMsgAndGo "生成HTML網站地圖、XML網站地圖成功,","AspCms_MakeHtml.asp?actType="&actType
End Sub
Sub makeditu2()
makeBaiduMap()
makeSiteMap()
End Sub
Sub makeByDay
dim rs,sql,EditTime,SortIDs
if not isdate(EditTime) Then
EditTime=date()
else
EditTime=getForm("EditTime", "post")
end if
sql="select * from {prefix}Content where ContentStatus=1 and LanguageID="&cint(rCookie("languageID"))&" and DateDiff('d', EditTime, '"&EditTime&"')<=0 order by ContentID"
set rs=conn.Exec(sql,"r1")
Do While not rs.Eof
'echo "生成"""&rs("ContentID")&"""成功 "
makeContent rs("ContentID"), 1, 1
rs.movenext
Loop
sql="select SortPath from {prefix}Sort where SortID in(select SortID from {prefix}Content where ContentStatus=1 and LanguageID="&cint(rCookie("languageID"))&" and DateDiff('d', EditTime, '"&EditTime&"')<=0 group by SortID)"
set rs=conn.Exec(sql,"r1")
Do While not rs.Eof
SortIDs=SortIDs&rs(0)
rs.moveNext
Loop
if not isnul(SortIDs) then
sql="select SortID from {prefix}Sort where SortID in("&SortIDs&")"
set rs=conn.Exec(sql,"r1")
Do While not rs.Eof
makeList( rs(0))
rs.moveNext
Loop
end if
rs.close : set rs =nothing
makeIndex()
makeAllAbout()
makeBaiduMap()
makeSiteMap()
alertMsgAndGo "HTML更新成功！","AspCms_MakeHtml.asp?actType="&actType
End Sub
'生成所有列表頁
Sub makeAllList()
dim rs,sql
sql = "select SortID,SortType,SortName from {prefix}Sort where SortType<>1 and SortType<>7 and GroupID<3 and LanguageID="&cint(rCookie("languageID"))&" order by SortID"
set rs=conn.Exec(sql,"r1")
Do While not rs.Eof
makeList( rs("SortID"))
'echo "生成"""&rs("SortID")&rs("SortName")&"""成功 "
rs.movenext
Loop
rs.close : set rs =nothing
if action<>"all" then alertMsgAndGo "生成列表頁成功","AspCms_MakeHtml.asp?actType="&actType
End Sub
'按條件生成列表頁
Sub makeListBySort()
dim rs,sql,SortID
SortID=getForm("lsortid","post")
if SortID=0 then alertMsgAndGo "請選擇欄目","AspCms_MakeHtml.asp?actType="&actType
if not isnum(SortID) then alertMsgAndGo "分類ID不正確","AspCms_MakeHtml.asp?actType="&actType
dim sortids
sortids=getSubSort(SortID, 1)
sql="select SortID,SortType,SortName from {prefix}Sort where SortType<>1 and SortType<>7 and GroupID<3 and LanguageID="&cint(rCookie("languageID"))&" and SortID in ("&sortids&") order by SortID"
set rs=conn.Exec(sql,"r1")
Do While not rs.Eof
makeList( rs("SortID"))
'echo "生成"""&rs("SortName")&"""成功 "
rs.movenext
Loop
rs.close : set rs =nothing
'for each SortID in sortids
' if isnum(SortID) then makeList(SortID)
' next
alertMsgAndGo "生成指定列表頁成功","AspCms_MakeHtml.asp?actType="&actType
End Sub
'生成首頁
Sub makeIndex
dim templateobj,templatePath : set templateobj = new TemplateClass
templatePath=sitePath&"/"&setting.htmlFilePath&"/index.html"
'die templatePath
if not CheckTemplateFile(templatePath) then echo "index.html"&err_16
with templateObj
.content=loadFile(templatePath)
.parseHtml()
.parseCommon
createTextFile .content, sitePath&setting.LanguagePath&"index"&FileExt,""
end with
set templateobj =nothing
if action<>"all" and action<>"day" then alertMsgAndGo "生成首頁成功","AspCms_MakeHtml.asp?actType="&actType
End Sub
'生成所有內容頁
Sub makeAllContent
dim rs,sql
sql="select * from {prefix}Content where ContentStatus=1 and GroupID<3 and LanguageID="&cint(rCookie("languageID"))&" order by ContentID"
set rs=conn.Exec(sql,"r1")
Do While not rs.Eof
'echo "生成"""&rs("ContentID")&"""成功 "
makeContent rs("ContentID"), 1, 1
rs.movenext
Loop
rs.close : set rs =nothing
if action<>"all" then alertMsgAndGo "生成內容頁成功","AspCms_MakeHtml.asp?actType="&actType
End Sub
'按分類生成
Sub makeContentBySortID
dim rs,sql,SortID
SortID=getForm("csortid","post")
if SortID=0 then alertMsgAndGo "請選擇欄目","AspCms_MakeHtml.asp?actType="&actType
sql="select * from {prefix}Content where ContentStatus=1 and GroupID<3 and SortID in("&getSubSort(SortID, 1)&") and LanguageID="&cint(rCookie("languageID"))
set rs=conn.Exec(sql,"r1")
Do While not rs.Eof
'echo "生成"""&rs("ContentID")&"""成功 "
makeContent rs("ContentID"), 1, 1
rs.movenext
Loop
rs.close : set rs =nothing
if action<>"all" then alertMsgAndGo "生成指定內容頁成功","AspCms_MakeHtml.asp?actType="&actType
End Sub
'生成所有單頁
Sub makeAllAbout
dim rs,sql
sql = "select SortID,SortType from {prefix}Sort where SortType=1 and GroupID<3 and LanguageID="&cint(rCookie("languageID"))
set rs=conn.exec(sql,"r1")
do while not rs.Eof
makeAbout rs("SortID"), 0, 1
rs.movenext
loop
rs.close : set rs =nothing
if action<>"all" and action<>"day" then alertMsgAndGo "生成專題成功","AspCms_MakeHtml.asp?actType="&actType
End Sub
'生成Baidu 站點地圖
'by amysimple 2011-06-24
Sub makeBaiduMap
Dim m_timespanB,m_timespanE:m_timespanB=timer
Dim resultUrl,tempUrl
Dim resultMsg
Dim makenum
if isNul(makenum) then makenum=1000 else makenum=clng(makenum)
allmakenum=getForm("allmakenum","get") : if isNul(allmakenum) then allmakenum=5000 else allmakenum=clng(allmakenum)
dim vDes,vName,i,j,rsObj,baiduStr,allmakenum,pagenum,xmlUrl,dt
dim TemplateObj : set TemplateObj= new TemplateClass
set rsObj=conn.Exec("select top "&allmakenum&" ContentID,a.SortID,a.GroupID,a.Exclusive,Title,Title2,TitleColor,IsOutLink,OutLink,Author,ContentSource,ContentTag,Content,ContentStatus,IsTop,Isrecommend,IsImageNews,IsHeadline,IsFeatured,ContentOrder,IsGenerated,Visits,a.AddTime,a.[ImagePath],a.IndexImage,a.DownURL,a.PageFileName,a.PageDesc,SortType,SortURL,SortFolder,SortFileName,SortName,ContentFolder,ContentFileName,b.GroupID from {prefix}Content as a,{prefix}Sort as b where a.LanguageID="&setting.languageID&"and a.SortID=b.SortID and ContentStatus=1 order by a.addtime desc","r1")
rsObj.pagesize=makenum
pagenum=rsObj.pagecount
redim resultUrl(pagenum-1)
for i=1 to pagenum
rsObj.absolutepage=i
baiduStr = ""
baiduStr = baiduStr & "http://"&setting.siteUrl&""
dt=rsObj("AddTime")
baiduStr = baiduStr & "1.0"
baiduStr = baiduStr & ""
for j=1 to rsObj.pagesize
vDes=rsObj("ContentTag") : if isNul(vDes) then vDes=""
vName=rsObj("Title") : if isNul(vName) then vName=""
Dim link
link="http://"&setting.siteUrl&TemplateObj.getContentLink(rsObj("SortID"),rsObj("ContentID"),rsObj("SortFolder"),rsObj("a.GroupID"),rsObj("ContentFolder"),rsObj("ContentFileName"),rsObj("AddTime"),rsobj("PageFileName"),rsObj("b.GroupID"))
baiduStr = baiduStr & ""&link&""
dt=rsObj("AddTime")
baiduStr = baiduStr & "0.5"
baiduStr = baiduStr & ""
rsObj.movenext
if rsObj.eof then exit for
next
baiduStr = baiduStr + ""
tempUrl = sitePath&setting.languagePath&"sitemap.xml"
createTextFile baiduStr,tempUrl,"utf-8"
resultUrl(i-1)="http://"&setting.siteUrl&tempUrl
next
rsObj.close : set rsObj=nothing
End Sub
Sub makeSiteMap
dim templateobj,templatePath : set templateobj=new TemplateClass
templatePath=sitePath&"/"&setting.htmlFilePath&"/sitemap.html"
if not CheckTemplateFile(templatePath) then echo templatePath&err_16 : exit Sub
with templateObj
.content=loadFile(templatePath)
.parseHtml()
.parseCommon
createTextFile .content ,sitePath&setting.languagePath&"sitemap.html",""
end with
set templateobj =nothing : terminateAllObjects
End Sub
Sub makeRssMap
dim templateobj,templatePath : set templateobj=new TemplateClass
templatePath=sitePath&"/"&setting.htmlFilePath&"/rssmap.html"
if not CheckTemplateFile(templatePath) then echo templatePath&err_16 : exit Sub
with templateObj
.content=loadFile(templatePath)
.parseHtml()
.parseRssList("")
.parseCommon
createTextFile .content ,sitePath&setting.languagePath&"rssmap.html",""
end with
set templateobj =nothing
End Sub
Sub makeRss
Dim rssStr,rssStr1,rssStr2,rssStr3,sortid
Dim rs
dim templateobj,templatePath : set templateobj=new TemplateClass
set rs=conn.exec("select SortID,SortName,SortURL,SortType,SortFolder,PageKeyWords,PageDesc from {prefix}Sort where SortType<>7 and LanguageID="&rCookie("LanguageID"),"r1")
do while not rs.eof
rssStr1="<![CDATA["&rs("SortName")&"_"&setting.siteTitle&"]]>http://"&setting.siteUrl&"zh-cn"&setting.companyEmail&""
rssStr3=""
Dim rsObj,sql
rssStr2=""
sql="select top 100 ContentID,a.SortID,a.GroupID,a.Exclusive,Title,Title2,TitleColor,IsOutLink,OutLink,Author,ContentSource,ContentTag,Content,ContentStatus,IsTop,Isrecommend,IsImageNews,IsHeadline,IsFeatured,ContentOrder,IsGenerated,Visits,a.AddTime,a.[ImagePath],a.IndexImage,a.DownURL,a.PageFileName,a.PageDesc,SortType,SortURL,SortFolder,SortFileName,SortName,ContentFolder,ContentFileName,b.GroupID from {prefix}Content as a,{prefix}Sort as b where a.LanguageID="&setting.languageID&"and a.SortID=b.SortID and a.SortID="&rs("SortID")&" and ContentStatus=1 order by a.addtime desc"
set rsObj=conn.Exec(sql,"r1")
do while not rsObj.eof
rssStr2=rssStr2&"<![CDATA["&rsObj("Title")&"]]>http://"&setting.siteUrl&TemplateObj.getContentLink(rsObj("SortID"),rsObj("ContentID"),rsObj("SortFolder"),rsObj("a.GroupID"),rsObj("ContentFolder"),rsObj("ContentFileName"),rsObj("AddTime"),rsobj("PageFileName"),rsObj("b.GroupID"))&""&formatDate(rsObj("AddTime"),1)&""&rs("SortName")&""&rsObj("Author")&""&setting.siteTitle&""
rsObj.movenext
loop
rssStr=rssStr1&rssStr2&rssStr3
createTextFile rssStr,sitePath&setting.languagePath&"rss/"&rs("SortID")&".xml",""
rs.movenext
loop
rsObj.close : set rsObj=nothing
rs.close : set rs=nothing
set templateobj =nothing
makeRssMap()
alertMsgAndGo "RSS生成成功!","-1"
End Sub
Sub delAllHtml
dim styles,style
styles=split("news,down,pic,product,about,",",")
if isExistFile(sitePath&"/"&"index.html") then delFile sitePath&"/"&"index.html" '刪除首頁
for each style in styles
if style="news" or style="down" or style="pic" or style="product" then Delhtml(style&"list") '刪除列表頁
Delhtml(style) '刪除詳細頁
next
'刪除指定的生成目錄
styles=""
styles=conn.exec("select SortFolder from {prefix}Sort where not isnull(SortFolder)","arr")
for each style in styles
'if not isnul(style) then echo "/"&sitePath&style&" "
'Delhtml(style) '刪除詳細頁
if not isnul(style) and isExistFolder("/"&sitePath&style) then delFolder("/"&sitePath&style)
next
End Sub
'根據目錄刪除html文件
Sub delhtml(str)
dim fileListArray,fileAttr,i
fileListArray= getFileList("/"&sitePath&str)
if instr(fileListArray(0),",")>0 then
for i = 0 to ubound(fileListArray)
fileAttr=split(fileListArray(i),",")
if GetExtend(fileAttr(0))=replace(FileExt,".","") then delFile fileAttr(4)
next
end if
End Sub
Function getSortLink(sortType, sortID, sortUrl, sortFolder, sortFileName, GroupID, Exclusive)
sortFolder=replace(repnull(sortFolder), "{sitepath}", sitePath)
sortFileName=replace(repnull(sortFileName), "{sortid}", sortID)
sortFileName=replace(sortFileName, "{page}", "1")
if sortType="7" then
if isurl(sortUrl) then
getSortLink=sortUrl
else
getSortLink=sitePath&sortUrl
end if
else
if runMode=1 and viewNoRight(GroupID, Exclusive) then
getSortLink=sortFolder&sortFileName&fileExt
else
Select case sortType
case "1"
getSortLink=sitePath&setting.languagePath&""&"about"&"/?"&sortID&fileExt
case else
getSortLink=sitePath&setting.languagePath&""&"list"&"/?"&sortID&"_1"&fileExt
End Select
end if
end if
End Function
Sub ResultUI(resultHTML)
%>