newschannel.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 1,462 行 · 第 1/5 页

ASP
1,462
字号
			End If
			Set rsClass = Nothing
			Exit Function
		Else
			strClassName = rsClass("ClassName")
			ClassID = rsClass("ClassID")
			ChildStr = rsClass("ChildStr")
			Child = rsClass("Child")
			strFileDir = rsClass("HtmlFileDir")
			ParentID = rsClass("ParentID")
			strParent = rsClass("ParentStr")
			If rsClass("skinid") <> 0 Then
				skinid = rsClass("skinid")
			Else
				skinid = Newasp.ChkNumeric(Newasp.ChannelSkin)
			End If
			AdsCode = rsClass("AdsCode")
			stopad = rsClass("stopad")
		End If
		rsClass.Close: Set rsClass = Nothing
		Newasp.LoadTemplates ChannelID, 2, skinid
		PageType = 1
		m_strFilePath = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, "",strFileDir,ClassID,0,1,"")
		HtmlFilePath = Newasp.HtmlFilesPath
		m_strFileDir = strFileDir
		strTemplate = Split(Newasp.HtmlContent, "|||@@@|||")
		'-- 大类列表显示方式
		showtree = Newasp.ChkNumeric(Newasp.HtmlSetting(4))
		'-- 最多列表数
		MaxListnum = Newasp.ChkNumeric(Newasp.HtmlSetting(5))
		
		strlen = Newasp.ChkNumeric(Newasp.HtmlSetting(10))
		
		ParentTemplate = strTemplate(1)
		ChildTemplate = strTemplate(0)

		If Child <> 0 And showtree <> 9 Then
			TemplateContent = ParentTemplate
		Else
			TemplateContent = ChildTemplate
		End If
		'Dim strPageTitle : strPageTitle = strClassName & Newasp.HtmlSetting(11)
		
		PageType = 1
		
		HtmlContent = TemplateContent
		'-- 新增分类广告代码
		HtmlContent = AdsReplace(HtmlContent,AdsCode, stopad)
		HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
		HtmlContent = Replace(HtmlContent, "{$ClassID}", ClassID)
		HtmlContent = Replace(HtmlContent, "{$ThisClassName}", strClassName)
		HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$ArticleIndex}", strIndexName)
		If Child <> 0 And showtree <> 9 Then
			Call LoadParentList
			Call ReplaceContent
			If CInt(CreateHtml) <> 0 Then
				'创建分类目录
				Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
				'开始生成父级分类的HTML页
				HtmlFileName = m_strFilePath
				Newasp.CreatedTextFile strBasicPath & HtmlFileName, HtmlContent
				If IsShowFlush = 1 Then Response.Write "<li style=""font-size: 12px;"">生成[<font color=""red"">" & strClassName & "</font>]分类列表HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
				Response.Flush
				MakePageDone = 1
			End If
		Else
			Call ReplaceContent
			maxperpage = Newasp.ChkNumeric(Newasp.HtmlSetting(1))
			If CLng(CurrentPage) = 0 Then CurrentPage = 1
			If Newasp.CheckStr(LCase(Request("order"))) = "hits" Then
				strOrder = "order by A.isTop desc, A.AllHits desc ,A.ArticleID desc"
			ElseIf Newasp.CheckStr(LCase(Request("order"))) = "topic" Then
				strOrder = "order by A.isTop desc, A.title desc ,A.ArticleID desc"
			Else
				strOrder = "order by A.isTop desc, A.WriteTime desc ,A.ArticleID desc"
			End If
			TotalNumber = Newasp.Execute("Select Count(ArticleID) from NC_Article where ChannelID = " & ChannelID & " And isAccept > 0 And ClassID in (" & ChildStr & ")")(0)
			totalrec = TotalNumber
			'-- 如果开启了父分类显示功能,限制显示数
			If Child > 0 And TotalNumber > MaxListnum And MaxListnum <> 999 Then
				strMaxListop = " TOP " & MaxListnum
				TotalNumber = MaxListnum
			Else
				strMaxListop = vbNullString
			End If
			
			TotalPageNum = CLng(TotalNumber / maxperpage)  '得到总页数
			If TotalPageNum < TotalNumber / maxperpage Then TotalPageNum = TotalPageNum + 1
			If CurrentPage < 1 Then CurrentPage = 1
			If CurrentPage > TotalPageNum Then CurrentPage = TotalPageNum
			Set Rs = CreateObject("ADODB.Recordset")
			SQL = "SELECT " & strMaxListop & " A.ArticleID,A.ClassID,A.BriefTopic,A.ColorMode,A.FontMode,A.title,A.content,A.Related,A.Author,A.ComeFrom,A.ImageUrl,A.isTop,A.username,A.star,A.isBest,A.WriteTime,A.Allhits,A.HtmlFileDate,C.ClassName,C.ParentID,C.ParentStr,C.skinid,C.HtmlFileDir,C.ChildStr FROM [NC_Article] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID where A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.ClassID in (" & ChildStr & ") " & strOrder & ""
			If isSqlDataBase = 1 Then
				Set Rs = Newasp.Execute(SQL)
			Else
				Rs.Open SQL, Conn, 1, 1
			End If
			If Rs.BOF And Rs.EOF Then
				HtmlContent = Replace(HtmlContent, "{$PageTitle}", strClassName)
				HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "还没有找到任何" & Newasp.ModuleName & "")
				HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
				If CreateHtml <> 0 Then
					Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
					HtmlFileName = m_strFilePath
					Newasp.CreatedTextFile strBasicPath & HtmlFileName, HtmlContent
					If IsShowFlush = 1 Then
						Response.Write "<li style=""font-size: 12px;"">生成[<font color=""red"">" & strClassName & "</font>]分类列表HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
						Response.Flush
					End If
					MakePageDone = 1
				End If
			Else
				TotalNumber = totalrec
				TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
				If CreateHtml <> 0 Then
					Call LoadChildListHtml(n)
				Else
					Call LoadChildListAsp
				End If
			End If
			Rs.Close: Set Rs = Nothing
		End If
		If CreateHtml = 0 Then CreateArticleList = HtmlContent
	End Function
	'================================================
	'过程名:ReplaceContent
	'作  用:替换模板内容
	'================================================
	Private Sub ReplaceContent()
		HtmlContent = HTML.ReadCurrentStation(HtmlContent, ChannelID, ClassID, strClassName, ParentID, strParent, strFileDir)
		HtmlContent = HTML.ReadAnnounceContent(HtmlContent, ChannelID)
		HtmlContent = ReadClassMenubar(HtmlContent)
		HtmlContent = ReadClassMenu(HtmlContent)
		HtmlContent = HTML.ReadArticlePic(HtmlContent)
		HtmlContent = HTML.ReadArticleList(HtmlContent)
		HtmlContent = HTML.ReadNewsPicAndText(HtmlContent)
		HtmlContent = HTML.ReadSoftPicAndText(HtmlContent)
		HtmlContent = HTML.ReadPopularArticle(HtmlContent)
		HtmlContent = HTML.ReadPopularSoft(HtmlContent)
		HtmlContent = HTML.ReadStatistic(HtmlContent)
		HtmlContent = HTML.ReadSoftPic(HtmlContent)
		HtmlContent = HTML.ReadSoftList(HtmlContent)
		HtmlContent = HTML.ReadFlashList(HtmlContent)
		HtmlContent = HTML.ReadFlashPic(HtmlContent)
		HtmlContent = Replace(HtmlContent, "{$CurrentClass}", HTML.CurrentClass)
		Dim strPageTitle : strPageTitle = HTML.CurrentClass & Newasp.HtmlSetting(11)
		HtmlContent = Replace(HtmlContent, "{$PageTitle}", strPageTitle)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
	End Sub
	'================================================
	'过程名:LoadParentList
	'作  用:装载父级文章列表
	'================================================
	Private Sub LoadParentList()
		Dim rsClslist, strContent, i, showtree
		Dim ClassUrl, ClassNameStr,n
		
		showtree = Trim(Newasp.HtmlSetting(4))
		PageType = 1
		TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
		If Not IsNull(TempListContent) Then
			SQL = "SELECT TOP " & CInt(Newasp.HtmlSetting(5)) & " ClassID,ClassName,HtmlFileDir FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And TurnLink = 0 And ParentID=" & ClassID & " ORDER BY orders ASC, ClassID ASC"
			Set rsClslist = Newasp.Execute(SQL)
			If rsClslist.BOF And rsClslist.EOF Then
				Set rsClslist = Nothing
				Exit Sub
			Else
				n = 0
				If showtree <> "1" Then strContent = "<table width=""100%"" align=center border=0 cellpadding=0 cellspacing=0 class=tablist>" & vbCrLf
				Do While Not rsClslist.EOF
					If showtree <> "1" Then 
						strContent = strContent & "<tr valign=""top"">" & vbCrLf
					Else
						strContent = strContent & "<div class=""mainParentListArea"">"
					End If
					For i = 1 To 2
						n = n + 1
						If showtree <> "1" Then strContent = strContent & "<td class=""tdlist"">"
						If Not (rsClslist.EOF) Then
							strContent = strContent & TempListContent
							If CInt(CreateHtml) <> 0 Then
								ClassUrl = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, "",rsClslist("HtmlFileDir"),rsClslist("ClassID"),0,1,"")
							Else
								If IsURLRewrite Then
									ClassUrl = ChannelRootDir & "list_1_" & rsClslist("ClassID") & Newasp.HtmlExtName
								Else
									ClassUrl = ChannelRootDir & "list.asp?classid=" & rsClslist("ClassID")
								End If
							End If
							ClassNameStr = "<a href=""" & ClassUrl & """ class=""showtitle"">" & rsClslist("ClassName") & "</a>"
							strContent = Replace(strContent, "{$ChannelID}", ChannelID)
							strContent = Replace(strContent, "{$ClassifyID}", rsClslist("ClassID"))
							strContent = Replace(strContent, "{$ClassName}", ClassNameStr)
							strContent = Replace(strContent, "{$ClassUrl}", ClassUrl)
							strContent = Replace(strContent, "{$n}", n)
							strContent = Replace(strContent, "{$i}", i)
							If showtree <> "1" Then strContent = strContent & "</td>" & vbCrLf
							rsClslist.MoveNext
						Else
							If showtree <> "1" Then strContent = strContent & "</td>" & vbCrLf
						End If
					Next
					If showtree <> "1" Then
						strContent = strContent & "</tr>" & vbCrLf
					Else
						strContent = strContent & "</div>" & vbCrLf
					End If
				Loop
				If showtree <> "1" Then strContent = strContent & "</table>" & vbCrLf
			End If
			HtmlContent = Replace(HtmlContent, TempListContent, strContent)
			HtmlContent = Replace(HtmlContent, "[ShowRepetend]", "")
			HtmlContent = Replace(HtmlContent, "[/ShowRepetend]", "")
			rsClslist.Close: Set rsClslist = Nothing
		End If
	End Sub
	'================================================
	'过程名:LoadChildListHtml
	'作  用:装载子级文章列表HTML
	'================================================
	Private Sub LoadChildListHtml(n)
		Dim Perownum
		Dim PerPageNum,c
		Perownum = Newasp.ChkNumeric(Newasp.HtmlSetting(8))
		PerPageNum = MakeListNum
		
		If IsNull(TempListContent) Then Exit Sub
		If n > TotalPageNum Then
			MakePageDone = 1
			Exit Sub
		End If
		'创建分类目录
		Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
		If MakeHtmlMode = 0 Then
			For CurrentPage = n To TotalPageNum
				Call CreateListHtml(CurrentPage,Perownum)
			Next
		Else
			c = 1
			For CurrentPage = n To TotalPageNum
				c = c + 1
				If CurrentPage > TotalPageNum Then Exit For
				Call CreateListHtml(CurrentPage,Perownum)
				If c > PerPageNum Then Exit Sub
			Next
			MakePageDone = 1
		End If
		
	End Sub
	Private Sub CreateListHtml(CurrentPage,Perownum)
		If CurrentPage > TotalPageNum Then MakePageDone = 1 : Exit Sub
		Dim HtmlFileName
		Dim ii,w
		
		Rs.MoveFirst
		i = 0
		If CurrentPage < 1 Then CurrentPage = 1
		If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
		ListContent = ""
		j = (CurrentPage - 1) * maxperpage + 1

		If Perownum > 1 Then 
			ListContent = Newasp.HtmlSetting(9)
			w = FormatPercent(100 / Perownum / 100,0)
		End If
		
		Do While Not Rs.EOF And i < CInt(maxperpage)
			If Not Response.IsClientConnected Then Response.end
			If Perownum > 1 Then
				ListContent = ListContent & "<tr valign=""top"">" & vbCrLf
				For ii = 1 To Perownum
					ListContent = ListContent & "<td width=""" & w & """ class=""shoplistrow"">"
					If Not Rs.EOF Then
						Call LoadListDetail
						Rs.movenext
						i = i + 1
						j = j + 1
					End If
					ListContent = ListContent & "</td>" & vbCrLf
				Next
				ListContent = ListContent & "</tr>" & vbCrLf
			Else
				Call LoadListDetail
				Rs.MoveNext
				i = i + 1
				j = j + 1
			End If

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?