create_sortingcls.asp

多用户管理分权限发布、管理软件信息； 自由选择系统默认为静态HTML或动态ASP； 无限制添加下载服务器

		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=""Name""></td>" & vbCrLf
		Response.Write "      <td class=forumrow>按 软件名称 排序 生成HTML页</td>" & vbCrLf
		Response.Write "    </tr>" & vbCrLf
		Response.Write "    <tr>" & vbCrLf
		Response.Write "      <td class=forumrow height=""25"" align=""center""><input type=radio name=order value=""Size""></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_Index.Asp'"" value=""生成下载首页"">"
		Response.Write " <input type=""button"" class=button name=""Submit2"" onclick=""javascript:location.href='Create_LateNew.Asp'"" value=""生成更新软件"">"
		Response.Write " <input type=""button"" class=button name=""Submit3"" onclick=""javascript:location.href='Create_Commend.Asp'"" value=""生成推荐软件"">"
		Response.Write " <input type=""button"" class=button name=""Submit4"" onclick=""javascript:location.href='Create_HotSoft.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>" & SoftTotal & "</B></font> 页)" & vbCrLf
		Response.Write "</td>" & vbCrLf
		Response.Write "</tr></table>" & vbCrLf
	End Sub

	Private Sub CreateSortingHtml()
		If CLng(Request.Form("StartID")) > CLng(Request.Form("EndID")) Then
			Response.Write ("<script>alert('对不起!你输入的开始ID比结束ID大，请重新输入。');history.go(-1)</script>")
			Exit Sub
		End If
		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 sortid,SortName,SoftNum from [NC_softsort] where sortid >= " & Request.Form("StartID") & " and sortid <= " & Request.Form("EndID") & ""
		Else
			If Request("type") = "all" Then
				SQL = "select sortid,SortName,SoftNum from [NC_softsort] order by sortid asc"
			Else
				SQL = "select sortid,SortName,SoftNum from [NC_softsort] where isUpdate = 1 order by sortid 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
				CreateSortList Rs("sortid"), Request("order")
				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

	Private Function CreateSortList(sortid, orders)
		Dim HtmlString, i, TopImg, isCommend, SoftImg
		Dim SoftName, SoftReadme, SoftTime, SoftSize
		Dim Rs, SQL
		Conn.Execute ("update NC_SoftSort set isUpdate = 0 where sortid=" & sortid)
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select sortid,sortname,rootid,depth,ParentID,strParent,Child from [NC_SoftSort] where sortid = " & sortid
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			Response.Write "Sorry！没有找到任何软件信息。或者您选择了错误的系统参数!"
			Response.End
		Else
			SortName = Rs("sortname")
			sortid = Rs("sortid")
			rootid = Rs("rootid")
			depth = Rs("depth")
			ParentID = Rs("ParentID")
			strParent = Rs("strParent")
			Child = Rs("Child")
			CreateNewFolder (sortid)
		End If
		Rs.Close
		order_name = orders
		strOrder = orders
		Select Case order_name
			Case "Name"
				order_name = "SoftName"
			Case "Indate"
				order_name = "SoftTime"
			Case "Size"
				order_name = "SoftSize"
			Case "Hits"
				order_name = "Hits"
			Case Else
				order_name = "SoftTime"
				strOrder = "Indate"
		End Select
		Dim temphtml, NowStats, HtmlTitle
		Dim TempTopStr, TempFootStr, Style_CSS
		If Len(sortid) = 0 Then
			NowStats = SortName
		Else
			NowStats = NowStation(sortid, SortName, ParentID, strParent)
		End If
		HtmlTitle = SortName
		If Len(Newasp.temphtml(0)) < 50 Then
			TempTopStr = Newasp.mainhtml(0) & Newasp.mainhtml(1) & Newasp.mainhtml(2) & Newasp.mainhtml(3)
		Else
			TempTopStr = Newasp.temphtml(0)
		End If
		If Len(Newasp.temphtml(4)) = 0 Then
			TempFootStr = Newasp.mainhtml(4)
		Else
			TempFootStr = Newasp.temphtml(4)
		End If
		Style_CSS = Replace(Replace(Newasp.Style_CSS, "{$SetupDir}", Newasp.SetupDir), "{$PicUrl}", Newasp.TempDir)
		temphtml = TempTopStr & Newasp.temphtml(1) & Newasp.temphtml(2) & Newasp.temphtml(3) & TempFootStr
		temphtml = Replace(temphtml, "{$NavMenu}", Newasp.SortingMenu)
		temphtml = Replace(temphtml, "{$Width}", Newasp.mainset(0))
		temphtml = Replace(temphtml, "{$Style_CSS}", Style_CSS)
		If CInt(Newasp.Setting(5)) = 0 Then
			temphtml = Replace(temphtml, "{$TopMeun}", Newasp.mainset(9))
		Else
			temphtml = Replace(temphtml, "{$TopMeun}", Newasp.mainset(10))
		End If
		temphtml = Replace(temphtml, "{$FootMeun}", Newasp.mainset(11))
		temphtml = Replace(temphtml, "{$NowStats}", NowStats)
		temphtml = Replace(temphtml, "{$Title}", HtmlTitle)
		temphtml = Replace(temphtml, "{$SortID}", sortid)
		temphtml = Replace(temphtml, "{$Sorting}", SoftSorting(sortid, ParentID, Child))

		temphtml = Replace(temphtml, "{$Adcolumn(0)}", NewCloud_Ads.RunScriptAds(2))
		temphtml = Replace(temphtml, "{$Adcolumn(1)}", NewCloud_Ads.BannerAds(2))
		temphtml = Replace(temphtml, "{$Adcolumn(2)}", NewCloud_Ads.AdsColumn(2, 2))
		temphtml = Replace(temphtml, "{$Adcolumn(3)}", NewCloud_Ads.AdsColumn(2, 3))
		temphtml = Replace(temphtml, "{$Adcolumn(6)}", NewCloud_Ads.AdsColumn(2, 7))
		temphtml = Replace(temphtml, "{$Adcolumn(4)}", NewCloud_Ads.ScriptFloatAds(2))
		temphtml = Replace(temphtml, "{$Adcolumn(5)}", NewCloud_Ads.ScriptFixedAds(2))

		If depth = 0 Then
			SQL = "select * from NC_softinfo where isLock=0 and rootid = " & rootid & " order by isTop Desc, " & order_name & " Desc, softid Desc"
		Else
			Dim Rss, AllSortID, ParentStr
			Set Rss = Newasp.Execute("select * from NC_SoftSort where strParent like '%"& sortid &"%'")
			If Rss.EOF And Rss.bof Then
				AllSortID = sortid
			Else
				Do While Not Rss.EOF
					ParentStr = Split(Rss("strParent"), ",")
					For i = 0 To UBound(ParentStr)
						If CLng(ParentStr(i)) = sortid Then
							AllSortID = AllSortID & Rss("sortid") &","
							Exit For
						End If
					Next
					Rss.movenext
				Loop
				AllSortID = AllSortID & sortid
			End If
			Rss.Close
			Set Rss = Nothing
			SQL = "select * from NC_softinfo where isLock=0 and sortid in (" & AllSortID & ") order by isTop Desc, " & order_name & " Desc, softid Desc"
		End If
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			HtmlString = "<p align=center>还没有找到任何软件！</p>"
			HtmlTemplate = temphtml
			HtmlTemplate = Replace(HtmlTemplate, "{$SortingList}", HtmlString)
			CreateHtmlFile sortid, strOrder, 1, HtmlTemplate
		Else

			totalnumber = Rs.recordcount
			If (totalnumber Mod maxperpage) = 0 Then
				Pcount = totalnumber \ maxperpage
			Else
				Pcount = totalnumber \ maxperpage + 1
			End If
			For CurrentPage = 1 To Pcount
				Rs.MoveFiRst
				If CurrentPage > Pcount Then CurrentPage = Pcount
				Rs.Move (CurrentPage - 1) * maxperpage
				bookmark = Rs.bookmark
				i = 0
				HtmlString = Newasp.TempSet(8)
				HtmlString = Replace(HtmlString, "{$SortID}", sortid)
				Do While Not Rs.EOF And i < CInt(maxperpage)
					HtmlString = HtmlString & Newasp.TempSet(10)
					If CInt(Rs("isTop")) = 1 Then
						TopImg = "<img src='" & Newasp.SetupDir & "images/isTop.gif' align='absmiddle'>"
					Else
						TopImg = "<img src='" & Newasp.SetupDir & "images/arrow.gif' align='absmiddle'>"
					End If
					If CInt(Rs("isCommend")) = 0 Then
						isCommend = ""
					Else
						isCommend = "<font color=red>推荐</font>"
					End If
					If CInt(Newasp.Setting(5)) = 0 Then
						SoftName = "" & TopImg & " <A HREF='" & Newasp.SetupDir & "Software/Catalog" & Rs("sortid") & "/" & Rs("softid") & ".html'>" & Trim(Rs("softname")) & " " & Trim(Rs("softver")) & "</a> " & isCommend & ""
					Else
						SoftName = "" & TopImg & " <A HREF='" & Newasp.SetupDir & "Software.asp?id=" & Rs("softid") & "'>" & Trim(Rs("softname")) & " " & Trim(Rs("softver")) & "</a> " & isCommend & ""
					End If
					If Rs("SoftTime") >= Date Then
						SoftTime = "<FONT color=red>" & FormatDateTime(Rs("SoftTime"), 2) & "</FONT >"
					Else
						SoftTime = FormatDateTime(Rs("SoftTime"), 2)
					End If
					If Rs("SoftSize") > 1024 Then
						SoftSize = Round(Rs("SoftSize") / 1024, 2) & " MB"
					Else
						SoftSize = Rs("SoftSize") & " KB"
					End If
					If Not IsNull(Trim(Rs("softimg"))) And Trim(Rs("softimg")) <> "" Then
						If CInt(Newasp.Setting(5)) = 0 Then
							SoftImg = "<A HREF='" & Newasp.SetupDir & "Software/Catalog" & Rs("sortid") & "/" & Rs("softid") & ".html'><img src='" & Rs("softimg") & "' width='" & Newasp.mainset(41) & "' height='" & Newasp.mainset(42) & "' border='0'></a> "
						Else
							SoftImg = "<A HREF='" & Newasp.SetupDir & "Software.asp?id=" & Rs("softid") & "'><img src='" & Rs("softimg") & "' width='" & Newasp.mainset(41) & "' height='" & Newasp.mainset(42) & "' border='0'></a> "
						End If
					Else
						SoftImg = "<img src=""" & Newasp.SetupDir & "images/NoPic.jpg"" width='" & Newasp.mainset(41) & "' height='" & Newasp.mainset(42) & "' border=0>"
					End If
					SoftReadme = Newasp.CutString(Rs("content"), CInt(Newasp.TempSet(7)))
					HtmlString = Replace(HtmlString, "{$SoftName}", SoftName)
					HtmlString = Replace(HtmlString, "{$SoftReadme}", SoftReadme)
					HtmlString = Replace(HtmlString, "{$SoftTime}", SoftTime)
					HtmlString = Replace(HtmlString, "{$SoftSize}", SoftSize)
					HtmlString = Replace(HtmlString, "{$Hits}", Rs("Hits"))
					HtmlString = Replace(HtmlString, "{$RunSystem}", Rs("RunSystem"))
					'HtmlString = Replace(HtmlString, "{$Impower}", Rs("impower"))
					HtmlString = Replace(HtmlString, "{$Grades}", Rs("Grades"))
					HtmlString = Replace(HtmlString, "{$SoftImg}", SoftImg)
					Rs.movenext
					i = i + 1
					If i >= maxperpage Then Exit Do
				Loop
				HtmlString = HtmlString & Newasp.TempSet(11)
				ShowPageHtml = HtmlShowPage(sortid, SortName, maxperpage, CInt(CurrentPage), totalnumber, strOrder)
				HtmlString = Replace(HtmlString, "{$ShowPage}", ShowPageHtml)
				HtmlTemplate = temphtml
				HtmlTemplate = Replace(HtmlTemplate, "{$SortingList}", HtmlString)