📄 newschannel.asp
字号:
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 = Replace(HtmlContent, "{$CurrentClass}", HTML.CurrentClass)
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
'=================================================
'过程名：CreateArticleContent
'作 用：生成文章内容
'参 数：ArticleID ----文章ID
'=================================================
Public Function CreateArticleContent(ArticleID)
Dim arrContent, Paginate, rsCreate, HtmlFileName, strHtmlContent
Dim sContentText, i
On Error Resume Next
If CreateHtml = 0 Then Exit Function
SQL = "select A.ArticleID,A.title,A.content,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
Set rsCreate = Newasp.Execute(SQL)
If rsCreate.BOF And rsCreate.EOF Then
Set rsCreate = Nothing
Exit Function
End If
HtmlFilePath = ShowChannelPath(Newasp.InstallDir & Newasp.ChannelDir,rsCreate("HtmlFileDir")) & Newasp.ShowDatePath(rsCreate("HtmlFileDate"), Newasp.HtmlPath)
Newasp.CreatPathEx (HtmlFilePath)
sContentText = Replace(rsCreate("Content"), "[NextPage]", "[page_break]")
sContentText = Replace(sContentText, "[Page_Break]", "[page_break]")
arrContent = Split(sContentText, "[page_break]")
Paginate = UBound(arrContent)
Response.Flush
For i = 1 To Paginate + 1
strHtmlContent = ReadArticleContent(rsCreate("ArticleID"), i)
HtmlFileName = HtmlFilePath & Newasp.ReadFileName(rsCreate("HtmlFileDate"), rsCreate("ArticleID"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, i)
Newasp.CreatedTextFile 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
On Error Resume Next
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
FrontArticle = "已经没有了"
Else
If CreateHtml <> 0 Then
HtmlFileUrl = ShowChannelPath(ChannelRootDir,rsContext("HtmlFileDir")) & Newasp.ShowDatePath(rsContext("HtmlFileDate"), Newasp.HtmlPath)
HtmlFileName = Newasp.ReadFileName(rsContext("HtmlFileDate"), rsContext("ArticleID"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, "")
FrontArticle = "<a href=" & HtmlFileUrl & HtmlFileName & ">" & rsContext("title") & "</a>"
Else
FrontArticle = "<a href=?id=" & rsContext("ArticleID") & ">" & rsContext("title") & "</a>"
End If
End If
rsContext.Close
Set rsContext = Nothing
End Function
'=================================================
'函数名：NextArticle
'作 用：显示下一篇文章
'参 数：ArticleID ----文章ID
'=================================================
Private Function NextArticle(ArticleID)
Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
On Error Resume Next
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
NextArticle = "已经没有了"
Else
If CreateHtml <> 0 Then
HtmlFileUrl = ShowChannelPath(ChannelRootDir,rsContext("HtmlFileDir")) & Newasp.ShowDatePath(rsContext("HtmlFileDate"), Newasp.HtmlPath)
HtmlFileName = Newasp.ReadFileName(rsContext("HtmlFileDate"), rsContext("ArticleID"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, "")
NextArticle = "<a href=" & HtmlFileUrl & HtmlFileName & ">" & rsContext("title") & "</a>"
Else
NextArticle = "<a href=?id=" & rsContext("ArticleID") & ">" & rsContext("title") & "</a>"
End If
End If
rsContext.Close
Set rsContext = Nothing
End Function
'=================================================
'过程名：ContentPagination
'作 用：以分页方式显示文章具体的内容
'参 数：无
'=================================================
Private Sub ContentPagination()
Dim ContentLen, maxperpage, Paginate
Dim arrContent, strContent, i
On Error Resume Next
strContent = Newasp.ReadContent(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=""ContentLabel"" class=""ContentLabel"">" & 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=""ContentLabel"">" & strContent & "</div>"
Else
strContent = "<div id=""NewsContentLabel"" class=""ContentLabel""></div>"
End If
Else
strContent = arrContent(CurrentPage - 1)
End If
ArticleContent = ArticleContent & strContent
If UserArticle = True Then
ArticleContent = ArticleContent & "</p><div id=""Message"" class=""Message""></div><p align='center'><b>"
Else
ArticleContent = ArticleContent & "</p><p align='center'><b>"
End If
If CurrentPage > 1 Then
ArticleContent = ArticleContent & "<a href='?id=" & ArticleID & "&Page=" & CurrentPage - 1 & "'>上一页</a> "
End If
For i = 1 To Paginate
If i = CurrentPage Then
ArticleContent = ArticleContent & "<font color='red'>[" & CStr(i) & "]</font> "
Else
ArticleContent = ArticleContent & "<a href='?id=" & ArticleID & "&Page=" & i & "'>[" & i & "]</a> "
End If
Next
If CurrentPage < Paginate Then
ArticleContent = ArticleContent & " <a href='?id=" & ArticleID & "&Page=" & CurrentPage + 1 & "'>下一页</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
On Error Resume Next
strContent = Newasp.ReadContent(Rs("content"))
strContent = Replace(strContent, "[NextPage]", "[page_break]")
strContent = Replace(strContent, "[Page_Break]", "[page_break]")
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 = strContent & "<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=""ContentLabel"">" & strContent & "</div>"
Else
strContent = "<div id=""NewsContentLabel"" class=""ContentLabel""></div>"
End If
Else
strContent = arrContent(CurrentPage - 1)
End If
TempContent = TempContent & strContent
If UserArticle = True Then
TempContent = TempContent & "</p><div id=""Message"" class=""Message""></div><p align='center'><b>"
Else
TempContent = TempContent & "</p><p align='center'><b>"
End If
If CurrentPage > 1 Then
TempContent = TempContent & "<a href='" & ReadPagination(CurrentPage - 1) & "'>上一页</a> "
End If
For i = 1 To Paginate
If i = CurrentPage Then
TempContent = TempContent & "<font color='red'>[" & i & "]</font> "
Else
TempContent = TempContent & "<a href='" & ReadPagination(i) & "'>[" & i & "]</a> "
End If
Next
If CurrentPage < Paginate Then
TempContent = TempContent & " <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
On Error Resume Next
CurrentPage = n
HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ArticleID"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, CurrentPage)
ReadPagination = HtmlFileName
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()
On Error Resume Next
strRelated = Replace(Replace(Replace(Replace(Replace(Replace(Replace(sRelated, "[", ""), "]", ""), "'", ""), "(", ""), ")", ""), "《", ""), "》", "")
strKey = Left(Newasp.ChkQueryStr(topic), 2)
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 & " And A.ArticleID <> " & ArticleID & " ORDER BY A.ArticleID DESC"
Set rsRdlated = Newasp.Execute(SQL)
If rsRdlated.EOF And rsRdlated.BOF Then
RelatedArticle = ""
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -