create_listingcls.asp

来自「多用户管理分权限发布、管理软件信息； 自由选择系统默认为静态HTML或动态A」· ASP 代码 · 共 787 行 · 第 1/3 页

			Else
				images = "<A HREF='" & Newasp.SetupDir & "Article.Asp?id=" & Rs("id") & "' title='" & Rs("title") & "'><img src='" & Rs("images") & "' width='" & Newasp.TempSet(18) & "' height='" & Newasp.TempSet(19) & "' border='0'></A>"
			End If
			HtmlString = images
		End If
		Rs.Close
		Set Rs = Nothing
		SingleImage = HtmlString
	End Function
	'*************************************************************
	'函数作用：当然位置
	'*************************************************************
	Private Function NowStation(classid, ClassName, ParentID, strParent)
		Dim Rs, SQL, HtmlString
		Set Rs = Server.CreateObject("adodb.recordset")
		If ParentID <> 0 And Len(strParent) <> 0 Then
			SQL = "select classid,ClassName from [NC_Class] where classid in(" & strParent & ")"
			Rs.Open SQL, Conn, 1, 1
			If Not (Rs.EOF And Rs.bof) Then
				Do While Not Rs.EOF
					If CInt(Newasp.Setting(5)) = 0 Then
						HtmlString = HtmlString & "<a href='" & Newasp.SetupDir & "Listing/Catalog" & Rs(0) & "/Listing_indate_Desc_1.html'>" & Rs(1) & "</a>→"
					Else
						HtmlString = HtmlString & "<a href='?classid=" & Rs(0) & "'>" & Rs(1) & "</a>→"
					End If
					Rs.movenext
				Loop
			End If
			Rs.Close
			Set Rs = Nothing
		End If
		If CInt(Newasp.Setting(5)) = 0 Then
			HtmlString = HtmlString & "<a href='" & Newasp.SetupDir & "Listing/Catalog" & classid & "/Listing_indate_Desc_1.html'>" & ClassName & "</a>"
		Else
			HtmlString = HtmlString & "<a href='?classid=" & classid & "'>" & ClassName & "</a>"
		End If
		NowStation = HtmlString
	End Function
	'*************************************************************
	'函数作用：文章分类
	'*************************************************************
	Private Function ArticleClass(classid, ParentID, Child)
		Dim Rs, SQL, HtmlString, ClassName, ListingName
		Set Rs = Server.CreateObject("adodb.recordset")
		HtmlString = Newasp.TempSet(1)
		If classid = "" Then
			SQL = "SELECT classid,ClassName,rootid,Child,ArticleNum,Readme FROM NC_Class where depth=0 order by rootid"
		Else
			If Child = 0 Then
				SQL = "SELECT classid,ClassName,rootid,Child,ArticleNum,Readme FROM NC_Class where Parentid=" & ParentID & " order by orders"
			Else
				SQL = "SELECT classid,ClassName,rootid,Child,ArticleNum,Readme FROM NC_Class where Parentid=" & classid & " order by orders"
			End If
		End If
		Rs.Open SQL, Conn, 1, 1
		If Rs.EOF And Rs.bof Then
			HtmlString = HtmlString & "<p align=center>还没有任何分类！</p>"
		Else
			Do While Not Rs.EOF
				HtmlString = HtmlString & Newasp.TempSet(2)

				If CStr(Rs("classid")) = CStr(classid) Then
					ListingName = "<A href='" & Newasp.SetupDir & "Listing/Catalog" & Rs("classid") & "/Listing_indate_Desc_1.html' class=ShowLink><B><FONT color=red>" & Rs("ClassName") & "</font></B></a>"
					ClassName = "<A href='?classid=" & Rs("classid") & "' class=ShowLink><B><FONT color=red>" & Rs("ClassName") & "</font></B></a>"
				Else
					ListingName = "<A href='" & Newasp.SetupDir & "Listing/Catalog" & Rs("classid") & "/Listing_indate_Desc_1.html'  title='" & Rs("Readme") & "<BR>共有文章： " & Rs("ArticleNum") & " 篇'>" & Rs("ClassName") & "</a>"
					ClassName = "<A href='?classid=" & Rs("classid") & "'  title='" & Rs("Readme") & "<BR>共有文章： " & Rs("ArticleNum") & " 篇'>" & Rs("ClassName") & "</a>"
				End If
				If CInt(Newasp.Setting(5)) = 0 Then
					HtmlString = Replace(HtmlString, "{$ClassName}", ListingName)
				Else
					HtmlString = Replace(HtmlString, "{$ClassName}", ClassName)
				End If
				HtmlString = Replace(HtmlString, "{$ArticleNum}", Rs("ArticleNum"))
				Rs.movenext
			Loop
		End If
		HtmlString = HtmlString & Newasp.TempSet(3)
		Rs.Close
		Set Rs = Nothing
		ArticleClass = HtmlString
	End Function
	'*************************************************************
	'函数作用：HTML分页
	'*************************************************************
	Private Function HtmlShowPage(classid, ClassName, maxperpage, CurrentPage, totalnumber, strOrder)
		Dim n, HtmlString, ii
		If totalnumber Mod maxperpage = 0 Then
			n = totalnumber \ maxperpage
		Else
			n = totalnumber \ maxperpage + 1
		End If
		HtmlString = "<table cellspacing=1 width='100%' border=0><form method=Post onChange=""submit()""><tr><td align=center> " & vbCrLf
		HtmlString = HtmlString & "<font color='red'>" & ClassName & "</font> "
		If CurrentPage < 2 Then
			HtmlString = HtmlString & "共有 <font COLOR=#FF0000><strong>" & totalnumber & "</strong></font> 个&nbsp;首 页&nbsp;上一页&nbsp;"
		Else
			HtmlString = HtmlString & "共有 <font COLOR=#FF0000><strong>" & totalnumber & "</strong></font> 个&nbsp;<a href=Listing_" & strOrder & "_Desc_1.html>首 页</a>&nbsp;"
			HtmlString = HtmlString & "<a href=Listing_" & strOrder & "_Desc_" & CurrentPage - 1 & ".html>上一页</a>&nbsp;"
		End If
		If n - CurrentPage < 1 Then
			HtmlString = HtmlString & "下一页&nbsp;尾 页" & vbCrLf
		Else
			HtmlString = HtmlString & "<a href=Listing_" & strOrder & "_Desc_" & (CurrentPage + 1) & ".html>下一页</a>"
			HtmlString = HtmlString & "&nbsp;<a href=Listing_" & strOrder & "_Desc_" & n & ".html>尾 页</a>" & vbCrLf
		End If
		HtmlString = HtmlString & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
		HtmlString = HtmlString & "&nbsp;转到："
		HtmlString = HtmlString & "<select name='page' size='1' style=""font-size: 9pt"" onChange='javascript:window.open(this.options[this.selectedIndex].value,""_top"")'>" & vbCrLf
		For ii = 1 To n
			HtmlString = HtmlString & "&nbsp;<option value='Listing_" & strOrder & "_Desc_" & ii & ".html' "
			If CurrentPage = CInt(ii) Then
				HtmlString = HtmlString & "selected "
			End If
			HtmlString = HtmlString & ">第" & ii & "页</option>"
		Next
		HtmlString = HtmlString & "&nbsp;</select> " & vbCrLf
		HtmlString = HtmlString & "</td></tr></FORM></table>" & vbCrLf
		HtmlShowPage = HtmlString
	End Function
	'*************************************************************
	'函数作用：ASP分页
	'*************************************************************
	Private Function AspShowPage(ClassName, maxperpage, CurrentPage, totalnumber)
		Dim n, HtmlString
		If totalnumber Mod maxperpage = 0 Then
			n = totalnumber \ maxperpage
		Else
			n = totalnumber \ maxperpage + 1
		End If
		HtmlString = "<table cellspacing=1 width='100%' border=0><form method=Post action=?classid=" & Request("classid") & "&order=" & Request("order") & "><tr><td align=center> " & vbCrLf
		HtmlString = HtmlString & "<font color='red'>" & ClassName & "</font> "
		If CurrentPage < 2 Then
			HtmlString = HtmlString & "共有 <font COLOR=#FF0000><strong>" & totalnumber & "</strong></font> 篇&nbsp;首 页&nbsp;上一页&nbsp;"
		Else
			HtmlString = HtmlString & "共有 <font COLOR=#FF0000><strong>" & totalnumber & "</strong></font> 篇&nbsp;<a href=?page=1&classid=" & Request("classid") & "&order=" & Request("order") & ">首 页</a>&nbsp;"
			HtmlString = HtmlString & "<a href=?page=" & CurrentPage - 1 & "&classid=" & Request("classid") & "&order=" & Request("order") & ">上一页</a>&nbsp;"
		End If
		If n - CurrentPage < 1 Then
			HtmlString = HtmlString & "下一页&nbsp;尾 页" & vbCrLf
		Else
			HtmlString = HtmlString & "<a href=?page=" & (CurrentPage + 1) & "&classid=" & Request("classid") & "&order=" & Request("order") & ">下一页</a>"
			HtmlString = HtmlString & "&nbsp;<a href=?page=" & n & "&classid=" & Request("classid") & "&order=" & Request("order") & ">尾 页</a>" & vbCrLf
		End If
		HtmlString = HtmlString & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
		HtmlString = HtmlString & "&nbsp;转到："
		HtmlString = HtmlString & "<input name=page size=3> <input type=submit name=Submit value='GO'>"
		HtmlString = HtmlString & "</td></tr></FORM></table>" & vbCrLf
		AspShowPage = HtmlString
	End Function

	Private Sub CreateMain()
		Dim SQL, Rss, ClassTotal
		SQL = "select count(classid) from [NC_Class]"
		Rss = Newasp.Execute(SQL)
		ClassTotal = Rss(0)
		Response.Write "<table width=""98%"" border=""0"" align=""center"" cellpadding=""5"" cellspacing=""1"" class=""tableBorder"">" & vbCrLf
		Response.Write "    <tr>" & vbCrLf
		Response.Write "      <th colspan=""2"">批量生成文章列表的HTML页</th></tr>" & vbCrLf
		Response.Write "    <tr>" & vbCrLf
		Response.Write "      <td class=forumrow height=""32"" style=""LINE-HEIGHT: 150%; font-size: 10pt;"" colspan=""2"">" & vbCrLf
		If Request("type") = "ok" Then
			Response.Write "<b>操作完成:共生成文章列表<font color=""#FF0000"">" & Request("num") & "</font>个,共有分类<font color=""#FF0000"">" & ClassTotal & "</font>个,总费时<font color=""#FF0000"">" & FormatNumber((Timer() - Request("D")), 2) & "</font>秒,完成时间" & Now() & "</b>" & vbCrLf
		End If
		Response.Write "</td>" & vbCrLf
		Response.Write "    <tr>" & vbCrLf
		Response.Write "      <td class=forumrow height=""32"" style=""LINE-HEIGHT: 150%; font-size: 9pt;"" colspan=""2"">" & vbCrLf
		Response.Write "<font color=""#FF0000"">说明：</font><BR>" & vbCrLf
		Response.Write "　　本系统提供以下几种文章列表排序方式，根据文章数量及服务器性能不同，生成的时间也不同，建议每次先按时间排序生成。" & vbCrLf
		Response.Write "</td>" & vbCrLf
		Response.Write "</tr>" & vbCrLf
		Response.Write "    <tr><form name=""myform"" method=""post"" action=""?action=Create"">" & vbCrLf
		Response.Write "      <td class=forumrow height=""25"" width=""15%"" align=""center""><input type=radio name=order value=""Indate"" checked></td>" & vbCrLf
		Response.Write "      <td class=forumrow width=""85%"">按 整理时间 排序 生成HTML页</td>" & vbCrLf
		Response.Write "    </tr>" & vbCrLf
		Response.Write "    <tr>" & vbCrLf
		Response.Write "      <td class=forumrow height=""22"" align=""center""><input type=radio name=order value=""Title""></td>" & vbCrLf
		Response.Write "      <td class=forumrow>按 文章名称 排序 生成HTML页</td>" & vbCrLf
		Response.Write "    </tr>" & vbCrLf
		Response.Write "    <tr>" & vbCrLf
		Response.Write "      <td class=forumrow height=""22"" align=""center""><input type=radio name=order value=""Hits""></td>" & vbCrLf
		Response.Write "      <td class=forumrow>按 浏览次数 排序 生成HTML页</td>" & vbCrLf
		Response.Write "    </tr>" & vbCrLf
		Response.Write "    <tr>" & vbCrLf
		Response.Write "      <td class=forumrow height=""22""></td>" & vbCrLf
		Response.Write "      <td class=forumrow><input type=""submit"" class=button name=""Submit"" value=""生成HTML页""> " & vbCrLf
		Response.Write " <input type=""checkbox"" name=""type"" checked value=""all""> 选择生成全部，否则只生成更新过的分类" & vbCrLf
		Response.Write "</td></form>" & vbCrLf
		Response.Write "    </tr>" & vbCrLf
		Response.Write "    <tr><form name=myform method=""post"" action=""?action=Create&seid=1"">" & vbCrLf
		Response.Write "      <td class=forumrow height=""22"">按分类ID生成</td>" & vbCrLf
		Response.Write "      <td class=forumrow>开始ID：<input size=6 name=""StartID"" value=""1"">　结束ID：<input size=6 name=""EndID"" value=""10""> 　<input type=""submit"" name=""Submit"" class=button value=""生成HTML页""></td>" & vbCrLf
		Response.Write "    </tr></form> " & vbCrLf
		Response.Write " <tr>"
		Response.Write " <td colspan=""2"" align=""center"" noWrap class=forumrow height=""22"">"
		Response.Write " <input type=""button"" class=button name=""Submit1"" onclick=""javascript:location.href='Create_ArticleIndex.Asp'"" value=""生成文章首页"">"
		Response.Write " <input type=""button"" class=button name=""Submit4"" onclick=""javascript:location.href='Create_HotArticle.Asp'"" value=""生成热门文章"">"
		Response.Write " <input type=""button"" class=button name=""Submit4"" onclick=""javascript:location.href='Create_NewArticle.Asp'"" value=""生成更新文章"">"
		Response.Write " <input type=""button"" class=button name=""Submit5"" onclick=""javascript:location.href='Create_HotTopJs.asp'"" value=""生成排行JS"">"
		Response.Write "</td>"
		Response.Write " </tr>"
		Response.Write "    <tr>" & vbCrLf
		Response.Write "      <td align=""center"" class=forumrow height=""22"" style=""LINE-HEIGHT: 150%; font-size: 10pt;"" colspan=""2"">" & vbCrLf
		Response.Write " (共有 <font color=""#FF3300""><B>" & ClassTotal & "</B></font> 页)" & vbCrLf
		Response.Write "</td>" & vbCrLf
		Response.Write "</tr></table>" & vbCrLf
	End Sub

	Private Sub CreateListingHtml()
		If CLng(Request.Form("StartID")) > CLng(Request.Form("EndID")) Then Response.Write ("<script>alert('对不起!你输入的开始ID比结束ID大，请重新输入。');history.go(-1)</script>")
		Response.Write "<b><font color=""#FF0000"">  正在生成文章列表的HTML页, 此操作可能要持续几分钟，请稍候......</font></b><BR>" & vbCrLf
		Response.Write "<table width=""400"" border=""0"" cellspacing=""1"" cellpadding=""1"">" & vbCrLf
		Response.Write "<tr> " & vbCrLf
		Response.Write "<td bgcolor=000000>" & vbCrLf
		Response.Write " <table width=""400"" border=""0"" cellspacing=""0"" cellpadding=""1"">" & vbCrLf
		Response.Write "<tr> " & vbCrLf
		Response.Write "<td bgcolor=ffffff height=9><img src=""images/bar9.gif"" width=0 height=16 id=img2 name=img2 align=absmiddle></td></tr></table>" & vbCrLf
		Response.Write "</td></tr></table></td></tr><tr> " & vbCrLf
		Response.Write "<td align=center bgcolor=000000> <span id=txt2 name=txt2 style=""font-size:9pt"">0</span><span style=""font-size:9pt"">%</span>  <span id=txt3 name=txt3 style=""font-size:9pt"">0</span></td></tr>" & vbCrLf
		Response.Write "</table>" & vbCrLf
		Response.Flush
		Dim totalnumber, Rs, SQL, i
		Set Rs = Server.CreateObject("adodb.recordset")
		If Request("seid") = 1 Then
			SQL = "select classid,ClassName,ArticleNum from [NC_Class] where classid >= " & Request.Form("StartID") & " and classid <= " & Request.Form("EndID") & ""
		Else
			If Request("type") = "all" Then
				SQL = "select classid,ClassName,ArticleNum from [NC_Class] order by classid asc"
			Else
				SQL = "select classid,ClassName,ArticleNum from [NC_Class] where isUpdate = 1 order by classid asc"
			End If
		End If
		Rs.Open SQL, Conn, 1, 1
		If Rs.EOF And Rs.bof Then
			Response.Write "Sorry！没有找到任何分类。或者分类没有更新!"

		Else
			totalnumber = Rs.recordcount
			i = 1
			Do While Not Rs.EOF
				CreateArticleList Rs("classid"), Request("order")
				Conn.Execute ("update NC_Class set isUpdate = 0 where classid=" & Rs("classid"))
				Response.Write "<script>img2.width=" & Fix((i / totalnumber) * 400) & ";" & vbCrLf
				Response.Write "txt2.innerHTML=""生成进度：" & FormatNumber(i / totalnumber * 100, 2, -1) & """;" & vbCrLf
				Response.Write "txt3.innerHTML=""　　共有分类 <B><font color=RED>" & totalnumber & "</font></B> 个 　正在生成第 " & i & " 个"";" & vbCrLf
				Response.Write "img2.title=""(" & i & ")"";</script>" & vbCrLf
				Response.Flush
				Response.Write "<table cellpadding=0 cellspacing=0 border=0 width=90% align=center><tr><td colspan=2 class=forumrow> 　生成文章列表 [" & Rs(1) & "] 完成； 共有文章 [" & Rs(2) & "] 个。</td></tr></table>"
				Response.Flush
				Rs.movenext
				i = i + 1
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		Response.Write "<script>img2.width=400;txt2.innerHTML=""100"";</script>"
		Response.Write "<meta http-equiv=""refresh"" content=""1;url='?num=" & totalnumber & "&D=" & d & "&order=" & Request("order") & "&type=ok'"">"
	End Sub
End Class
%>