newschannel.asp

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

				Else
					ArticleContent = ArticleContent & "<a href="""& m_strFileUrl & CurrentPage - 1 & m_strFileExt & """>上一页</a>&nbsp;&nbsp;"
				End If
			End If
			For i = 1 To Paginate
				If i = CurrentPage Then
					ArticleContent = ArticleContent & "<font color=""red"">[" & CStr(i) & "]</font>&nbsp;"
				Else
					If IsURLRewrite And i = 1 Then
						ArticleContent = ArticleContent & "<a href="""& ArticleID & m_strFileExt & """>[" & i & "]</a>&nbsp;"
					Else
						ArticleContent = ArticleContent & "<a href="""& m_strFileUrl & i & m_strFileExt & """>[" & i & "]</a>&nbsp;"
					End if
				End If
			Next
			If CurrentPage < Paginate Then
				ArticleContent = ArticleContent & "&nbsp;<a href="""& m_strFileUrl & CurrentPage + 1 & m_strFileExt & """>下一页</a>"
			End If
			ArticleContent = ArticleContent & "</b></p>"
		End If
	End Sub
	'=================================================
	'函数名：HtmlPagination
	'作  用：以分页方式显示文章具体的内容
	'参  数：无
	'=================================================
	Private Function HtmlPagination(n)
		Dim ContentLen, CurrentPage, maxperpage, Paginate
		Dim arrContent, strContent, TempContent, i
		
		strContent = ubb.UBBCode(Rs("content"))
		ContentLen = Len(strContent)
		CurrentPage = CInt(n)
		If InStr(strContent, "[page_break]") <= 0 Then
			If UserArticle = True Then 
				strContent = Newasp.RemoveHtml(strContent)
				strContent = Left(strContent,maxstrlen)
			End If
			TempContent = "<div id=""NewsContentLabel"" class=""NewsContent"">" & strContent & "</div><div id=""Message"" class=""Message""></div>"
		Else
			arrContent = Split(strContent, "[page_break]")

			Paginate = UBound(arrContent) + 1
			If CurrentPage = 0 Then
				CurrentPage = 1
			Else
				CurrentPage = CInt(CurrentPage)
			End If
			If CurrentPage < 1 Then CurrentPage = 1
			If CurrentPage > Paginate Then CurrentPage = Paginate
			
			If UserArticle = True Then
				If CurrentPage = 1 Then
					strContent = arrContent(CurrentPage - 1)
					strContent = Newasp.RemoveHtml(strContent)
					strContent = Left(strContent,maxstrlen)
					strContent = "<div id=""NewsContentLabel"" class=""NewsContent"">" & strContent & "</div>"
				Else
					strContent = "<div id=""NewsContentLabel"" class=""NewsContent""></div>"
				End If
			Else
				strContent = "<div id=""NewsContentLabel"" class=""NewsContent"">"& arrContent(CurrentPage - 1)
			End If
			
			TempContent = TempContent & strContent
			If UserArticle = True Then
				TempContent = TempContent & "</p></div><div id=""Message"" class=""Message""></div><p align=""center""><b>"
			Else
				TempContent = TempContent & "</p></div><p align=""center""><b>"
			End If
			If CurrentPage > 1 Then
				TempContent = TempContent & "<a href=""" & ReadPagination(CurrentPage - 1) & """>上一页</a>&nbsp;&nbsp;"
			End If
			For i = 1 To Paginate
				If i = CurrentPage Then
					TempContent = TempContent & "<font color=""red"">[" & i & "]</font>&nbsp;"
				Else
					TempContent = TempContent & "<a href=""" & ReadPagination(i) & """>[" & i & "]</a>&nbsp;"
				End If
			Next
			If CurrentPage < Paginate Then
				TempContent = TempContent & "&nbsp;<a href=""" & ReadPagination(CurrentPage + 1) & """>下一页</a>"
			End If
			TempContent = TempContent & "</b></p>"
		End If
		HtmlPagination = TempContent
	End Function
	Private Function ReadPagination(n)
		Dim HtmlFileName, CurrentPage
		CurrentPage = n
		HtmlFileName = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("ArticleID"),CurrentPage,"")
		ReadPagination = Mid(HtmlFileName, InStrRev(HtmlFileName, "/") + 1)
	End Function
	'=================================================
	'函数名：RelatedArticle
	'作  用：显示相关文章
	'参  数：sRelated ----相关文章
	'=================================================
	Private Function RelatedArticle(sRelated, topic, ArticleID)
		Dim rsRdlated, SQL, HtmlFileUrl, HtmlFileName
		Dim strTitle, strTopic, ArticleTitle, strContent
		Dim strRelated, arrRelated, i, Resize, strRearrange
		Dim strKey
		Dim ArrayTemp()
		
		strRelated = Replace(Replace(Replace(Replace(Replace(Replace(Replace(sRelated, "[", ""), "]", ""), "'", ""), "(", ""), ")", ""), "《", ""), "》", "")
		strKey = Left(Newasp.ChkQueryStr(topic), 5)
		If Not IsNull(sRelated) And sRelated <> Empty Then
			If InStr(strRelated, "|") > 1 Then
				arrRelated = Split(strRelated, "|")
				strRelated = "((A.title like '%" & arrRelated(0) & "%')"
				For i = 1 To UBound(arrRelated)
					strRelated = strRelated & " Or (A.title like '%" & arrRelated(i) & "%')"
				Next
				'strRelated = strRelated & ")"
			Else
				strRelated = "((A.title like '%" & strRelated & "%')"
			End If
			strRelated = strRelated & " Or (A.title like '%" & strKey & "%'))"
		Else
			strRelated = "(A.title like '%" & strKey & "%')"
		End If
		SQL = "SELECT TOP " & CInt(Newasp.HtmlSetting(1)) & " A.ArticleID,A.ClassID,A.ColorMode,A.FontMode,A.title,A.BriefTopic,A.AllHits,A.WriteTime,A.HtmlFileDate,C.HtmlFileDir FROM [NC_Article] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID where A.ChannelID=" & ChannelID & " And A.isAccept > 0 And " & strRelated & " ORDER BY A.ArticleID DESC"
		Set rsRdlated = Newasp.Execute(SQL)
		If rsRdlated.EOF And rsRdlated.BOF Then
			RelatedArticle = ""
			Set rsRdlated = Nothing
			Exit Function
		Else
			i = 0
			Resize = 0
			Do While Not rsRdlated.EOF
				ReDim Preserve ArrayTemp(i + Resize)
				strContent = ArrayTemp(i) & Newasp.HtmlSetting(4)
				strTopic = Newasp.ReadPicTopic(rsRdlated("BriefTopic"))
				If Len(strTopic) = 0 Then
					strTitle = Newasp.GotTopic(rsRdlated("Title"), CInt(Newasp.HtmlSetting(2)))
				Else
					strTitle = Newasp.GotTopic(rsRdlated("Title"), CInt(Newasp.HtmlSetting(2))-6)
				End If
				strTitle = Newasp.ReadFontMode(strTitle, rsRdlated("ColorMode"), rsRdlated("FontMode"))
				
				If CreateHtml <> 0 Then
					HtmlFileUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsRdlated("HtmlFileDate"),rsRdlated("HtmlFileDir"),rsRdlated("ClassID"),rsRdlated("ArticleID"),1,"")
				Else
					If IsURLRewrite Then
						HtmlFileUrl = rsRdlated("ArticleID") & Newasp.HtmlExtName
					Else
						HtmlFileUrl = "show.asp?id=" & rsRdlated("ArticleID")
					End If
				End If
				ArticleTitle = "<a href=""" & HtmlFileUrl & """" & LoadRemark(rsRdlated("title")) & ">" & strTitle & "</a>"
				strContent = Replace(strContent, "{$BriefTopic}", strTopic)
				strContent = Replace(strContent, "{$ArticleTitle}", ArticleTitle)
				strContent = Replace(strContent, "{$AllHits}", rsRdlated("AllHits"))
				strContent = Replace(strContent, "{$WriteTime}", Newasp.ShowDateTime(rsRdlated("WriteTime"), CInt(Newasp.HtmlSetting(3))))
				ArrayTemp(i) = strContent
				rsRdlated.MoveNext
				i = i + 1
			Loop
		End If
		rsRdlated.Close
		Set rsRdlated = Nothing
		strRearrange = Join(ArrayTemp, vbCrLf)
		RelatedArticle = strRearrange
	End Function
	'=================================================
	'函数名：ReadHotArticle
	'作  用：显示热门文章
	'参  数：ClassID ----文章分类ID
	'=================================================
	Private Function ReadHotArticle(ClassID)
		Dim rsHot, SQL, HtmlFileUrl, HtmlFileName
		Dim strTitle, strTopic, ArticleTitle, strContent
		Dim i, Resize, strRearrange
		Dim ArrayTemp()
		
		SQL = "SELECT TOP " & CInt(Newasp.HtmlSetting(1)) & " A.ArticleID,A.ClassID,A.ColorMode,A.FontMode,A.title,A.BriefTopic,A.AllHits,A.WriteTime,A.HtmlFileDate,C.HtmlFileDir FROM [NC_Article] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID where A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.AllHits >= " & CLng(Newasp.LeastHotHist) & " ORDER BY A.AllHits DESC,A.ArticleID DESC"
		Set rsHot = Newasp.Execute(SQL)
		If rsHot.EOF And rsHot.BOF Then
			ReadHotArticle = ""
			Set rsHot = Nothing
			Exit Function
		Else
			i = 0
			Resize = 0
			Do While Not rsHot.EOF
				ReDim Preserve ArrayTemp(i + Resize)
				strContent = ArrayTemp(i) & Newasp.HtmlSetting(4)
				
				
				strTopic = Newasp.ReadPicTopic(rsHot("BriefTopic"))
				If Len(strTopic) = 0 Then
					strTitle = Newasp.GotTopic(rsHot("Title"), CInt(Newasp.HtmlSetting(2)))
				Else
					strTitle = Newasp.GotTopic(rsHot("Title"), CInt(Newasp.HtmlSetting(2)) - 6)
				End If
				strTitle = Newasp.ReadFontMode(strTitle, rsHot("ColorMode"), rsHot("FontMode"))
				If CreateHtml <> 0 Then
					HtmlFileUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsHot("HtmlFileDate"),rsHot("HtmlFileDir"),rsHot("ClassID"),rsHot("ArticleID"),1,"")
				Else
					If IsURLRewrite Then
						HtmlFileUrl = rsHot("ArticleID") & Newasp.HtmlExtName
					Else
						HtmlFileUrl = "show.asp?id=" & rsHot("ArticleID")
					End If
				End If
				ArticleTitle = "<a href=""" & HtmlFileUrl & """" & LoadRemark(rsHot("title")) & ">" & strTitle & "</a>"
				strContent = Replace(strContent, "{$BriefTopic}", strTopic)
				strContent = Replace(strContent, "{$ArticleTitle}", ArticleTitle)
				strContent = Replace(strContent, "{$AllHits}", rsHot("AllHits"))
				strContent = Replace(strContent, "{$WriteTime}", Newasp.ShowDateTime(rsHot("WriteTime"), CInt(Newasp.HtmlSetting(3))))
				ArrayTemp(i) = strContent
				rsHot.MoveNext
				i = i + 1
			Loop
		End If
		rsHot.Close
		Set rsHot = Nothing
		strRearrange = Join(ArrayTemp, vbCrLf)
		ReadHotArticle = strRearrange
	End Function
	'================================================
	'函数名：ArticleComment
	'作  用：文章评论
	'参  数：ArticleID ----文章ID
	'================================================
	Private Function ArticleComment(ArticleID)
		Dim rsComment, SQL, strContent, strComment
		Dim i, Resize, strRearrange
		Dim ArrayTemp()
		
		Set rsComment = Newasp.Execute("Select Top " & CInt(Newasp.HtmlSetting(5)) & " content,Grade,username,postime,postip From NC_Comment where ChannelID=" & ChannelID & " And postid = " & ArticleID & " order by postime desc,CommentID desc")
		If Not (rsComment.EOF And rsComment.BOF) Then
			i = 0
			Resize = 0
			Do While Not rsComment.EOF
				ReDim Preserve ArrayTemp(i + Resize)
				strContent = ArrayTemp(i) & Newasp.HtmlSetting(7)
				strComment = Newasp.CutString(rsComment("content"), CInt(Newasp.HtmlSetting(6)))
				strContent = Replace(strContent, "{$Comment}", Newasp.HTMLEncode(strComment))
				strContent = Replace(strContent, "{$UserName}", Newasp.HTMLEncode(rsComment("username")))
				strContent = Replace(strContent, "{$UserGrade}", rsComment("Grade"))
				strContent = Replace(strContent, "{$postime}", rsComment("postime"))
				strContent = Replace(strContent, "{$postip}", rsComment("postip"))
				ArrayTemp(i) = strContent
				rsComment.MoveNext
				i = i + 1
			Loop
		End If
		rsComment.Close
		strRearrange = Join(ArrayTemp, vbCrLf)
		Set rsComment = Nothing
		ArticleComment = strRearrange
	End Function
	'##############################################################################
	'#############################\\执行文章列表开始//#############################
	Public Sub ShowArticleList()
		If CreateHtml <> 0 Then
			Response.Redirect (ChannelRootDir & "index" & Newasp.HtmlExtName)
			Exit Sub
		Else
			Newasp.PreventInfuse
			If Not IsNumeric(Request("page")) And Len(Request("page")) <> 0 Then
				Response.Write ("错误的系统参数!请输入整数")
				Response.end
			End If
			If Not IsEmpty(Request("page")) And Len(Request("page")) <> 0 Then
				CurrentPage = Newasp.ChkNumeric(Request("page"))
			Else
				CurrentPage = 1
			End If
			ClassID = Newasp.ChkNumeric(Request("ClassID"))
			Response.Write CreateArticleList(ClassID, 1)
		End If
	End Sub
	'================================================
	'函数名：CreateArticleList
	'作  用：生成文章列表
	'================================================
	Public Function CreateArticleList(clsid, n)
		Dim rsClass, TemplateContent, strTemplate, strOrder
		Dim ParentTemplate, ChildTemplate, HtmlFileName
		Dim MaxListnum, strMaxListop, showtree
		Dim AdsCode,stopad,m_strFilePath
		
		If Not IsNumeric(clsid) Then Exit Function
		SQL = "select ClassID,ClassName,ChildStr,ParentID,ParentStr,Child,skinid,HtmlFileDir,UseHtml,AdsCode,stopad from [NC_Classify] where ChannelID = " & ChannelID & " And ClassID=" & clsid
		Set rsClass = Newasp.Execute(SQL)
		If rsClass.BOF And rsClass.EOF Then
			If CreateHtml = 0 Then
				Response.Write "<meta http-equiv=""refresh"" content=""2;url=/"" />" & vbNewLine
				Response.Write "<p align=""center"" style=""font-size: 16px;color: red;"">对不起，该页面发生了错误，无法访问! 系统两秒后自动转到网站首页......</p>" & vbNewLine