📄 admin_create_other.asp
字号:
<!--#include file="../Conn.asp"-->
<!--#include file="../Inc/Cl_ClsSysTem.asp"-->
<!--#include file="../Inc/Cl_Function_Public.asp"-->
<!--#include file="Inc/Function.asp"-->
<%
Dim ChannelID
Dim Action, CreateType
Dim sTemp, objStream
Dim TotalPut, CurrentPage, TotalPages
Dim sModuleName, sTitleName
Cl.Get_WebSetting()
if Cl.ChkIsOuter then
Call Cl.OutErr(0,"<p align=center><font color='red'>对不起，为了系统安全，不允许直接或从外部链接地址访问本系统的后台管理页面。</font></p>")
end if
ChannelID = Cl.GetClng(Request("ChannelID"))
if ChannelID = 0 then Cl.ShowErr("参数错误！")
Cl.Get_ChannelSetting(ChannelID)
if Not Cl.ChkAdminLogin then Cl.ShowErr("<li>您未登录或者您无此操作权限！</li>")
if Not Cl.TrueChannelPurview(3,ChannelID) then Cl.ShowErr("<br /><li>您无此操作权限！</li>")
Cl.Web_Setting(0) = "No"
CreateHtmlIng = True
Action = Lcase(Trim(Request("Action")))
Select Case Clng(Cl.Channel.selectSingleNode("@moduleid").text)
Case 1 : sModuleName = "Article" : sTitleName = "Title"
Case 2 : sModuleName = "Soft" : sTitleName = "SoftName"
Case 3 : sModuleName = "Photo" : sTitleName = "PhotoName"
Case 4 : sModuleName = "Movie" : sTitleName = "MovieName"
Case 5 : sModuleName = "Product" : sTitleName = "ProductName"
Case Else : sModuleName = "Article" : sTitleName = "Title"
End Select
Header
Select Case Action
Case "createmap"
Call CreateMap()
Case "createxmlmap"
Call CreateXmlMap()
Case Else
Call ShowCreateMain()
End Select
Footer
Sub ShowCreateMain()
%>
<script language="JavaScript" src="../inc/Js/selectdate.js" type="text/javascript"></script>
<table border="0" align="center" cellpadding="0" cellspacing="1" class="border">
<form action="Admin_Create_Other.asp" method="post" name="formap" id="formap">
<tr><td class="title">(<%=Cl.Channel.selectSingleNode("@channelitemname").text%>)HTML地图生成操作</td></tr>
<tr class="tdbg"><td> 说明：生成HTML格式的全站地图</td></tr>
<tr class="tdbg"><td> 总输出数量
<input name="TopNum" id="TopNum" value="1000" size="8" maxlength="5" />
<font color="#888888">HTML地图总输出数量</font></td>
</tr>
<tr class="tdbg"><td> 每页记录数
<input name="PageSize" id="PageSize" value="100" size="8" maxlength="2" />
<font color="#888888">每页输出数量，不能大于100</font></td>
</tr>
<tr class="tdbg"><td> 分页换行数
<input name="MaxPageCol" id="MaxPageCol" value="10" size="8" maxlength="2" />
<font color="#888888">地图分页每行显示数</font></td>
</tr>
<tr class="tdbg"><td>
<input name="Action" type="hidden" id="Action" value="CreateMap" />
<input name="ChannelID" type="hidden" id="ChannelID" value="<%=ChannelID%>" />
<input name="submit" type="submit" id="submit" value="开始生成 >> " />
</td></tr>
</form>
</table>
<br />
<table border="0" align="center" cellpadding="0" cellspacing="1" class="border">
<form action="Admin_Create_Other.asp" method="post" name="formxmlmap" id="formxmlmap">
<tr><td class="title">(<%=Cl.Channel.selectSingleNode("@channelitemname").text%>)XML地图生成操作</td></tr>
<tr class="tdbg"><td> 说明：生成符合GOOGLE规范的XML格式地图</td></tr>
<tr class="tdbg"><td> 总输出数量
<input name="TopNum" id="TopNum" value="5000" size="10" maxlength="5" />
<font color="#888888">XML地图总输出数量</font></td>
</tr>
<tr class="tdbg"><td> 每页记录数
<input name="PageSize" id="PageSize" value="1000" size="10" maxlength="4" />
<font color="#888888">每页记录数，不能大于3000</font></td>
</tr>
<tr class="tdbg"><td> 更 新 频率 <select name="Frequency">
<option value="always">随时更新</option>
<option value="hourly">每 小 时</option>
<option value="daily">每天更新</option>
<option value="weekly" selected="selected">每周更新</option>
<option value="monthly">每月更新</option>
<option value="yearly">每年更新</option>
<option value="never">从不更新</option>
</select>
<font color="#888888">根据站点内容更新情况自行选择</font></td>
</tr>
<tr class="tdbg"><td> 优先权比值
<input name="Priority" id="Priority" value="0.5" size="10" maxlength="3" />
<font color="#888888">0.0-1.0之间,推荐使用默认值</font></td>
</tr>
<tr class="tdbg"><td>
<input name="Action" type="hidden" id="Action" value="CreateXmlMap" />
<input name="ChannelID" type="hidden" id="ChannelID" value="<%=ChannelID%>" />
<input name="submit" type="submit" id="submit" value="开始生成 >> " />
</td></tr>
</form>
</table>
<%
End Sub
Sub CreateMap()
Server.ScriptTimeOut = 999999
Dim Mi,Make,LinkUrl,sFileUrl,sHead
Dim TopNum,PageSize,MaxPageCol
Dim SqlMake, RsMake
TopNum = Cl.GetClng(Request("TopNum"))
PageSize = Cl.GetClng(Request("PageSize"))
MaxPageCol = Cl.GetClng(Request("MaxPageCol"))
if TopNum = 0 then Call Cl.OutMsg(0,"参数错误，请重新输入！","javascript:history.go(-1)")
if PageSize < 1 or PageSize > 100 then PageSize = 100
Set RsMake = Server.CreateObject("ADODB.Recordset")
SqlMake="Select Top " & TopNum & " InfoID,ClassID,"&sTitleName&",Prefixion,UpDateTime,IsHtml,HtmlFileUrl from Cl_" & sModuleName & " where Status=1 and Deleted=False and ChannelID="&ChannelID&" order by UpDateTime desc,InfoID desc"
OpenConn : RsMake.open SqlMake,Conn,1,1
if RsMake.Bof and RsMake.Eof then
RsMake.Close:Set RsMake=Nothing
Response.Write "<font color='red'>当前无任何"&Cl.Channel.selectSingleNode("@channelitemname").text&"！</font>"
exit sub
End if
Response.Write "<font color='#ff0033'>正在生成"&Cl.Channel.selectSingleNode("@channelitemname").text&"站点地图，请稍候.....</font><br />"
TotalPut = RsMake.recordcount
if (TotalPut mod PageSize)=0 then
TotalPages = TotalPut \ PageSize
else
TotalPages = TotalPut \ PageSize + 1
end if
sHead = "<html>" & Vbcrlf
sHead = sHead & "<head>" & Vbcrlf
sHead = sHead & "<title>"&Cl.Web_Info(1)&"--SiteMap</title>" & Vbcrlf
sHead = sHead & "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & Vbcrlf
sHead = sHead & "<link href="""&Cl.WebDir&"Skins/Css/Css0.css"" rel=""stylesheet"" type=""text/css"">" & Vbcrlf
sHead = sHead & "</head>" & Vbcrlf
On Error Resume Next
Set objStream = CreateObject(Trim(Cl.Web_Info(13)))
For CurrentPage=1 To TotalPages
RsMake.MoveFirst
RsMake.move (CurrentPage-1)*PageSize
SqlMake=RsMake.GetRows(PageSize)
sTemp = "<body>" & vbcrlf
sTemp = sTemp & Cl.Web_Info(1) & " >> 网站地图 >> Page" & CurrentPage & "<br />" & vbcrlf
For Mi=0 to Ubound(SqlMake,2)
if SqlMake(5,Mi)=True and Clng(Cl.Channel.selectSingleNode("@iscreatehtml").text)=1 then
LinkUrl=Cl.WebDir & SqlMake(6,Mi)
else
LinkUrl=Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text & "/ShowInfo.asp?InfoID="&SqlMake(0,Mi)
end if
sTemp = sTemp & "<li><a href=""http://" & Cl.ServerName & Server.HtmlEnCode(LinkUrl) & """>"
sTemp = sTemp & SqlMake(2,Mi) & "</a> - [" & Cl.Format_Time(SqlMake(4,Mi),3) & "]</li>" & Vbcrlf
if Not Response.IsClientConnected then Exit For
Next
sTemp = sTemp & "<br />"
For Mi=1 to TotalPages
if Mi = CurrentPage then
sTemp = sTemp & " [<font color=red>" & Mi & "</font>] "
Else
sTemp = sTemp & " [<a href=""http://" & Cl.ServerName & Cl.WebDir & "SiteMap/" & Cl.Channel.selectSingleNode("@channeldir").text & "_" & Mi & ".html"">" & Mi & "</a>] "
End if
if Mi Mod MaxPageCol = 0 then sTemp = sTemp & "<br />" & VbCrlf
Next
sTemp = sTemp & "</body>" & vbcrlf
sTemp = sHead & sTemp & "</html>"
sFileUrl = Cl.WebDir & "SiteMap/" & Cl.Channel.selectSingleNode("@channeldir").text & "_" & CurrentPage & ".html"
Set Make = objStream.CreateTextFile(Server.MapPath(sFileUrl), True)
Make.Write sTemp & vbNewLine & _
"<!--Powered by:"& ClCMS_Version & "(www.as"&"poo.c"&"n) " &_
"CreateDate:"&Now&"--> "
Set Make = Nothing
Response.Write "生成HTML站点地图("&sFileUrl&")成功！<br />"
Next
SqlMake=Empty
Set objStream = Nothing
RsMake.Close:Set RsMake=Nothing
Response.Write "<font color=blue>恭喜您，HTML站点地图生成完毕！</font>"
End Sub
Sub CreateXmlMap()
Server.ScriptTimeOut = 999999
Dim Mi, LinkUrl, sFileUrl
Dim TopNum,PageSize,Frequency,Priority
Dim SqlMake, RsMake
TopNum = Cl.GetClng(Request("TopNum"))
PageSize = Cl.GetClng(Request("PageSize"))
Frequency = Trim(Request("Frequency"))
Priority = Trim(Request("Priority"))
if TopNum = 0 then Call Cl.OutMsg(0,"参数错误，请重新输入！","javascript:history.go(-1)")
if Not IsNumeric(Priority) then Priority=0.5
if PageSize < 1 or PageSize > 3000 then PageSize = 1000
'Priority = Int(Priority)
Set RsMake = Server.CreateObject("ADODB.Recordset")
SqlMake="Select Top " & TopNum & " InfoID,ClassID,UpDateTime,IsHtml,HtmlFileUrl from Cl_" & sModuleName & " where Status=1 and Deleted=False and ChannelID="&ChannelID&" order by UpDateTime desc,InfoID desc"
OpenConn : RsMake.open SqlMake,Conn,1,1
if RsMake.Bof and RsMake.Eof then
RsMake.Close:Set RsMake=Nothing
Response.Write "<font color='red'>当前无任何"&Cl.Channel.selectSingleNode("@channelitemname").text&"！</font>"
exit sub
End if
Response.Write "<font color='#ff0033'>正在生成"&Cl.Channel.selectSingleNode("@channelitemname").text&"站点地图，请稍候.....</font><br />"
TotalPut = RsMake.recordcount
if (TotalPut mod PageSize)=0 then
TotalPages = TotalPut \ PageSize
else
TotalPages = TotalPut \ PageSize + 1
end if
On Error Resume Next
Set objStream = Server.CreateObject("ADODB"&".Stream")
For CurrentPage=1 To TotalPages
RsMake.MoveFirst
RsMake.move (CurrentPage-1)*PageSize
SqlMake=RsMake.GetRows(PageSize)
sTemp = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbcrlf
sTemp = sTemp & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbcrlf
For Mi=0 to Ubound(SqlMake,2)
if SqlMake(3,Mi)=True and Clng(Cl.Channel.selectSingleNode("@iscreatehtml").text)=1 then
LinkUrl=Cl.WebDir & SqlMake(4,Mi)
else
LinkUrl=Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text & "/ShowInfo.asp?InfoID="&SqlMake(0,Mi)
end if
sTemp = sTemp & "<url>" & vbcrlf
sTemp = sTemp & "<loc>http://" & Cl.ServerName & Server.HtmlEnCode(LinkUrl) & "</loc>" & vbcrlf
sTemp = sTemp & "<lastmod>" & Cl.Format_Time(SqlMake(2,Mi),3) & "</lastmod>" & vbcrlf
sTemp = sTemp & "<changefreq>" & Frequency & "</changefreq>" & vbcrlf
sTemp = sTemp & "<priority>" & Priority & "</priority>" & vbcrlf
sTemp = sTemp & "</url>" & vbcrlf
if Not Response.IsClientConnected then Exit For
Next
sTemp = sTemp & "</urlset>" & vbcrlf
sFileUrl = Cl.WebDir & "SiteMap/" & Cl.Channel.selectSingleNode("@channeldir").text & "_" & CurrentPage & ".xml"
With objStream
.Open
.Position = objStream.Size
.Charset = "utf-8"
.WriteText = sTemp
.SaveToFile server.mappath(sFileUrl),2 '生成的XML文件名
.Close
End With
Response.Write "生成XML站点地图("&sFileUrl&")成功！<br />"
Next
SqlMake=Empty
Set objStream = Nothing
RsMake.Close:Set RsMake=Nothing
Response.Write "<font color=blue>恭喜您，XML站点地图生成完毕！</font>"
End Sub
'<!--
'┌───────────────────────────────────────────────────────┐
'│ │
'│ CreateLive CMS Version 4.0 │
'│ Powered by Aspoo.CN │
'│ │
'│ 邮箱: support@aspoo.cn Info@aspoo.cn │
'│ ＱＱ: 3315263 596197794 │
'│ 网站: www.aspoo.cn www.aspoo.com │
'│ 论坛: bbs.aspoo.cn bbs.aspoo.com │
'│ │
'│ Copyright (C) 2005-2007 Aspoo.CN All Rights Reserved. │
'└───────────────────────────────────────────────────────┘
'-->
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -