📄 newschannel.asp
字号:
ListContent = Replace(ListContent, "{$BriefTopic}", sTopic)
ListContent = Replace(ListContent, "{$ArticleID}", Rs("ArticleID"))
ListContent = Replace(ListContent, "{$ArticleHits}", Rs("AllHits"))
ListContent = Replace(ListContent, "{$UserName}", Rs("username"))
ListContent = Replace(ListContent, "{$Star}", Rs("star"))
ListContent = Replace(ListContent, "{$IsBest}", Rs("isBest"))
ListContent = Replace(ListContent, "{$IsTop}", Rs("isTop"))
ListContent = Replace(ListContent, "{$ArticleDateTime}", WriteTime)
ListContent = Replace(ListContent, "{$ArticleContent}", ArticleContent)
ListContent = Replace(ListContent, "{$ListStyle}", ListStyle)
ListContent = Replace(ListContent, "{$Order}", j)
ListContent = Replace(ListContent, "{$PageID}", CurrentPage)
End Sub
Public Function ASPCurrentPage(stype)
Dim CurrentUrl
Select Case stype
Case "1"
CurrentUrl = "&classid=" & Trim(Request("classid")) & "&order=" & Trim(Request("order"))
Case "2"
CurrentUrl = "&sid=" & Trim(Request("sid"))
Case "3", "4", "5"
CurrentUrl = ""
Case Else
If Trim(Request("word")) <> "" Then
CurrentUrl = "&word=" & Trim(Request("word"))
Else
CurrentUrl = "&act=" & Trim(Request("act")) & "&classid=" & Trim(Request("classid")) & "&keyword=" & Trim(Request("keyword"))
End If
End Select
ASPCurrentPage = CurrentUrl
End Function
Private Function ReadListPageName(ClassID, CurrentPage)
ReadListPageName = Newasp.ClassFileName(ClassID, Newasp.HtmlExtName, Newasp.HtmlPrefix, CurrentPage)
End Function
'##############################################################################
'#############################\\执行专题文章开始//#############################
Public Sub ShowArticleSpecial()
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 = CLng(Request("page"))
Else
CurrentPage = 1
End If
SpecialID = Newasp.ChkNumeric(Request("sid"))
Response.Write CreateArticleSpecial(SpecialID, 1)
End If
End Sub
Public Function CreateArticleSpecial(sid, n)
On Error Resume Next
Dim rsPecial
Dim HtmlFileName
PageType = 2
If Not IsNumeric(SpecialID) Then Exit Function
Set rsPecial = Newasp.Execute("select SpecialID,SpecialName,SpecialDir from [NC_Special] where ChannelID = " & ChannelID & " And SpecialID=" & sid)
If rsPecial.BOF And rsPecial.EOF Then
Response.Write ("错误的系统参数!")
Set rsPecial = Nothing
Exit Function
Else
SpecialName = rsPecial("SpecialName")
SpecialID = rsPecial("SpecialID")
SpecialDir = rsPecial("SpecialDir")
skinid = CLng(Newasp.ChannelSkin)
End If
rsPecial.Close: Set rsPecial = Nothing
Newasp.LoadTemplates ChannelID, 4, skinid
If CreateHtml <> 0 Then
HtmlFilePath = Newasp.InstallDir & Newasp.ChannelDir & "special/" & SpecialDir & "/"
Newasp.CreatPathEx (HtmlFilePath)
End If
HtmlContent = Newasp.HtmlContent
HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
HtmlContent = Replace(HtmlContent, "{$SpecialID}", SpecialID)
HtmlContent = Replace(HtmlContent, "{$PageTitle}", SpecialName)
HtmlContent = Replace(HtmlContent, "{$ArticleIndex}", strIndexName)
HtmlContent = Replace(HtmlContent, "{$SpecialName}", SpecialName)
Call ReplaceString
maxperpage = CInt(Newasp.HtmlSetting(1))
If CLng(CurrentPage) = 0 Then CurrentPage = 1
'记录总数
TotalNumber = Newasp.Execute("Select Count(ArticleID) from NC_Article where ChannelID = " & ChannelID & " And isAccept > 0 And SpecialID = " & SpecialID)(0)
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 A.ArticleID,A.ClassID,A.BriefTopic,A.ColorMode,A.FontMode,A.title,A.content,A.Related,A.Author,A.ComeFrom,A.isTop,A.username,A.star,A.isBest,A.WriteTime,A.Allhits,A.HtmlFileDate,C.ClassName,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.SpecialID = " & SpecialID & " order by A.isTop desc, A.WriteTime desc ,A.ArticleID desc"
If isSqlDataBase = 1 Then
If CurrentPage > 100 Then
Rs.Open SQL, Conn, 1, 1
Else
Set Rs = Newasp.Execute(SQL)
End If
Else
Rs.Open SQL, Conn, 1, 1
End If
If Rs.BOF And Rs.EOF Then
'如果没有找到相关内容,清除掉无用的标签代码
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "还没有找到任何专题" & Newasp.ModuleName & "")
HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
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
'如果是生成HTML,执行下面的语句
If CreateHtml <> 0 Then
HtmlFileName = HtmlFilePath & Newasp.SpecialFileName(SpecialID, Newasp.HtmlExtName, 1)
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
'获取模板标签[ShowRepetend][/ReadArticleList]中的字符串
TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
If CreateHtml <> 0 Then
Call LoadArticleListHtml(n)
Else
Call LoadChildListAsp
End If
End If
Rs.Close: Set Rs = Nothing
If CreateHtml = 0 Then CreateArticleSpecial = HtmlContent
Exit Function
End Function
'================================================
'过程名：LoadArticleListHtml
'作 用：装载文章列表并生成HTML
'================================================
Private Sub LoadArticleListHtml(n)
Dim HtmlFileName, strFlush
If IsNull(TempListContent) Then Exit Sub
'On Error Resume Next
For CurrentPage = n To TotalPageNum
Rs.MoveFirst
i = 0
If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
ListContent = ""
j = (CurrentPage - 1) * maxperpage + 1
Do While Not Rs.EOF And i < CInt(maxperpage)
If Not Response.IsClientConnected Then Response.end
Call LoadListDetail
Rs.MoveNext
i = i + 1
j = j + 1
If i >= maxperpage Then Exit Do
Loop
Dim strHtmlFront, strHtmlPage
strHtmlFront = "Special" & Newasp.Supplemental(SpecialID, 3) & "_"
strHtmlPage = htmlshowpage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, strHtmlFront, Newasp.HtmlExtName, SpecialName)
HtmlTemplate = HtmlContent
HtmlTemplate = Replace(HtmlTemplate, TempListContent, ListContent)
HtmlTemplate = Replace(HtmlTemplate, "{$ReadListPage}", strHtmlPage)
HtmlTemplate = Replace(HtmlTemplate, "[ShowRepetend]", "")
HtmlTemplate = Replace(HtmlTemplate, "[/ShowRepetend]", "")
'开始生成子分类的HTML页
HtmlFileName = HtmlFilePath & Newasp.SpecialFileName(SpecialID, Newasp.HtmlExtName, CurrentPage)
Newasp.CreatedTextFile HtmlFileName, HtmlTemplate
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
Exit Sub
End Sub
'================================================
'过程名：ReplaceString
'作 用：替换模板内容
'================================================
Private Sub ReplaceString()
HtmlContent = HTML.ReadCurrentStation(HtmlContent, ChannelID, ClassID, strClassName, ParentID, strParent, strFileDir)
HtmlContent = HTML.ReadAnnounceContent(HtmlContent, ChannelID)
HtmlContent = ReadClassMenu(HtmlContent)
HtmlContent = ReadClassMenubar(HtmlContent)
HtmlContent = HTML.ReadArticlePic(HtmlContent)
HtmlContent = HTML.ReadArticleList(HtmlContent)
HtmlContent = HTML.ReadSoftPic(HtmlContent)
HtmlContent = HTML.ReadSoftList(HtmlContent)
HtmlContent = HTML.ReadNewsPicAndText(HtmlContent)
HtmlContent = HTML.ReadPopularArticle(HtmlContent)
HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
End Sub
'##############################################################################
'#############################\\执行推荐文章开始//#############################
'================================================
'过程名：ShowBestArticle
'作 用：显示推荐文章
'================================================
Public Sub ShowBestArticle()
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 = CLng(Request("page"))
Else
CurrentPage = 1
End If
Response.Write CreateBestArticle(1)
End If
End Sub
'================================================
'过程名：ShowNewArticle
'作 用：显示最新文章
'================================================
Public Sub ShowNewArticle()
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 = CLng(Request("page"))
Else
CurrentPage = 1
End If
Response.Write CreateBestArticle(0)
End If
End Sub
'================================================
'过程名：NewBestArticleList
'作 用：最新推荐文章列表
'================================================
Public Function CreateBestArticle(t)
'On Error Resume Next
Dim HtmlFileName, SQL1, SQL2
skinid = CLng(Newasp.ChannelSkin)
Newasp.LoadTemplates ChannelID, 5, skinid
HtmlFilePath = Newasp.InstallDir & Newasp.ChannelDir & "special/"
HtmlContent = Newasp.HtmlContent
HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
HtmlContent = Replace(HtmlContent, "{$ArticleIndex}", strIndexName)
If t = 1 Then
strClassName = "推荐" & Newasp.ModuleName
HtmlContent = Replace(HtmlContent, "{$PageTitle}", "推荐" & Newasp.ModuleName)
PageType = 3
SQL1 = "And IsBest > 0"
SQL2 = "And A.IsBest > 0"
Else
strClassName = "最新" & Newasp.ModuleName
HtmlContent = Replace(HtmlContent, "{$PageTitle}", "最新" & Newasp.ModuleName)
PageType = 5
SQL1 = ""
SQL2 = ""
End If
Call ReplaceString
maxperpage = CInt(Newasp.HtmlSetting(1))
If CLng(CurrentPage) = 0 Then CurrentPage = 1
'记录总数
TotalNumber = Newasp.Execute("Select Count(ArticleID) from NC_Article where ChannelID = " & ChannelID & " And isAccept > 0 " & SQL1 & "")(0)
If TotalNumber >= CLng(Newasp.HtmlSetting(4)) Then TotalNumber = CLng(Newasp.HtmlSetting(4))
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 = Create⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -