create_listingcls.asp

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

		End If
		Rs.Close

		order_name = orders
		strOrder = orders
		Select Case order_name
			Case "Title"
				order_name = "title"
			Case "Indate"
				order_name = "InfoTime"
			Case "Hits"
				order_name = "Hits"
			Case Else
				order_name = "InfoTime"
				strOrder = "Indate"
		End Select
		Dim temphtml, NowStats, HtmlTitle, ArticleIndex
		Dim TempTopStr, TempFootStr, Style_CSS
		ArticleIndex = "<A HREF='" & Newasp.SetupDir & "Article/index.html'>" & Newasp.TempSet(10) & "</A>→"
		NowStats = ArticleIndex & NowStation(classid, ClassName, ParentID, strParent)
		HtmlTitle = ClassName
		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
		temphtml = TempTopStr & Newasp.temphtml(1) & Newasp.temphtml(2) & Newasp.temphtml(3) & TempFootStr
		temphtml = Replace(temphtml, "{$NavMenu}", Newasp.ClassMenu)
		temphtml = Replace(temphtml, "{$Width}", Newasp.mainset(0))
		temphtml = Replace(temphtml, "{$TopMeun}", Newasp.mainset(9))
		temphtml = Replace(temphtml, "{$FootMeun}", Newasp.mainset(11))
		temphtml = Replace(temphtml, "{$Style_CSS}", Newasp.Style_CSS)
		temphtml = Replace(temphtml, "{$NowStats}", NowStats)
		temphtml = Replace(temphtml, "{$Title}", HtmlTitle)
		temphtml = Replace(temphtml, "{$ClassID}", classid)
		temphtml = Replace(temphtml, "{$ArticleClass}", ArticleClass(classid, ParentID, Child))
		temphtml = Replace(temphtml, "{$BestArticle}", BestArticle)
		temphtml = Replace(temphtml, "{$PicNews}", PictureNews)
		temphtml = Replace(temphtml, "{$NewPic}", SingleImage("InfoTime"))
		temphtml = Replace(temphtml, "{$HotPic}", SingleImage("Hits"))
		temphtml = Replace(temphtml, "{$Adcolumn(0)}", NewCloud_Ads.RunScriptAds(5))
		temphtml = Replace(temphtml, "{$Adcolumn(1)}", NewCloud_Ads.BannerAds(5))
		temphtml = Replace(temphtml, "{$Adcolumn(2)}", NewCloud_Ads.AdsColumn(5, 2))
		temphtml = Replace(temphtml, "{$Adcolumn(3)}", NewCloud_Ads.AdsColumn(5, 3))
		temphtml = Replace(temphtml, "{$Adcolumn(6)}", NewCloud_Ads.AdsColumn(5, 7))
		temphtml = Replace(temphtml, "{$Adcolumn(4)}", NewCloud_Ads.ScriptFloatAds(5))
		temphtml = Replace(temphtml, "{$Adcolumn(5)}", NewCloud_Ads.ScriptFixedAds(5))

		If depth = 0 Then
			SQL = "select * from NC_Article where isLock=0 and rootid = " & rootid & " order by isTop Desc, " & order_name & " Desc, ID Desc"
		Else
			Dim Rs_c, AllClassID, ParentStr
			Set Rs_c = Newasp.Execute("select * from NC_Class where strParent like '%"& classid &"%'")
			If Rs_c.EOF And Rs_c.bof Then
				AllClassID = classid
			Else
				Do While Not Rs_c.EOF
					ParentStr = Split(Rs_c("strParent"), ",")
					For i = 0 To UBound(ParentStr)
						If CLng(ParentStr(i)) = classid Then
							ParentStr = ParentStr & Rs_c("classid") &","
						End If
					Next
					Rs_c.movenext
				Loop
				AllClassID = AllClassID & classid
			End If
			Rs_c.Close
			 Set Rs_c = Nothing
			SQL = "select * from NC_Article where isLock=0 and classid in (" & AllClassID & ") order by isTop Desc, " & order_name & " Desc, ID 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, "{$ArticleList}", HtmlString)
			CreateHtmlFile classid, 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
				j = (CurrentPage - 1) * maxperpage + 1
				HtmlString = Newasp.TempSet(12)
				HtmlString = Replace(HtmlString, "{$ClassID}", classid)
				Do While Not Rs.EOF And i < CInt(maxperpage)
					HtmlString = HtmlString & Newasp.TempSet(14)
					If CInt(Rs("isTop")) = 1 Then
						Icon = "<img src='" & Newasp.SetupDir & "images/isTop.gif' align='absmiddle'>"
					Else
						Icon = "<img src='" & Newasp.SetupDir & Newasp.TempDir & "icon2.gif' align='absmiddle'>"
					End If
					If CInt(Rs("isCommend")) = 0 Then
						isCommend = ""
					Else
						isCommend = Newasp.TempSet(16)
					End If
					If CInt(Newasp.Setting(5)) = 0 Then
						Title = "<A HREF='" & Newasp.SetupDir & "Article/Catalog" & Rs("classid") & "/" & Rs("ID") & ".html'>" & Trim(Rs("Title")) & "</a> "
					Else
						Title = "<A HREF='" & Newasp.SetupDir & "Article.Asp?id=" & Rs("ID") & "'>" & Trim(Rs("Title")) & "</a> "
					End If
					If Rs("InfoTime") >= Date Then
						InfoTime = "<FONT color=red>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
					Else
						InfoTime = FormatDateTime(Rs("InfoTime"), 2)
					End If
					HtmlString = Replace(HtmlString, "{$Title}", Title)
					HtmlString = Replace(HtmlString, "{$InfoTime}", InfoTime)
					HtmlString = Replace(HtmlString, "{$Hits}", Rs("Hits"))
					HtmlString = Replace(HtmlString, "{$Commend}", isCommend)
					HtmlString = Replace(HtmlString, "{$Icon}", Icon)
					HtmlString = Replace(HtmlString, "{$Sequence}", j)
					Rs.movenext
					i = i + 1
					j = j + 1
				Loop
				HtmlString = HtmlString & Newasp.TempSet(15)
				ShowPageHtml = HtmlShowPage(classid, ClassName, maxperpage, CurrentPage, totalnumber, strOrder)
				HtmlString = Replace(HtmlString, "{$ShowPage}", ShowPageHtml)
				HtmlTemplate = temphtml
				HtmlTemplate = Replace(HtmlTemplate, "{$ArticleList}", HtmlString)
				CreateHtmlFile classid, strOrder, CurrentPage, HtmlTemplate
			Next
		End If
		Rs.Close
		Set Rs = Nothing

	End Function
	'*************************************************************
	'函数作用：生成HTML文件
	'*************************************************************
	Private Function CreateHtmlFile(classid, strOrder, CurrentPage, HtmlTemplate)
		Dim CreateHtml, FSO, Fout, CreatePath
		Set FSO = Server.CreateObject(Newasp.Script_FSO)
		CreatePath = "" & Newasp.SetupDir & "Listing/Catalog" & classid & "/Listing_" & strOrder & "_Desc_" & CurrentPage & ".html"
		CreateHtml = Server.MapPath(CreatePath)
		Set Fout = FSO.CreateTextFile(CreateHtml)
		Fout.WriteLine HtmlTemplate
		Fout.Close
		Set Fout = Nothing
		Set FSO = Nothing
	End Function
	'*************************************************************
	'函数作用：按分类ID生成文件目录
	'*************************************************************
	Private Function CreateNewFolder(FolderID)
		Dim FSO, FolderPath
		If CInt(Newasp.Setting(5)) = 1 Then Exit Function
		FolderPath = Newasp.SetupDir & "Listing/Catalog" & FolderID
		Set FSO = Server.CreateObject(Newasp.Script_FSO)
		If FSO.FolderExists(Server.MapPath(FolderPath)) = False Then
			FSO.CreateFolder Server.MapPath(FolderPath)
		End If
		Set FSO = Nothing
	End Function
	'*************************************************************
	'函数作用：推荐文章
	'*************************************************************
	Private Function BestArticle()
		Dim Rs, SQL, HtmlString, ArticleTitle, ClassName, InfoTime, InfoDate
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select Top " & CInt(Newasp.TempSet(4)) & " id,classid,Title, ClassName,InfoTime,Hits,isTop from NC_Article where isLock = 0 And isCommend = 1 order by isTop desc, InfoTime desc, id desc"
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			HtmlString = "还没有推荐文章!"
		Else
			Do While Not Rs.EOF
				If Rs("InfoTime") >= Date Then
					InfoTime = "<FONT color=red>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
					InfoDate = "<FONT color=red>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
				Else
					InfoTime = "<FONT color=#999999>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
					InfoDate = "<FONT color=#999999>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
				End If
				If CInt(Newasp.Setting(5)) = 0 Then
					ArticleTitle = "<A HREF='" & Newasp.SetupDir & "Article/Catalog" & Rs(1) & "/" & Rs(0) & ".html' title='文章标题：" & Rs(2) & "<BR>更新时间：" & Rs(4) & "<BR>浏览次数：" & Rs(5) & "' class='TableLink'>" & Newasp.gotTopic(Rs(2), CInt(Newasp.TempSet(5))) & "</A>"
					ClassName = "<A HREF='" & Newasp.SetupDir & "Listing/Catalog" & Rs(1) & "/Listing_Indate_Desc_1.html' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</A>"
				Else
					ArticleTitle = "<A HREF='" & Newasp.SetupDir & "Article.asp?id=" & Rs(0) & "' title='文章标题：" & Rs(2) & "<BR>更新时间：" & Rs(4) & "<BR>浏览次数：" & Rs(5) & "' class='TableLink'>" & Newasp.gotTopic(Rs(2), CInt(Newasp.TempSet(5))) & "</A>"
					ClassName = "<A HREF='" & Newasp.SetupDir & "Listing.asp?classid=" & Rs(1) & "' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</A>"
				End If
				HtmlString = HtmlString & Newasp.TempSet(6)
				HtmlString = Replace(HtmlString, "{$BestTopic}", ArticleTitle)
				HtmlString = Replace(HtmlString, "{$ClassName}", ClassName)
				HtmlString = Replace(HtmlString, "{$InfoTime}", InfoTime)
				HtmlString = Replace(HtmlString, "{$ArticleHits}", Rs("Hits"))
				HtmlString = Replace(HtmlString, "{$InfoDate}", InfoDate)
				Rs.movenext
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		BestArticle = HtmlString
	End Function
	'*************************************************************
	'函数作用：图文
	'*************************************************************
	Private Function PictureNews()
		Dim Rs, SQL, HtmlString, ArticleTitle, ClassName, InfoTime, InfoDate
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select Top " & CInt(Newasp.TempSet(7)) & " id,classid,Title, ClassName,InfoTime,Hits from NC_Article where isLock = 0 And isImg = 1 order by InfoTime desc, id desc"
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			HtmlString = "还没有图文信息!"
		Else
			Do While Not Rs.EOF
				If Rs("InfoTime") >= Date Then
					InfoTime = "<FONT color=red>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
					InfoDate = "<FONT color=red>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
				Else
					InfoTime = "<FONT color=#999999>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
					InfoDate = "<FONT color=#999999>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
				End If
				If CInt(Newasp.Setting(5)) = 0 Then
					ArticleTitle = "<A HREF='" & Newasp.SetupDir & "Article/Catalog" & Rs(1) & "/" & Rs(0) & ".html' title='文章标题：" & Rs(2) & "<BR>更新时间：" & Rs(4) & "<BR>浏览次数：" & Rs(5) & "' class='TableLink'>" & Newasp.gotTopic(Rs(2), CInt(Newasp.TempSet(8))) & "</A>"
					ClassName = "<A HREF='" & Newasp.SetupDir & "Listing/Catalog" & Rs(1) & "/Listing_Indate_Desc_1.html' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</A>"
				Else
					ArticleTitle = "<A HREF='" & Newasp.SetupDir & "Article.asp?id=" & Rs(0) & "' title='文章标题：" & Rs(2) & "<BR>更新时间：" & Rs(4) & "<BR>浏览次数：" & Rs(5) & "' class='TableLink'>" & Newasp.gotTopic(Rs(2), CInt(Newasp.TempSet(8))) & "</A>"
					ClassName = "<A HREF='" & Newasp.SetupDir & "Listing.asp?classid=" & Rs(1) & "' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</A>"
				End If
				HtmlString = HtmlString & Newasp.TempSet(9)
				HtmlString = Replace(HtmlString, "{$Topic}", ArticleTitle)
				HtmlString = Replace(HtmlString, "{$ClassName}", ClassName)
				HtmlString = Replace(HtmlString, "{$InfoTime}", InfoTime)
				HtmlString = Replace(HtmlString, "{$ArticleHits}", Rs("Hits"))
				HtmlString = Replace(HtmlString, "{$InfoDate}", InfoDate)
				Rs.movenext
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		PictureNews = HtmlString
	End Function

	Private Function SingleImage(orders)
		Dim Rs, SQL, HtmlString, Topic, images, OrderName
		Set Rs = Server.CreateObject("adodb.recordset")
		If orders = "Hits" Then
			OrderName = "Hits"
		Else
			OrderName = "InfoTime"
		End If
		SQL = "select Top 1 id,classid,title,images from NC_Article where isLock = 0 And images <>'' order by " & OrderName & " desc, id desc"
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			HtmlString = "<img src=""" & Newasp.SetupDir & "images/NoPic.jpg"" width='" & Newasp.TempSet(18) & "' height='" & Newasp.TempSet(19) & "' border=0>"
		Else
			If CInt(Newasp.Setting(5)) = 0 Then
				images = "<A HREF='" & Newasp.SetupDir & "Article/Catalog" & Rs("classid") & "/" & Rs("id") & ".html' title='" & Rs("title") & "'><img src='" & Rs("images") & "' width='" & Newasp.TempSet(18) & "' height='" & Newasp.TempSet(19) & "' border='0'></A>"