newschannel.asp

网络上经典的图片程序

			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 = ShowChannelPath(ChannelRootDir,rsRdlated("HtmlFileDir")) & Newasp.ShowDatePath(rsRdlated("HtmlFileDate"), Newasp.HtmlPath)
					HtmlFileName = Newasp.ReadFileName(rsRdlated("HtmlFileDate"), rsRdlated("ArticleID"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, "")
					ArticleTitle = "<a href=""" & HtmlFileUrl & HtmlFileName & """ title='" & rsRdlated("title") & "'>" & strTitle & "</a>"
				Else
					ArticleTitle = "<a href=""show.asp?id=" & rsRdlated("ArticleID") & """ title='" & rsRdlated("title") & "'>" & strTitle & "</a>"
				End If
				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()
		
		'On Error Resume Next
		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 = ShowChannelPath(ChannelRootDir,rsHot("HtmlFileDir")) & Newasp.ShowDatePath(rsHot("HtmlFileDate"), Newasp.HtmlPath)
					HtmlFileName = Newasp.ReadFileName(rsHot("HtmlFileDate"), rsHot("ArticleID"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, "")
					ArticleTitle = "<a href=" & HtmlFileUrl & HtmlFileName & " title='" & rsHot("title") & "'>" & strTitle & "</a>"
				Else
					ArticleTitle = "<a href=show.asp?id=" & rsHot("ArticleID") & " title='" & rsHot("title") & "'>" & strTitle & "</a>"
				End If
				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()
		
		On Error Resume Next
		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
	'================================================
	'函数名：CurrentStation
	'作  用：当前位置
	'参  数：...
	'================================================
	Private Function CurrentStation(ChannelID, ClassID, ClassName, ParentID, strParent, HtmlFileDir, Compart)
		Dim rsCurrent, SQL, strContent, ChannelDir
		
		On Error Resume Next
		ChannelDir = ChannelRootDir
		If ParentID <> 0 And Len(strParent) <> 0 Then
			SQL = "select ClassID,ClassName,HtmlFileDir from [NC_Classify] where ChannelID = " & ChannelID & " And ClassID in(" & strParent & ")"
			Set rsCurrent = Newasp.Execute(SQL)
			If Not (rsCurrent.EOF And rsCurrent.BOF) Then
				Do While Not rsCurrent.EOF
					If CInt(Newasp.IsCreateHtml) <> 0 Then
						strContent = strContent & "<a href='" & ChannelDir & rsCurrent("HtmlFileDir") & "'>" & rsCurrent(1) & "</a>" & Compart & ""
					Else
						strContent = strContent & "<a href='" & ChannelDir & "list.asp?classid=" & rsCurrent("ClassID") & "'>" & rsCurrent("ClassName") & "</a>" & Compart & ""
					End If
					rsCurrent.MoveNext
				Loop
			End If
			rsCurrent.Close
			Set rsCurrent = Nothing
		End If
		If CInt(Newasp.IsCreateHtml) <> 0 Then
			strContent = strContent & "<a href='" & ChannelDir & HtmlFileDir & "'>" & ClassName & "</a>"
		Else
			strContent = strContent & "<a href='" & ChannelDir & "list.asp?classid=" & ClassID & "'>" & ClassName & "</a>"
		End If
		CurrentStation = strContent
	End Function
	'================================================
	'函数名：ReadCurrentStation
	'作  用：读取当前位置
	'参  数：str ----原字符串
	'================================================
	Private Function ReadCurrentStation(str, ChannelID, ClassID, ClassName, ParentID, strParent, HtmlFileDir)
		Dim strTemp, i, sTempContent, nTempContent
		Dim arrTempContent, arrTempContents
		
		On Error Resume Next
		strTemp = str
		sTempContent = Newasp.CutMatchContent(strTemp, "{#CurrentStation(", ")}", 1)
		nTempContent = Newasp.CutMatchContent(strTemp, "{#CurrentStation(", ")}", 0)
		arrTempContents = Split(sTempContent, "|||")
		arrTempContent = Split(nTempContent, "|||")
		For i = 0 To UBound(arrTempContents)
			strTemp = Replace(strTemp, arrTempContents(i), CurrentStation(ChannelID, ClassID, ClassName, ParentID, strParent, HtmlFileDir, arrTempContent(i)))
		Next
		ReadCurrentStation = strTemp
	End Function
	'##############################################################################
	'#############################\\执行文章列表开始//#############################
	Public Sub ShowArticleList()
		On Error Resume Next
		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)
		On Error Resume Next
		Dim rsClass, TemplateContent, strTemplate, strOrder
		Dim ParentTemplate, ChildTemplate, HtmlFileName
		Dim MaxListnum, strMaxListop, showtree
		Dim AdsCode,stopad
		
		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
			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 = CLng(Newasp.ChannelSkin)
			End If
			AdsCode = rsClass("AdsCode")
			stopad = rsClass("stopad")
		End If
		rsClass.Close: Set rsClass = Nothing
		Newasp.LoadTemplates ChannelID, 2, skinid
		PageType = 1
		HtmlFilePath = Newasp.InstallDir & Newasp.ChannelDir & 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, "{$PageTitle}", strPageTitle)
		HtmlContent = Replace(HtmlContent, "{$ArticleIndex}", strIndexName)
		If Child <> 0 And showtree <> 9 Then
			Call LoadParentList
			Call ReplaceContent
			If CInt(CreateHtml) <> 0 Then
				'创建分类目录
				Newasp.CreatPathEx (HtmlFilePath)
				'开始生成父级分类的HTML页
				HtmlFileName = HtmlFilePath & ReadListPageName(ClassID, 0)
				Newasp.CreatedTextFile HtmlFileName, HtmlContent
				If IsShowFlush = 1 Then Response.Write "<li style=""font-size: 12px;"">生成" & Newasp.ModuleName & "列表HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
				Response.Flush
			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"