newschannel.asp

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

		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		HtmlContent = Replace(HtmlContent, "{$ArticleIndex}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
		HtmlContent = Replace(HtmlContent, "{$MemberName}", Newasp.membername)
		HtmlContent = Replace(HtmlContent, "{$PageTitle}", Rs("title"))
		HtmlContent = Replace(HtmlContent, "{$SubTitle}", subtitle)
		HtmlContent = Replace(HtmlContent, "{$ClassID}", Rs("ClassID"))
		HtmlContent = Replace(HtmlContent, "{$ArticleID}", ArticleID)
		HtmlContent = Replace(HtmlContent, "{$CurrentPage}", CurrentPage)
		HtmlContent = Replace(HtmlContent, "{$ArticleTitle}", Rs("title"))
		HtmlContent = Replace(HtmlContent, "{$ArticleContent}", ArticleContent)
		If UserArticle = True Then
			HtmlContent = Replace(HtmlContent, "{$ScriptContent}", "<script src=""" & ChannelRootDir & "content.asp?ArticleID=" & ArticleID & "&page=" & CurrentPage & """></script>")
		Else
			HtmlContent = Replace(HtmlContent, "{$ScriptContent}", "")
		End If
		HtmlContent = Replace(HtmlContent, "{$Author}", Newasp.ChkNull(Rs("Author")))
		HtmlContent = Replace(HtmlContent, "{$ComeFrom}", Rs("ComeFrom")&"")
		HtmlContent = Replace(HtmlContent, "{$WriteTime}", Rs("WriteTime")&"")
		HtmlContent = Replace(HtmlContent, "{$UserName}", Rs("username")&"")
		HtmlContent = Replace(HtmlContent, "{$Star}", Rs("star")&"")
		HtmlContent = Replace(HtmlContent, "{$Best}", Rs("isBest"))
		HtmlContent = Replace(HtmlContent, "{$ClassName}", Rs("ClassName"))
		HtmlContent = Replace(HtmlContent, "{$ThisUrl}", ThisUrl)
		HtmlContent = Replace(HtmlContent, "{$HeadTitle}", Rs("title"))
		
		HtmlContent = GetDescription(HtmlContent, ArticleContent)
		If InStr(HtmlContent, "{$Description}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$Description}", Newasp.CutString(ArticleContent,190))
		End If
		If InStr(HtmlContent, "{$FrontArticle}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$FrontArticle}", FrontArticle(ArticleID))
		End If
		If InStr(HtmlContent, "{$NextArticle}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$NextArticle}", NextArticle(ArticleID))
		End If
		If InStr(HtmlContent, "{$RelatedArticle}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$RelatedArticle}", RelatedArticle(Rs("Related")&"", Rs("title"), ArticleID))
		End If
		If InStr(HtmlContent, "{$ShowHotArticle}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$ShowHotArticle}", ReadHotArticle(Rs("ClassID")))
		End If
		If InStr(HtmlContent, "{$ArticleComment}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$ArticleComment}", ArticleComment(Rs("ArticleID")))
		End If
		HtmlContent = HTML.ReadCurrentStation(HtmlContent, ChannelID, Rs("ClassID"), Rs("ClassName"), Rs("ParentID"), Rs("ParentStr"), Rs("HtmlFileDir"))
		HtmlContent = HTML.ReadAnnounceContent(HtmlContent, ChannelID)
		HtmlContent = ReadClassMenubar(HtmlContent)
		HtmlContent = ReadClassMenu(HtmlContent)
		HtmlContent = HTML.ReadArticlePic(HtmlContent)
		HtmlContent = HTML.ReadArticleList(HtmlContent)
		HtmlContent = HTML.ReadPopularArticle(HtmlContent)
		HtmlContent = HTML.ReadSoftPic(HtmlContent)
		HtmlContent = HTML.ReadSoftList(HtmlContent)
		HtmlContent = HTML.ReadFlashList(HtmlContent)
		HtmlContent = HTML.ReadFlashPic(HtmlContent)
		HtmlContent = HTML.LoadCommentGrade(HtmlContent, ChannelID, ArticleID)
		HtmlContent = Replace(HtmlContent, "{$Classify}", Trim(HTML.CurrentClass))
		HtmlContent = Replace(HtmlContent, "{$CurrentClass}", HTML.CurrentClass)
		If len(subtitle) = 0 Then
			HeaderTitle = Trim(HTML.CurrentClass)
			HeaderTitles = ""
			HeaderTopic = ""
		Else
			HeaderTitle = subtitle
			HeaderTitles = " - " & subtitle
			HeaderTopic = subtitle
		End If
		HtmlContent = Replace(HtmlContent, "{$HeaderTitle}", HeaderTitle)
		HtmlContent = Replace(HtmlContent, "{$HeaderTitles}", HeaderTitles)
		HtmlContent = Replace(HtmlContent, "{$HeaderTopic}", HeaderTopic)
		HtmlContent = Replace(HtmlContent, "{$ParentClass}", HTML.ParentClass)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		ReadArticleContent = HtmlContent
		Rs.Close: Set Rs = Nothing
	End Function
	Private Function GetDescription(ByVal str,ByVal strIntro)
		Dim strTemp, i
		Dim sTempContent, nTempContent
		Dim arrTempContent, arrTempContents, strLen
		If Len(strIntro) = 0 Then
			GetDescription = str
			Exit Function
		End If
		strTemp = str
		If InStr(strTemp, "{$Description(") > 0 Then
			sTempContent = Newasp.CutMatchContent(strTemp, "{$Description(", ")}", 1)
			nTempContent = Newasp.CutMatchContent(strTemp, "{$Description(", ")}", 0)
			arrTempContents = Split(sTempContent, "|||")
			arrTempContent = Split(nTempContent, "|||")
			
			For i = 0 To UBound(arrTempContents)
				strLen = Newasp.ChkNumeric(arrTempContent(i))
				If strLen > 0 Then
					strTemp = Replace(strTemp, arrTempContents(i), Newasp.CutString(strIntro,strLen))
				Else
					strTemp = Replace(strTemp, arrTempContents(i), ChkDescription(strIntro))
				End If
			Next
		End If
		GetDescription = strTemp
	End Function
	Public Function ChkDescription(ByVal str)
		Dim re,strHtml
		strHtml = str
		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		re.Pattern = "\[br\]"
		strHtml = re.Replace(strHtml, "")
		re.Pattern = "\[align=right\](.*)\[\/align\]"
		strHtml = re.Replace(strHtml, "")
		re.Pattern = "([\f\n\r\t\v])"
		strHtml = re.Replace(strHtml, "")
		re.Pattern = "<(.[^>]*)>"
		strHtml = re.Replace(strHtml, "")
		Set re = Nothing
		strHtml = Replace(strHtml, "&nbsp;", "")
		strHtml = Replace(strHtml, "====", "")
		strHtml = Replace(strHtml, "----", "")
		strHtml = Replace(strHtml, "////", "")
		strHtml = Replace(strHtml, "\\\\", "")
		strHtml = Replace(strHtml, "####", "")
		strHtml = Replace(strHtml, "@@@@", "")
		strHtml = Replace(strHtml, "****", "")
		strHtml = Replace(strHtml, "~~~~", "")
		strHtml = Replace(strHtml, "≡≡≡", "")
		strHtml = Replace(strHtml, "++++", "")
		strHtml = Replace(strHtml, "::::", "")
		strHtml = Replace(strHtml, Chr(34), "&quot;")
		strHtml = Replace(strHtml, Chr(39), "&#39;")
		strHtml = Replace(strHtml, "[InstallDir_ChannelDir]", "")
		strHtml = Replace(strHtml, "[NextPage]", "")
		strHtml = Replace(strHtml, "[Page_Break]", "")
		ChkDescription = strHtml
	End Function
	'=================================================
	'过程名：CreateArticleContent
	'作  用：生成文章内容
	'参  数：ArticleID ----文章ID
	'=================================================
	Public Function CreateArticleContent(ArticleID)
		Dim arrContent, Paginate, rsCreate, HtmlFileName, strHtmlContent
		Dim sContentText, i
		
		If CreateHtml = 0 Then Exit Function
		
		SQL = "SELECT A.ArticleID,A.classid,A.title,A.content,A.HtmlFileDate,A.AutoPages,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.ArticleID=" & ArticleID
		Set rsCreate = Newasp.Execute(SQL)
		If rsCreate.BOF And rsCreate.EOF Then
			Set rsCreate = Nothing
			Exit Function
		End If
		
		HtmlFilePath = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsCreate("HtmlFileDate"),rsCreate("HtmlFileDir"),rsCreate("ClassID"),rsCreate("ArticleID"),1,"")
		HtmlFilePath = Newasp.HtmlFilesPath
		Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
		ubb.Pagination = Newasp.ChkNumeric(rsCreate("AutoPages"))
		sContentText = ubb.UBBCode(rsCreate("Content"))
		arrContent = Split(sContentText, "[page_break]")
		Paginate = UBound(arrContent)
		Response.Flush
		For i = 1 To Paginate + 1
			strHtmlContent = ReadArticleContent(rsCreate("ArticleID"), i)
			HtmlFileName = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsCreate("HtmlFileDate"),rsCreate("HtmlFileDir"),rsCreate("ClassID"),rsCreate("ArticleID"),i,"")
			Newasp.CreatedTextFile strBasicPath & HtmlFileName, strHtmlContent
			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
		Next
		rsCreate.Close: Set rsCreate = Nothing
	End Function
	'=================================================
	'函数名：FrontArticle
	'作  用：显示上一篇文章
	'参  数：ArticleID ----文章ID
	'=================================================
	Private Function FrontArticle(ArticleID)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		SQL = "select Top 1 A.ArticleID,A.ClassID,A.title,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.ArticleID < " & ArticleID & " order by A.ArticleID desc"
		Set rsContext = Newasp.Execute(SQL)
		If rsContext.EOF And rsContext.BOF Then
			HtmlContent = Replace(HtmlContent, "{$BackUrl}", "#")
			FrontArticle = "已经没有了"
		Else
			If CreateHtml <> 0 Then
				HtmlFileUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsContext("HtmlFileDate"),rsContext("HtmlFileDir"),rsContext("ClassID"),rsContext("ArticleID"),1,"")
			Else
				If IsURLRewrite Then
					HtmlFileUrl = rsContext("ArticleID") & Newasp.HtmlExtName
				Else
					HtmlFileUrl = "?id=" & rsContext("ArticleID")
				End If
			End If
			HtmlContent = Replace(HtmlContent, "{$BackUrl}", HtmlFileUrl)
			FrontArticle = "<a href=""" & HtmlFileUrl & """>" & rsContext("title") & "</a>"
		End If
		rsContext.Close
		Set rsContext = Nothing
	End Function
	'=================================================
	'函数名：NextArticle
	'作  用：显示下一篇文章
	'参  数：ArticleID ----文章ID
	'=================================================
	Private Function NextArticle(ArticleID)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		SQL = "select Top 1 A.ArticleID,A.ClassID,A.title,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.ArticleID > " & ArticleID & " order by A.ArticleID asc"
		Set rsContext = Newasp.Execute(SQL)
		If rsContext.EOF And rsContext.BOF Then
			HtmlContent = Replace(HtmlContent, "{$NextUrl}", "#")
			NextArticle = "已经没有了"
		Else
			If CreateHtml <> 0 Then
				HtmlFileUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsContext("HtmlFileDate"),rsContext("HtmlFileDir"),rsContext("ClassID"),rsContext("ArticleID"),1,"")
			Else
				If IsURLRewrite Then
					HtmlFileUrl = rsContext("ArticleID") & Newasp.HtmlExtName
				Else
					HtmlFileUrl = "?id=" & rsContext("ArticleID")
				End If
			End If
			HtmlContent = Replace(HtmlContent, "{$NextUrl}", HtmlFileUrl)
			NextArticle = "<a href=""" & HtmlFileUrl & """>" & rsContext("title") & "</a>"
		End If
		rsContext.Close
		Set rsContext = Nothing
	End Function
	'=================================================
	'过程名：ContentPagination
	'作  用：以分页方式显示文章具体的内容
	'参  数：无
	'=================================================
	Private Sub ContentPagination()
		Dim ContentLen, maxperpage, Paginate
		Dim arrContent, strContent, i
		Dim m_strFileUrl,m_strFileExt
		
		strContent = ubb.UBBCode(Rs("Content"))
		strContent = Replace(strContent, "[NextPage]", "[page_break]")
		strContent = Replace(strContent, "[Page_Break]", "[page_break]")
		ContentLen = Len(strContent)
		If InStr(strContent, "[page_break]") <= 0 Then
			If UserArticle = True Then 
				strContent = Newasp.RemoveHtml(strContent)
				strContent = Left(strContent,maxstrlen)
			End If
			ArticleContent = "<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 = CLng(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 = arrContent(CurrentPage - 1)
				strContent = "<div id=""NewsContentLabel"" class=""NewsContent"">"& arrContent(CurrentPage - 1)
			End If
			
			ArticleContent = ArticleContent & strContent
			If UserArticle = True Then
				ArticleContent = ArticleContent & "</p></div><div id=""Message"" class=""Message""></div><p align=""center""><b>"
			Else
				ArticleContent = ArticleContent & "</p></div><p align=""center""><b>"
			End If
			If IsURLRewrite Then
				m_strFileExt = Newasp.HtmlExtName
				m_strFileUrl = ArticleID & "_"
			Else
				m_strFileExt = ""
				m_strFileUrl = "?id=" & ArticleID & "&Page="
			End If
			If CurrentPage > 1 Then
				If IsURLRewrite And (CurrentPage-1) = 1 Then
					ArticleContent = ArticleContent & "<a href="""& ArticleID & m_strFileExt & """>上一页</a>&nbsp;&nbsp;"