www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/inc/NewsChannel.asp
<!--#include file="ubbcode.asp"-->
<%
Dim NewCloud
Set NewCloud = New NewsChannel_Cls
Class NewsChannel_Cls
Private ChannelID, CreateHtml, keyword
Private Rs, SQL, ChannelRootDir, HtmlContent, strIndexName
Private ArticleID, ArticleContent, skinid, ClassID
Private maxperpage, TotalNumber, TotalPageNum, CurrentPage, i, totalrec
Private strFileDir, ParentID, strParent, strClassName, ChildStr, Child
Private ListContent, TempListContent, HtmlTemplate, HtmlFilePath
Private SpecialID, SpecialName, SpecialDir, PageType, ForbidEssay, strInstallDir
Private IsShowFlush, j, UserArticle,maxstrlen
Private FoundErr,strlen,m_strFileDir,m_strCurrPageName
Public Channel_Setting,xmlFilePath,m_xmlFilePath,m_strXMLPath,TextContent,isxmltext,xmlfilename
Public MakeHtmlMode,MakePageDone,MakeListNum,strBasicPath,ChannelXMLPath,htmlmark
Private Sub Class_Initialize()
On Error Resume Next
FoundErr = False
UserArticle = False
ChannelID = 1
IsShowFlush = 0
strlen = 0
MakeHtmlMode = 0
MakePageDone = 0
'--每页生成数
MakeListNum = 50
htmlmark = 0
End Sub
Private Sub Class_Terminate()
Set HTML = Nothing
End Sub
Public Property Let Channel(chanid)
ChannelID = chanid
End Property
Public Property Let ShowFlush(para)
IsShowFlush = para
End Property
Public Sub ChannelMain()
On Error Resume Next
Newasp.ReadChannel (ChannelID)
CreateHtml = CInt(Newasp.IsCreateHtml)
If Newasp.BindDomain = "0" Then
ChannelRootDir = Newasp.InstallDir & Newasp.ChannelDir
strBasicPath = ""
strInstallDir = Newasp.InstallDir
Else
ChannelRootDir = "/"
strInstallDir = Newasp.SiteUrl & Newasp.InstallDir
If Len(Newasp.NamedPath) > 2 Then
strBasicPath = Newasp.NamedPath
Else
strBasicPath = Server.MapPath(Newasp.InstallDir & Newasp.ChannelDir)
End If
End If
ImagePath = strInstallDir & "images/"
strIndexName = "<a href=""" & ChannelRootDir & """>" & Newasp.ChannelName & "</a>"
ubb.BasePath = ChannelRootDir
ubb.setUbbcode = Join(Newasp.setUserEditor,"|")
ubb.Keyword = Newasp.ContentKeyword
Channel_Setting = Split(Newasp.Channel_Setting & "|||||||||||||||", "|||")
If htmlmark=1 Then
ChannelXMLPath = Newasp.InstallDir & Newasp.ChannelDir
Else
ChannelXMLPath = ChannelRootDir
End If
m_xmlFilePath = Trim(Channel_Setting(12))
If Len(m_xmlFilePath) > 2 And InStr(m_xmlFilePath, ":") > 0 Then
m_strXMLPath = m_xmlFilePath &"\"
Else
m_strXMLPath = Server.MapPath(ChannelXMLPath & m_xmlFilePath) & "\"
End If
m_strXMLPath = Replace(m_strXMLPath, "\\", "\")
End Sub
'#############################\\执行文章首页开始//#############################
'=================================================
'过程名：ShowArticleIndex
'作 用：显示文章首页
'=================================================
Public Sub ShowArticleIndex()
LoadArticleIndex
'If CreateHtml <> 0 Then
'Response.Write "<meta http-equiv=""refresh"" content=""0;url=index" & Newasp.HtmlExtName & """ />"
'Else
Response.Write HtmlContent
'End If
End Sub
'=================================================
'过程名：CreateArticleIndex
'作 用：生成文章首页的HTML
'=================================================
Public Sub CreateArticleIndex()
LoadArticleIndex
Dim FilePath
If Newasp.BindDomain = "0" Then
FilePath = ChannelRootDir & "index" & Newasp.HtmlExtName
Else
FilePath = "\index" & Newasp.HtmlExtName
End If
Newasp.CreatedTextFile strBasicPath & FilePath, HtmlContent
If IsShowFlush = 1 Then Response.Write "<li style=""font-size: 12px;"">生成" & Newasp.ModuleName & "首页HTML完成... " & FilePath & "</li>" & vbNewLine
Response.Flush
End Sub
'=================================================
'过程名：LoadArticleIndex
'作 用：装载文章首页
'=================================================
Private Sub LoadArticleIndex()
Newasp.LoadTemplates ChannelID, 1, Newasp.ChkNumeric(Newasp.ChannelSkin)
HtmlContent = Newasp.HtmlContent
HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
If Len(Newasp.HtmlSetting(1)) < 2 Then
HtmlContent = Replace(HtmlContent, "{$PageTitle}", Newasp.ChannelName)
Else
HtmlContent = Replace(HtmlContent, "{$PageTitle}", Newasp.ChannelName & Newasp.HtmlSetting(1))
End If
HtmlContent = Replace(HtmlContent, "{$ChannelName}", Newasp.ChannelName)
HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
HtmlContent = Replace(HtmlContent, "{$ArticleIndex}", strIndexName)
HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
HtmlContent = HTML.ReadAnnounceContent(HtmlContent, ChannelID)
HtmlContent = ReadClassMenu(HtmlContent)
HtmlContent = ReadClassMenubar(HtmlContent)
HtmlContent = HTML.ReadArticlePic(HtmlContent)
HtmlContent = HTML.ReadSoftPic(HtmlContent)
HtmlContent = HTML.ReadArticleList(HtmlContent)
HtmlContent = HTML.ReadSoftList(HtmlContent)
HtmlContent = HTML.ReadFlashList(HtmlContent)
HtmlContent = HTML.ReadFlashPic(HtmlContent)
HtmlContent = HTML.ReadFriendLink(HtmlContent)
HtmlContent = HTML.ReadNewsPicAndText(HtmlContent)
HtmlContent = HTML.ReadSoftPicAndText(HtmlContent)
HtmlContent = HTML.ReadGuestList(HtmlContent)
HtmlContent = HTML.ReadAnnounceList(HtmlContent)
HtmlContent = HTML.ReadPopularArticle(HtmlContent)
HtmlContent = HTML.ReadPopularSoft(HtmlContent)
HtmlContent = HTML.ReadPopularFlash(HtmlContent)
HtmlContent = HTML.ReadStatistic(HtmlContent)
HtmlContent = HTML.ReadUserRank(HtmlContent)
HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
HtmlContent = HtmlContent
End Sub
'##############################################################################
'#############################\\执行文章内容开始//#############################
'=================================================
'过程名：ShowArticleInfo
'作 用：显示文章内容页面
'=================================================
Public Sub ShowArticleInfo()
If CreateHtml <> 0 Then
Response.Redirect (ChannelRootDir & "index" & Newasp.HtmlExtName)
Exit Sub
Else
Newasp.PreventInfuse
ArticleID = Newasp.ChkNumeric(Request("id"))
CurrentPage = Newasp.ChkNumeric(Request("Page"))
Response.Write ReadArticleContent(ArticleID, CurrentPage)
End If
End Sub
Private Function CheckUserRead(ByVal ArticleID, ByVal PointNum, ByVal UserGroup, ByVal User_Group)
Dim Message, CookiesID
Dim GroupSetting, GroupName, gradeid
If CInt(Newasp.membergrade) = 999 Then Exit Function
If CInt(Newasp.membergrade) <> 0 Then
gradeid = CInt(Newasp.membergrade)
Else
gradeid = 0
End If
GroupSetting = Split(Newasp.UserGroupSetting(gradeid), "|||")
GroupName = GroupSetting(UBound(GroupSetting))
If CInt(User_Group) > CInt(gradeid) Or CInt(UserGroup) > CInt(gradeid) Then
Message = "<li>您没有登录或者你的会员级别不够，不能阅览此文章！</li><li>如果你是本站会员, 请先<a href=""../user/"">登陆</a></li>"
Response.Redirect (strInstallDir & "showerr.asp?action=error&Message=" & Server.URLEncode(Message))
Response.end
End If
Dim rsMember
If CInt(Newasp.memberclass) > 0 Then
Set rsMember = CreateObject("ADODB.Recordset")
SQL = "SELECT userid,UserGrade,UserClass,ExpireTime FROM NC_User WHERE UserClass>0 And username='" & Newasp.membername & "' And userid=" & CLng(Newasp.memberid)
rsMember.Open SQL, Conn, 1, 3
If rsMember.BOF And rsMember.EOF Then
Message = "<li>非法操作~！</li>"
Response.Redirect (strInstallDir & "showerr.asp?action=error&Message=" & Server.URLEncode(Message))
Set rsMember = Nothing
Response.end
Else
If DateDiff("D", CDate(rsMember("ExpireTime")), Now()) > 0 Or CInt(rsMember("UserClass")) = 999 Then
Message = "<li>对不起！您的会员已到期，不能阅览此文章；</li><li>如果你要阅览此文章请联系管理员。</li>"
Response.Redirect (strInstallDir & "showerr.asp?action=error&Message=" & Server.URLEncode(Message))
Set rsMember = Nothing
Response.end
Else
Set rsMember = Nothing
Exit Function
End If
End If
rsMember.Close: Set rsMember = Nothing
Exit Function
End If
CookiesID = "ArticleID_" & ArticleID
If Trim(Request.Cookies("ReadArticle")) = "" Then
Response.Cookies("ReadArticle")("userip") = Newasp.GetUserip
Response.Cookies("ReadArticle").Expires = Date + 1
End If
If CLng(Request.Cookies("ReadArticle")(CookiesID)) <> CLng(ArticleID) And CInt(UserGroup) > 0 Then
Set rsMember = CreateObject("ADODB.Recordset")
SQL = "SELECT userid,UserGrade,userpoint,ExpireTime FROM NC_User WHERE username='" & Newasp.membername & "' And userid=" & CLng(Newasp.memberid)
rsMember.Open SQL, Conn, 1, 3
If rsMember.BOF And rsMember.EOF Then
Message = "<li>非法操作~！</li>"
Response.Redirect (strInstallDir & "showerr.asp?action=error&Message=" & Server.URLEncode(Message))
Set rsMember = Nothing
Response.end
Else
If CInt(rsMember("UserGrade")) < CInt(UserGroup) Then
Message = "<li>您的级别不够，阅览此文章需要<font color=blue>" & GroupName & "</font>以上级别的会员；</li><li>如果你要阅览此文章请联系管理员。</li>"
Response.Redirect (strInstallDir & "showerr.asp?action=error&Message=" & Server.URLEncode(Message))
Set rsMember = Nothing
Response.end
End If
If CLng(rsMember("userpoint")) < CLng(PointNum) Then
Message = "<li>对不起!您的点数不足。不能阅览此文章</li><li>阅览此文章所需的点数：" & PointNum & "</li><li>如果你确实要阅览此文章请到<a href=""../user/"">会员中心</a>充值。</li>"
Response.Redirect (strInstallDir & "showerr.asp?action=error&Message=" & Server.URLEncode(Message))
Set rsMember = Nothing
Response.end
End If
rsMember("userpoint") = CLng(rsMember("userpoint") - PointNum)
rsMember.Update
Response.Cookies("ReadArticle")(CookiesID) = ArticleID
End If
rsMember.Close: Set rsMember = Nothing
End If
UserArticle = False
End Function
'=================================================
'函数名：ReadArticleContent
'作 用：读取文章内容
'参 数：ArticleID ----文章ID
'=================================================
Private Function ReadArticleContent(ArticleID, CurrentPage)
Dim ThisUrl
Dim subtitle, HeaderTitle,HeaderTitles,HeaderTopic,HeaderTopics
If Not IsNumeric(ArticleID) Then
Exit Function
Else
ArticleID = CLng(ArticleID)
End If
If CurrentPage = 0 Then CurrentPage = 1
SQL = "SELECT A.ArticleID,A.ClassID,A.title,A.subtitle,A.[content],A.Related,A.Author,A.ComeFrom,A.isTop,A.username,A.star,A.isBest,A.WriteTime,A.AllHits,A.HtmlFileDate,A.UserGroup,A.PointNum,A.AutoPages,A.isxmltext,A.xmlfilename,C.ClassName,C.ParentID,C.ParentStr,C.skinid,C.HtmlFileDir,C.ChildStr,C.UserGroup As User_Group,C.UseHtml,C.AdsCode,C.stopad 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 Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
ReadArticleContent = ""
Set Rs = Nothing
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
Exit Function
End If
If Rs("UserGroup") > 0 Or Rs("User_Group") >0 Then
UserArticle = True
Else
UserArticle = False
End If
If Rs("skinid") <> 0 Then
skinid = Rs("skinid")
Else
skinid = Newasp.ChkNumeric(Newasp.ChannelSkin)
End If
'--如果是XML文件,就从XML文件中读出内容------
isxmltext = Newasp.ChkNumeric(Rs("isxmltext"))
xmlfilename = Rs("xmlfilename") & ""
If isxmltext = 1 Then
xmlFilePath = m_strXMLPath & xmlfilename
TextContent = Newasp.ReadXMLDocument(xmlFilePath,"article/@content")
If TextContent = "" Then TextContent = Rs("content") & ""
TextContent = TextContent
Else
TextContent = Rs("content")
End If
'---------------------------------------------
Newasp.LoadTemplates ChannelID, 3, skinid
'-- 限制会员文章显示字符数
maxstrlen = CInt(Newasp.ChkNumeric(Newasp.HtmlSetting(8)))
If maxstrlen < 5 Then maxstrlen = 300
'--是否自动分页
ubb.Pagination = Newasp.ChkNumeric(Rs("AutoPages"))
If CreateHtml <> 0 Then
ArticleContent = HtmlPagination(CurrentPage)
ThisUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("ArticleID"),1,"")
Else
CheckUserRead Rs("ArticleID"), Rs("PointNum"), Rs("UserGroup"), Rs("User_Group")
Call ContentPagination
If IsURLRewrite Then
ThisUrl = ChannelRootDir & Rs("ArticleID") & Newasp.HtmlExtName
Else
ThisUrl = ChannelRootDir & "show.asp?id=" & Rs("ArticleID")
End If
End If
'--副标题
subtitle = Rs("subtitle") & ""
HtmlContent = Newasp.HtmlContent
'-- 新增分类广告代码
HtmlContent = AdsReplace(HtmlContent,Rs("AdsCode"),Rs("stopad"))
HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
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)
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 = 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.ReadStatistic(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 = Newasp.SiteName
HeaderTopics = ""
Else
HeaderTitle = subtitle
HeaderTitles = " - " & subtitle
HeaderTopic = subtitle
HeaderTopics = "," & subtitle
End If
HtmlContent = Replace(HtmlContent, "{$HeaderTitle}", HeaderTitle)
HtmlContent = Replace(HtmlContent, "{$HeaderTitles}", HeaderTitles)
HtmlContent = Replace(HtmlContent, "{$HeaderTopic}", HeaderTopic)
HtmlContent = Replace(HtmlContent, "{$HeaderTopics}", HeaderTopics)
HtmlContent = Replace(HtmlContent, "{$ParentClass}", HTML.ParentClass)
HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
HtmlContent = Replace(HtmlContent, "{$HeadTitle}", Rs("title")&"")
HtmlContent = Replace(HtmlContent, "{$ArticleTitle}", Rs("title")&"")
HtmlContent = Replace(HtmlContent, "{$ArticleContent}", ArticleContent)
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, " ", "")
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), """)
strHtml = Replace(strHtml, Chr(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,A.isxmltext,A.xmlfilename,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
'--如果是XML文件,就从XML文件中读出内容------
isxmltext = Newasp.ChkNumeric(rsCreate("isxmltext"))
xmlfilename = rsCreate("xmlfilename") & ""
If isxmltext = 1 Then
xmlFilePath = m_strXMLPath & xmlfilename
TextContent = Newasp.ReadXMLDocument(xmlFilePath,"article/@content")
If TextContent = "" Then TextContent = rsCreate("content") & ""
Else
TextContent = rsCreate("content")
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(TextContent)
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(TextContent)
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> "
Else
ArticleContent = ArticleContent & "<a href="""& m_strFileUrl & CurrentPage - 1 & m_strFileExt & """>上一页</a> "
End If
End If
For i = 1 To Paginate
If i = CurrentPage Then
ArticleContent = ArticleContent & "<font color=""red"">[" & CStr(i) & "]</font> "
Else
If IsURLRewrite And i = 1 Then
ArticleContent = ArticleContent & "<a href="""& ArticleID & m_strFileExt & """>[" & i & "]</a> "
Else
ArticleContent = ArticleContent & "<a href="""& m_strFileUrl & i & m_strFileExt & """>[" & i & "]</a> "
End if
End If
Next
If CurrentPage < Paginate Then
ArticleContent = ArticleContent & " <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(TextContent)
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> "
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
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()
On Error Resume Next
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 = Server.CreateObject("ADODB.Recordset")
rsRdlated.Open SQL, Conn, 1, 1
If Err Then
rsRdlated.Close:Set rsRdlated = Nothing
Exit Function
End If
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 Audit=0 And postid = " & ArticleID & " ORDER BY 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
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 = Newasp.ChkNumeric(Newasp.ChannelSkin)
End If
AdsCode = rsClass("AdsCode")
stopad = rsClass("stopad")
End If
rsClass.Close: Set rsClass = Nothing
Newasp.LoadTemplates ChannelID, 2, skinid
PageType = 1
m_strFilePath = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, "",strFileDir,ClassID,0,1,"")
HtmlFilePath = Newasp.HtmlFilesPath
m_strFileDir = 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, "{$ThisClassName}", strClassName)
HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
HtmlContent = Replace(HtmlContent, "{$ArticleIndex}", strIndexName)
If Child <> 0 And showtree <> 9 Then
Call LoadParentList
Call ReplaceContent
If CInt(CreateHtml) <> 0 Then
'创建分类目录
Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
'开始生成父级分类的HTML页
HtmlFileName = m_strFilePath
Newasp.CreatedTextFile strBasicPath & HtmlFileName, HtmlContent
If IsShowFlush = 1 Then Response.Write "<li style=""font-size: 12px;"">生成[<font color=""red"">" & strClassName & "</font>]分类列表HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
Response.Flush
MakePageDone = 1
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"
ElseIf Newasp.CheckStr(LCase(Request("order"))) = "topic" Then
strOrder = "ORDER BY A.isTop DESC, A.title DESC ,A.ArticleID DESC"
Else
strOrder = "ORDER BY A.isTop DESC, A.WriteTime DESC ,A.ArticleID DESC"
End If
TotalNumber = Newasp.Execute("SELECT Count(ArticleID) FROM NC_Article WHERE ChannelID = " & ChannelID & " And isAccept > 0 And ClassID in (" & ChildStr & ")")(0)
totalrec = TotalNumber
'-- 如果开启了父分类显示功能,限制显示数
If Child > 0 And TotalNumber > MaxListnum And MaxListnum <> 999 Then
strMaxListop = " TOP " & MaxListnum
TotalNumber = MaxListnum
Else
strMaxListop = vbNullString
End If
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 " & strMaxListop & " A.ArticleID,A.ClassID,A.BriefTopic,A.ColorMode,A.FontMode,A.title,A.[content],A.Related,A.Author,A.ComeFrom,A.ImageUrl,A.isTop,A.username,A.star,A.isBest,A.WriteTime,A.AllHits,A.HtmlFileDate,A.isxmltext,A.xmlfilename,C.ClassName,C.ParentID,C.ParentStr,C.skinid,C.HtmlFileDir,C.ChildStr FROM [NC_Article] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID where A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.ClassID in (" & ChildStr & ") " & strOrder & ""
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, "{$PageTitle}", strClassName)
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "还没有找到任何" & Newasp.ModuleName & "")
HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
If CreateHtml <> 0 Then
Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
HtmlFileName = m_strFilePath
Newasp.CreatedTextFile strBasicPath & HtmlFileName, HtmlContent
If IsShowFlush = 1 Then
Response.Write "<li style=""font-size: 12px;"">生成[<font color=""red"">" & strClassName & "</font>]分类列表HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
Response.Flush
End If
MakePageDone = 1
End If
Else
TotalNumber = totalrec
TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
If CreateHtml <> 0 Then
Call LoadChildListHtml(n)
Else
Call LoadChildListAsp
End If
End If
Rs.Close: Set Rs = Nothing
End If
If CreateHtml = 0 Then CreateArticleList = HtmlContent
End Function
'================================================
'过程名：ReplaceContent
'作 用：替换模板内容
'================================================
Private Sub ReplaceContent()
HtmlContent = HTML.ReadCurrentStation(HtmlContent, ChannelID, ClassID, strClassName, ParentID, strParent, strFileDir)
HtmlContent = HTML.ReadAnnounceContent(HtmlContent, ChannelID)
HtmlContent = ReadClassMenubar(HtmlContent)
HtmlContent = ReadClassMenu(HtmlContent)
HtmlContent = HTML.ReadArticlePic(HtmlContent)
HtmlContent = HTML.ReadArticleList(HtmlContent)
HtmlContent = HTML.ReadNewsPicAndText(HtmlContent)
HtmlContent = HTML.ReadSoftPicAndText(HtmlContent)
HtmlContent = HTML.ReadPopularArticle(HtmlContent)
HtmlContent = HTML.ReadPopularSoft(HtmlContent)
HtmlContent = HTML.ReadStatistic(HtmlContent)
HtmlContent = HTML.ReadSoftPic(HtmlContent)
HtmlContent = HTML.ReadSoftList(HtmlContent)
HtmlContent = HTML.ReadFlashList(HtmlContent)
HtmlContent = HTML.ReadFlashPic(HtmlContent)
HtmlContent = Replace(HtmlContent, "{$CurrentClass}", HTML.CurrentClass)
Dim strPageTitle
If Len(Trim(Newasp.HtmlSetting(11))) > 1 Then
strPageTitle = HTML.CurrentClass & Newasp.HtmlSetting(11)
Else
strPageTitle = HTML.CurrentClass
End If
HtmlContent = Replace(HtmlContent, "{$PageTitle}", strPageTitle)
HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
End Sub
'================================================
'过程名：LoadParentList
'作 用：装载父级文章列表
'================================================
Private Sub LoadParentList()
Dim rsClslist, strContent, i, showtree
Dim ClassUrl, ClassNameStr,n
showtree = Trim(Newasp.HtmlSetting(4))
PageType = 1
TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
If Not IsNull(TempListContent) Then
SQL = "SELECT TOP " & CInt(Newasp.HtmlSetting(5)) & " ClassID,ClassName,HtmlFileDir FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And TurnLink = 0 And ParentID=" & ClassID & " ORDER BY orders ASC, ClassID ASC"
Set rsClslist = Newasp.Execute(SQL)
If rsClslist.BOF And rsClslist.EOF Then
Set rsClslist = Nothing
Exit Sub
Else
n = 0
If showtree <> "1" Then strContent = "<table width=""100%"" align=""center"" border=""0"" cellpadding=""0"" cellspacing=""0"" class=""tablist"">" & vbCrLf
Do While Not rsClslist.EOF
If showtree <> "1" Then
strContent = strContent & "<tr valign=""top"">" & vbCrLf
Else
strContent = strContent & "<div class=""mainParentListArea"">"
End If
For i = 1 To 2
n = n + 1
If showtree <> "1" Then strContent = strContent & "<td class=""tdlist"">"
If Not (rsClslist.EOF) Then
strContent = strContent & TempListContent
If CInt(CreateHtml) <> 0 Then
ClassUrl = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, "",rsClslist("HtmlFileDir"),rsClslist("ClassID"),0,1,"")
Else
If IsURLRewrite Then
ClassUrl = ChannelRootDir & "list_1_" & rsClslist("ClassID") & Newasp.HtmlExtName
Else
ClassUrl = ChannelRootDir & "list.asp?classid=" & rsClslist("ClassID")
End If
End If
ClassNameStr = "<a href=""" & ClassUrl & """ class=""showtitle"">" & rsClslist("ClassName") & "</a>"
strContent = Replace(strContent, "{$ChannelID}", ChannelID)
strContent = Replace(strContent, "{$ClassifyID}", rsClslist("ClassID"))
strContent = Replace(strContent, "{$ClassName}", ClassNameStr)
strContent = Replace(strContent, "{$ClassUrl}", ClassUrl)
strContent = Replace(strContent, "{$n}", n)
strContent = Replace(strContent, "{$i}", i)
If showtree <> "1" Then strContent = strContent & "</td>" & vbCrLf
rsClslist.MoveNext
Else
If showtree <> "1" Then strContent = strContent & "</td>" & vbCrLf
End If
Next
If showtree <> "1" Then
strContent = strContent & "</tr>" & vbCrLf
Else
strContent = strContent & "</div>" & vbCrLf
End If
Loop
If showtree <> "1" Then strContent = strContent & "</table>" & vbCrLf
End If
HtmlContent = Replace(HtmlContent, TempListContent, strContent)
HtmlContent = Replace(HtmlContent, "[ShowRepetend]", "")
HtmlContent = Replace(HtmlContent, "[/ShowRepetend]", "")
rsClslist.Close: Set rsClslist = Nothing
End If
End Sub
'================================================
'过程名：LoadChildListHtml
'作 用：装载子级文章列表HTML
'================================================
Private Sub LoadChildListHtml(n)
Dim Perownum
Dim PerPageNum,c
Perownum = Newasp.ChkNumeric(Newasp.HtmlSetting(8))
PerPageNum = MakeListNum
If IsNull(TempListContent) Then Exit Sub
If n > TotalPageNum Then
MakePageDone = 1
Exit Sub
End If
'创建分类目录
Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
If MakeHtmlMode = 0 Then
For CurrentPage = n To TotalPageNum
Call CreateListHtml(CurrentPage,Perownum)
Next
Else
c = 1
For CurrentPage = n To TotalPageNum
c = c + 1
If CurrentPage > TotalPageNum Then Exit For
Call CreateListHtml(CurrentPage,Perownum)
If c > PerPageNum Then Exit Sub
Next
MakePageDone = 1
End If
End Sub
Private Sub CreateListHtml(CurrentPage,Perownum)
If CurrentPage > TotalPageNum Then MakePageDone = 1 : Exit Sub
Dim HtmlFileName
Dim ii,w
Rs.MoveFirst
i = 0
If CurrentPage < 1 Then CurrentPage = 1
If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
ListContent = ""
j = (CurrentPage - 1) * maxperpage + 1
If Perownum > 1 Then
ListContent = Newasp.HtmlSetting(9)
w = FormatPercent(100 / Perownum / 100,0)
End If
Do While Not Rs.EOF And i < CInt(maxperpage)
If Not Response.IsClientConnected Then Response.end
If Perownum > 1 Then
ListContent = ListContent & "<tr valign=""top"">" & vbCrLf
For ii = 1 To Perownum
ListContent = ListContent & "<td width=""" & w & """ class=""shoplistrow"">"
If Not Rs.EOF Then
Call LoadListDetail
Rs.movenext
i = i + 1
j = j + 1
End If
ListContent = ListContent & "</td>" & vbCrLf
Next
ListContent = ListContent & "</tr>" & vbCrLf
Else
Call LoadListDetail
Rs.MoveNext
i = i + 1
j = j + 1
End If
If i >= maxperpage Then Exit Do
Loop
'--开始生成文章内容的HTML页面
Dim strHtmlFront, strHtmlPage
HtmlFileName = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, "",m_strFileDir,ClassID,0,CurrentPage,"page")
strHtmlPage = showhtmlpage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, Newasp.HtmlFilesName, strClassName)
HtmlTemplate = HtmlContent
HtmlTemplate = Replace(HtmlTemplate, TempListContent, ListContent)
HtmlTemplate = Replace(HtmlTemplate, "{$ReadListPage}", strHtmlPage)
HtmlTemplate = Replace(HtmlTemplate, "[ShowRepetend]", "")
HtmlTemplate = Replace(HtmlTemplate, "[/ShowRepetend]", "")
'开始生成子分类的HTML页
Newasp.CreatedTextFile strBasicPath & HtmlFileName, HtmlTemplate
If IsShowFlush = 1 Then
Response.Write "<li style=""font-size: 12px;"">生成[<font color=""red"">" & strClassName & "</font>]分类列表HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
Response.Flush
End If
End Sub
'================================================
'过程名：LoadChildListAsp
'作 用：装载子级文章列表ASP
'================================================
Private Sub LoadChildListAsp()
If IsNull(TempListContent) Then Exit Sub
Dim Perownum,ii,w
Perownum = Newasp.ChkNumeric(Newasp.HtmlSetting(8))
i = 0
Rs.MoveFirst
If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
ListContent = ""
j = (CurrentPage - 1) * maxperpage + 1
If Perownum > 1 Then
ListContent = Newasp.HtmlSetting(9)
w = FormatPercent(100 / Perownum / 100,0)
End If
Do While Not Rs.EOF And i < CInt(maxperpage)
If Not Response.IsClientConnected Then Response.end
If Perownum > 1 Then
ListContent = ListContent & "<tr valign=""top"">" & vbCrLf
For ii = 1 To Perownum
ListContent = ListContent & "<td width=""" & w & """ class=""shoplistrow"">"
If Not Rs.EOF Then
Call LoadListDetail
Rs.movenext
i = i + 1
j = j + 1
End If
ListContent = ListContent & "</td>" & vbCrLf
Next
ListContent = ListContent & "</tr>" & vbCrLf
Else
Call LoadListDetail
Rs.MoveNext
i = i + 1
j = j + 1
End If
If i >= maxperpage Then Exit Do
Loop
Dim strPagination
strPagination = ShowListPage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, ASPCurrentPage(PageType), strClassName)
HtmlContent = Replace(HtmlContent, TempListContent, ListContent)
HtmlContent = Replace(HtmlContent, "[ShowRepetend]", "")
HtmlContent = Replace(HtmlContent, "[/ShowRepetend]", "")
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", strPagination)
End Sub
'================================================
'过程名：LoadListDetail
'作 用：装载子级文章列表细节
'================================================
Private Sub LoadListDetail()
Dim sTitle, sTopic, ArticleTitle, ListStyle,ImageUrl,Thumbnail
Dim ArticleContent, ArticleUrl, WriteTime, sClassName
ListContent = ListContent & TempListContent
If (i Mod 2) = 0 Then
ListStyle = 1
Else
ListStyle = 2
End If
If strlen > 0 Then
sTitle = Newasp.GotTopic(Rs("title"),strlen)
Else
sTitle = Rs("title")
End If
sTitle = Newasp.ReadFontMode(sTitle, Rs("ColorMode"), Rs("FontMode"))
sTopic = Newasp.ReadPicTopic(Rs("BriefTopic"))
If CInt(CreateHtml) <> 0 Then
ArticleUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("ArticleID"),1,"")
sClassName = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("ArticleID"),1,"")
Else
If IsURLRewrite Then
ArticleUrl = ChannelRootDir & Rs("ArticleID") & Newasp.HtmlExtName
sClassName = ChannelRootDir & "list_1_" & Rs("ClassID") & Newasp.HtmlExtName
Else
ArticleUrl = ChannelRootDir & "show.asp?id=" & Rs("ArticleID")
sClassName = ChannelRootDir & "list.asp?classid=" & Rs("ClassID")
End If
End If
sClassName = "<a href=""" & sClassName & """>" & Rs("ClassName") & "</a>"
ArticleTitle = "<a href=""" & ArticleUrl & """" & LoadRemark(Rs("title")) & ">" & sTitle & "</a>"
'--如果是XML文件,就从XML文件中读出内容------
isxmltext = Newasp.ChkNumeric(Rs("isxmltext"))
xmlfilename = Rs("xmlfilename") & ""
If isxmltext = 1 Then
xmlFilePath = m_strXMLPath & xmlfilename
TextContent = Newasp.ReadXMLDocument(xmlFilePath,"article/@content")
If TextContent = "" Then TextContent = Rs("content") & ""
Else
TextContent = Rs("content")
End If
'---------------------------------------------
ArticleContent = Replace(TextContent, "[page_break]", "")
ArticleContent = Newasp.CutString(ArticleContent, CInt(Newasp.HtmlSetting(3)))
'--缩略图
ImageUrl = Newasp.GetImageUrl(Rs("ImageUrl"), ChannelRootDir)
ImageUrl = Newasp.GetFlashAndPic(ImageUrl, Newasp.HtmlSetting(6), Newasp.HtmlSetting(7))
Thumbnail = "<a href=""" & ArticleUrl & """ title=""" & Rs("title") & """>" & ImageUrl & "</a>"
WriteTime = Newasp.ShowDateTime(Rs("WriteTime"), CInt(Newasp.HtmlSetting(2)))
WriteTime = Replace(WriteTime, " globalDate", "")
ListContent = Replace(ListContent, "{$ImageUrl}", ImageUrl)
ListContent = Replace(ListContent, "{$Thumbnail}", Thumbnail)
ListContent = Replace(ListContent, "{$ClassifyName}", sClassName)
ListContent = Replace(ListContent, "{$ArticleUrl}", ArticleUrl)
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, "{$ListStyle}", ListStyle)
ListContent = Replace(ListContent, "{$Order}", j)
ListContent = Replace(ListContent, "{$i}", i+1)
ListContent = Replace(ListContent, "{$PageID}", CurrentPage)
ListContent = Replace(ListContent, "{$ArticleTitle}", ArticleTitle)
ListContent = Replace(ListContent, "{$ArticleTopic}", sTitle)
ListContent = Replace(ListContent, "{$ArticleContent}", ArticleContent)
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()
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)
Dim rsPecial
Dim HtmlFileName
m_strCurrPageName = "special"
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 = Newasp.ChkNumeric(Newasp.ChannelSkin)
End If
rsPecial.Close: Set rsPecial = Nothing
strClassName = SpecialName
m_strCurrPageName = SpecialDir
Newasp.LoadTemplates ChannelID, 4, skinid
If CreateHtml <> 0 Then
HtmlFileName = Newasp.ReadDestination(Newasp.MoreDestination, Newasp.ChannelDir, "",SpecialDir & "/",SpecialID,SpecialID,1,m_strCurrPageName)
HtmlFilePath = Newasp.HtmlFilesPath
Newasp.CreatPathEx (strBasicPath & 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, "{$IndexTitle}", strIndexName)
HtmlContent = Replace(HtmlContent, "{$SpecialName}", SpecialName)
Call ReplaceString
strlen = Newasp.ChkNumeric(Newasp.HtmlSetting(10))
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.ImageUrl,A.isTop,A.username,A.star,A.isBest,A.WriteTime,A.AllHits,A.HtmlFileDate,A.isxmltext,A.xmlfilename,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), "")
'如果是生成HTML,执行下面的语句
If CreateHtml <> 0 Then
Newasp.CreatedTextFile strBasicPath & 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
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 strHtmlPage
HtmlFileName = Newasp.ReadDestination(Newasp.MoreDestination, Newasp.ChannelDir, "",SpecialDir & "/",SpecialID,SpecialID,CurrentPage,m_strCurrPageName)
strHtmlPage = showhtmlpage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, Newasp.HtmlFilesName, SpecialName)
HtmlTemplate = HtmlContent
HtmlTemplate = Replace(HtmlTemplate, TempListContent, ListContent)
HtmlTemplate = Replace(HtmlTemplate, "{$ReadListPage}", strHtmlPage)
HtmlTemplate = Replace(HtmlTemplate, "[ShowRepetend]", "")
HtmlTemplate = Replace(HtmlTemplate, "[/ShowRepetend]", "")
'开始生成子分类的HTML页
Newasp.CreatedTextFile strBasicPath & 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.ReadNewsPicAndText(HtmlContent)
HtmlContent = HTML.ReadPopularArticle(HtmlContent)
HtmlContent = HTML.ReadSoftPic(HtmlContent)
HtmlContent = HTML.ReadSoftList(HtmlContent)
HtmlContent = HTML.ReadFlashList(HtmlContent)
HtmlContent = HTML.ReadFlashPic(HtmlContent)
HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
End Sub
'##############################################################################
'#############################\\执行推荐文章开始//#############################
'================================================
'过程名：ShowBestArticle
'作 用：显示推荐文章
'================================================
Public Sub ShowBestArticle()
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()
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)
Dim HtmlFileName, SQL1, SQL2
skinid = Newasp.ChkNumeric(Newasp.ChannelSkin)
Newasp.LoadTemplates ChannelID, 5, skinid
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)
HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
strlen = Newasp.ChkNumeric(Newasp.HtmlSetting(11))
If t = 1 Then
strClassName = "推荐" & Newasp.ModuleName
HtmlContent = Replace(HtmlContent, "{$PageTitle}", "推荐" & Newasp.ModuleName)
PageType = 3
SQL1 = "And IsBest > 0"
SQL2 = "And A.IsBest > 0"
m_strCurrPageName = "best"
Else
strClassName = "最新" & Newasp.ModuleName
HtmlContent = Replace(HtmlContent, "{$PageTitle}", "最新" & Newasp.ModuleName)
PageType = 5
SQL1 = ""
SQL2 = ""
m_strCurrPageName = "new"
End If
'--获取HTML文件路径
If CreateHtml <> 0 Then
HtmlFileName = Newasp.ReadDestination(Newasp.MoreDestination, Newasp.ChannelDir, "",m_strCurrPageName & "/",t,t,1,m_strCurrPageName)
HtmlFilePath = Newasp.HtmlFilesPath
Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
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 = CreateObject("ADODB.Recordset")
SQL = "SELECT TOP " & CLng(Newasp.HtmlSetting(4)) & " A.ArticleID,A.ClassID,A.BriefTopic,A.ColorMode,A.FontMode,A.title,A.[content],A.Related,A.Author,A.ComeFrom,A.ImageUrl,A.isTop,A.username,A.star,A.isBest,A.WriteTime,A.AllHits,A.HtmlFileDate,A.isxmltext,A.xmlfilename,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 " & SQL2 & " ORDER BY 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), "")
'如果是生成HTML,执行下面的语句
If CreateHtml <> 0 Then
Newasp.CreatedTextFile strBasicPath & HtmlFileName, HtmlContent
If IsShowFlush = 1 Then
Response.Write "<li style=""font-size: 12px;"">生成" & strClassName & "HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
Response.Flush
End If
End If
Else
'获取模板标签[ShowRepetend][/ReadArticleList]中的字符串
TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
If CreateHtml <> 0 Then
Call LoadBestArticleListHtml(t)
Else
Call LoadChildListAsp
End If
End If
Rs.Close: Set Rs = Nothing
If CreateHtml = 0 Then Response.Write HtmlContent
Exit Function
End Function
'================================================
'过程名：LoadBestArticleListHtml
'作 用：装载文章列表并生成HTML
'================================================
Private Sub LoadBestArticleListHtml(t)
Dim HtmlFileName, sulCurrentPage
If IsNull(TempListContent) Then Exit Sub
For CurrentPage = 1 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 strHtmlPage
HtmlFileName = Newasp.ReadDestination(Newasp.MoreDestination, Newasp.ChannelDir, "",m_strCurrPageName & "/",t,t,CurrentPage,m_strCurrPageName)
strHtmlPage = showhtmlpage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, Newasp.HtmlFilesName, strClassName)
HtmlTemplate = HtmlContent
HtmlTemplate = Replace(HtmlTemplate, TempListContent, ListContent)
HtmlTemplate = Replace(HtmlTemplate, "{$ReadListPage}", strHtmlPage)
HtmlTemplate = Replace(HtmlTemplate, "[ShowRepetend]", "")
HtmlTemplate = Replace(HtmlTemplate, "[/ShowRepetend]", "")
'开始生成子分类的HTML页
Newasp.CreatedTextFile strBasicPath & HtmlFileName, HtmlTemplate
If IsShowFlush = 1 Then
Response.Write "<li style=""font-size: 12px;"">生成" & strClassName & "HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
Response.Flush
End If
Next
Exit Sub
End Sub
'##############################################################################
'#############################\\执行热门文章开始//#############################
'================================================
'过程名：ShowNewArticle
'作 用：显示最新文章
'================================================
Public Sub ShowHotArticle()
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 CreateHotArticle()
End If
End Sub
Public Function CreateHotArticle()
Dim HtmlFileName
PageType = 4
skinid = Newasp.ChkNumeric(Newasp.ChannelSkin)
Newasp.LoadTemplates ChannelID, 6, skinid
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)
HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
HtmlContent = Replace(HtmlContent, "{$PageTitle}", "阅览排行")
strlen = Newasp.ChkNumeric(Newasp.HtmlSetting(11))
Call ReplaceString
strClassName = "阅览排行"
m_strCurrPageName = "hot"
'--获取HTML文件路径
If CreateHtml <> 0 Then
HtmlFileName = Newasp.ReadDestination(Newasp.MoreDestination, Newasp.ChannelDir, "",m_strCurrPageName & "/",3,3,1,m_strCurrPageName)
HtmlFilePath = Newasp.HtmlFilesPath
Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
End If
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 AllHits > " & CLng(Newasp.LeastHotHist) & "")(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 = CreateObject("ADODB.Recordset")
SQL = "SELECT TOP " & CLng(Newasp.HtmlSetting(4)) & " A.ArticleID,A.ClassID,A.BriefTopic,A.ColorMode,A.FontMode,A.title,A.[content],A.Related,A.Author,A.ComeFrom,A.ImageUrl,A.isTop,A.username,A.star,A.isBest,A.WriteTime,A.AllHits,A.HtmlFileDate,A.isxmltext,A.xmlfilename,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.AllHits > " & CLng(Newasp.LeastHotHist) & " ORDER BY A.AllHits DESC, A.WriteTime DESC ,A.ArticleID DESC"
If isSqlDataBase = 1 Then
Set Rs = Newasp.Execute(SQL)
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), "")
'如果是生成HTML,执行下面的语句
If CreateHtml <> 0 Then
Newasp.CreatedTextFile strBasicPath & 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 LoadHotArticleListHtml
Else
Call LoadChildListAsp
End If
End If
Rs.Close: Set Rs = Nothing
If CreateHtml = 0 Then Response.Write HtmlContent
Exit Function
End Function
'================================================
'过程名：LoadHotArticleListHtml
'作 用：装载文章列表并生成HTML
'================================================
Private Sub LoadHotArticleListHtml()
Dim HtmlFileName, sulCurrentPage
If IsNull(TempListContent) Then Exit Sub
For CurrentPage = 1 To TotalPageNum
Rs.MoveFirst
i = 0
If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
'Dim bookmark:bookmark = Rs.bookmark
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 strHtmlPage
HtmlFileName = Newasp.ReadDestination(Newasp.MoreDestination, Newasp.ChannelDir, "",m_strCurrPageName & "/",3,3,CurrentPage,m_strCurrPageName)
strHtmlPage = showhtmlpage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, Newasp.HtmlFilesName, strClassName)
HtmlTemplate = HtmlContent
HtmlTemplate = Replace(HtmlTemplate, TempListContent, ListContent)
HtmlTemplate = Replace(HtmlTemplate, "{$ReadListPage}", strHtmlPage)
HtmlTemplate = Replace(HtmlTemplate, "[ShowRepetend]", "")
HtmlTemplate = Replace(HtmlTemplate, "[/ShowRepetend]", "")
'开始生成子分类的HTML页
Newasp.CreatedTextFile strBasicPath & 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
End If
Next
Exit Sub
End Sub
'##########################################################################
'#############################\\文章搜索开始//#############################
Public Sub ShowArticleSearch()
Dim SearchMaxPageList
Dim Action, findword
Dim rsClass, strNoResult
Dim strWord, s
PageType = 6
keyword = Newasp.ChkQueryStr(Trim(Request("keyword")))
keyword = Newasp.CheckInfuse(keyword,255)
strWord = Newasp.CheckStr(Trim(Request("word")))
strWord = Newasp.CheckInfuse(strWord,10)
s = Newasp.ChkNumeric(Request.QueryString("s"))
If Newasp.CheckNull(strWord) Then
strWord = UCase(Left(strWord, 6))
keyword = strWord
Else
strWord = ""
End If
If keyword = "" And strWord = "" Then
Call OutAlertScript("请输入要查询的关键字！")
Exit Sub
End If
If strWord = "" Then
If Not Newasp.CheckQuery(keyword) Then
Call OutAlertScript("你查询的关键中有非法字符！\n请返回重新输入关键字查询。")
Exit Sub
End If
End If
skinid = Newasp.ChkNumeric(Newasp.ChannelSkin)
On Error Resume Next
Newasp.LoadTemplates ChannelID, 7, skinid
If Newasp.HtmlSetting(4) <> "0" Then
If IsNumeric(Newasp.HtmlSetting(4)) Then
SearchMaxPageList = Newasp.ChkNumeric(Newasp.HtmlSetting(4))
Else
SearchMaxPageList = 50
End If
Else
SearchMaxPageList = 50
End If
strNoResult = Replace(Newasp.HtmlSetting(8), "{$KeyWord}", keyword)
Action = Newasp.CheckStr(Trim(Request("act")))
Action = Newasp.CheckStr(Action)
If strWord = "" And LCase(Action) <> "isweb" Then
If Newasp.strLength(keyword) < CLng(Newasp.HtmlSetting(5)) Or Newasp.strLength(keyword) > CLng(Newasp.HtmlSetting(6)) Then
Call OutAlertScript("查询错误！\n您查询的关键字不能小于 " & Newasp.HtmlSetting(5) & " 或者大于 " & Newasp.HtmlSetting(6) & " 个字节。")
Exit Sub
End If
End If
If strWord = "" Then
If LCase(Action) = "topic" Then
findword = "A.Title like '%" & keyword & "%'"
ElseIf LCase(Action) = "content" Then
If CInt(Newasp.FullContQuery) <> 0 Then
findword = "A.Content like '%" & keyword & "%'"
Else
Call OutAlertScript(Replace(Replace(Newasp.HtmlSetting(10), Chr(34), "\"""), vbCrLf, ""))
Exit Sub
End If
Else
findword = "A.Title like '%" & keyword & "%'"
End If
Else
findword = "A.AlphaIndex='" & strWord & "'"
End If
If LCase(Action) <> "isweb" Then
If IsEmpty(Session("QueryLimited")) Then
Session("QueryLimited") = keyword & "|" & Action & "|" & Now()
Else
Dim QueryLimited
QueryLimited = Split(Session("QueryLimited"), "|")
If UBound(QueryLimited) = 2 Then
If CStr(Trim(QueryLimited(0))) = CStr(keyword) And CStr(Trim(QueryLimited(1))) = CStr(Action) Then
Session("QueryLimited") = keyword & "|" & Action & "|" & Now()
Else
If DateDiff("s", QueryLimited(2), Now()) < CLng(Newasp.HtmlSetting(7)) Then
Dim strLimited
strLimited = Replace(Newasp.HtmlSetting(9), "{$TimeLimited}", Newasp.HtmlSetting(7))
Call OutAlertScript(Replace(Replace(strLimited, Chr(34), "\"""), vbCrLf, ""))
Exit Sub
Else
Session("QueryLimited") = keyword & "|" & Action & "|" & Now()
End If
End If
Else
Session("QueryLimited") = keyword & "|" & Action & "|" & Now()
End If
End If
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, "{$ArticleIndex}", strIndexName)
HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
HtmlContent = Replace(HtmlContent, "{$KeyWord}", KeyWord)
HtmlContent = Replace(HtmlContent, "{$PageTitle}", Newasp.ModuleName & "搜索")
HtmlContent = Replace(HtmlContent, "{$QueryKeyWord}", "<font color=""red""><strong>" & keyword & "</strong></font>")
Call ReplaceString
If LCase(Action) <> "isweb" Then
If IsNumeric(Request("classid")) And Request("classid") <> "" Then
Set rsClass = Newasp.Execute("SELECT ClassID,ChildStr FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & CLng(Request("classid")))
If rsClass.BOF And rsClass.EOF Then
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", strNoResult, 1, 1, 1)
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "")
HtmlContent = Replace(HtmlContent, "{$totalrec}", 0)
HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
Set rsClass = Nothing
Response.Write HtmlContent
Exit Sub
Else
findword = "A.ClassID in (" & rsClass("ChildStr") & ") And " & findword
End If
rsClass.Close: Set rsClass = Nothing
End If
maxperpage = CInt(Newasp.HtmlSetting(1))
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
If CLng(CurrentPage) = 0 Then CurrentPage = 1
Set Rs = CreateObject("ADODB.Recordset")
SQL = "SELECT TOP " & SearchMaxPageList & " A.ArticleID,A.ClassID,A.BriefTopic,A.ColorMode,A.FontMode,A.title,A.[content],A.Related,A.Author,A.ComeFrom,A.ImageUrl,A.isTop,A.username,A.star,A.isBest,A.WriteTime,A.AllHits,A.HtmlFileDate,A.isxmltext,A.xmlfilename,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 " & findword & " ORDER BY A.WriteTime DESC,A.ArticleID DESC"
Rs.Open SQL, Conn, 1, 1
If Err Or (Rs.BOF And Rs.EOF) Then
'如果没有找到相关内容,清除掉无用的标签代码
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", strNoResult)
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "")
HtmlContent = Replace(HtmlContent, "{$totalrec}", 0)
HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
Else
TotalNumber = Rs.RecordCount
If (TotalNumber Mod maxperpage) = 0 Then
TotalPageNum = TotalNumber \ maxperpage
Else
TotalPageNum = TotalNumber \ maxperpage + 1
End If
If CurrentPage > TotalPageNum Then CurrentPage = TotalPageNum
If CurrentPage < 1 Then CurrentPage = 1
HtmlContent = Replace(HtmlContent, "{$totalrec}", TotalNumber)
'获取模板标签[ShowRepetend][/ReadArticleList]中的字符串
TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
Call LoadSearchList
End If
Rs.Close: Set Rs = Nothing
Else
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "")
HtmlContent = Replace(HtmlContent, "{$totalrec}", 0)
HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
If s = 1 Then
Call isWeb_Query()
Exit Sub
End If
Response.Write HtmlContent & SearchObj
Exit Sub
End If
Response.Write HtmlContent
Exit Sub
End Sub
'================================================
'过程名：LoadChildListAsp
'作 用：装载子级文章列表ASP
'================================================
Private Sub LoadSearchList()
If IsNull(TempListContent) Then Exit Sub
i = 0
Rs.MoveFirst
If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
j = (CurrentPage - 1) * maxperpage + 1
ListContent = ""
Do While Not Rs.EOF And i < CInt(maxperpage)
If Not Response.IsClientConnected Then Response.end
Call SearchResult
Rs.MoveNext
i = i + 1
j = j + 1
If i >= maxperpage Then Exit Do
Loop
Dim strPagination
strPagination = ShowListPage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, ASPCurrentPage(PageType), "搜索结果")
HtmlContent = Replace(HtmlContent, TempListContent, ListContent)
HtmlContent = Replace(HtmlContent, "[ShowRepetend]", "")
HtmlContent = Replace(HtmlContent, "[/ShowRepetend]", "")
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", strPagination)
End Sub
'================================================
'过程名：SearchResult
'作 用：装载搜索列表
'================================================
Private Sub SearchResult()
Dim sTitle, sTopic, ArticleTitle, ListStyle, TitleWord
Dim ArticleContent, ArticleUrl, WriteTime, sClassName
ListContent = ListContent & TempListContent
If (i Mod 2) = 0 Then
ListStyle = 1
Else
ListStyle = 2
End If
TitleWord = Replace(Rs("title"), "" & keyword & "", "<font color=red>" & keyword & "</font>")
sTitle = Newasp.ReadFontMode(TitleWord, Rs("ColorMode"), Rs("FontMode"))
sTopic = Newasp.ReadPicTopic(Rs("BriefTopic"))
If CInt(CreateHtml) <> 0 Then
ArticleUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("ArticleID"),1,"")
sClassName = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("ArticleID"),1,"")
Else
If IsURLRewrite Then
ArticleUrl = ChannelRootDir & Rs("ArticleID") & Newasp.HtmlExtName
sClassName = ChannelRootDir & "list_1_" & Rs("ClassID") & Newasp.HtmlExtName
Else
ArticleUrl = ChannelRootDir & "show.asp?id=" & Rs("ArticleID")
sClassName = ChannelRootDir & "list.asp?classid=" & Rs("ClassID")
End If
End If
sClassName = "<a href=""" & sClassName & """ target=""_blank""><span style=""color:" & Newasp.MainSetting(3) & """>" & Rs("ClassName") & "</span></a>"
ArticleTitle = "<a href=""" & ArticleUrl & """" & LoadRemark(Rs("title")) & " target=""_blank"">" & sTitle & "</a>"
'--如果是XML文件,就从XML文件中读出内容------
isxmltext = Newasp.ChkNumeric(Rs("isxmltext"))
xmlfilename = Rs("xmlfilename") & ""
If isxmltext = 1 Then
xmlFilePath = m_strXMLPath & xmlfilename
TextContent = Newasp.ReadXMLDocument(xmlFilePath,"article/@content")
If TextContent = "" Then TextContent = Rs("content") & ""
Else
TextContent = Rs("content")
End If
'---------------------------------------------
ArticleContent = Newasp.CutString(TextContent, CInt(Newasp.HtmlSetting(3)))
ArticleContent = Replace(ArticleContent, "" & keyword & "", "<font color=""red"">" & keyword & "</font>")
WriteTime = Newasp.ShowDateTime(Rs("WriteTime"), CInt(Newasp.HtmlSetting(2)))
WriteTime = Replace(WriteTime, " globalDate", "")
ListContent = Replace(ListContent, "{$KeyWord}", keyword)
ListContent = Replace(ListContent, "{$totalrec}", TotalNumber)
ListContent = Replace(ListContent, "{$ClassifyName}", sClassName)
ListContent = Replace(ListContent, "{$ArticleUrl}", ArticleUrl)
ListContent = Replace(ListContent, "{$LinksUrl}", ArticleUrl)
ListContent = Replace(ListContent, "{$BriefTopic}", sTopic)
ListContent = Replace(ListContent, "{$ArticleHits}", Rs("AllHits"))
ListContent = Replace(ListContent, "{$UserName}", Rs("username")&"")
ListContent = Replace(ListContent, "{$ArticleDateTime}", WriteTime)
ListContent = Replace(ListContent, "{$ListStyle}", ListStyle)
ListContent = Replace(ListContent, "{$Author}", Newasp.ChkNull(Rs("Author")))
ListContent = Replace(ListContent, "{$Order}", j)
ListContent = Replace(ListContent, "{$ArticleTitle}", ArticleTitle)
ListContent = Replace(ListContent, "{$ArticleTopic}", sTitle)
ListContent = Replace(ListContent, "{$ArticleContent}", ArticleContent)
End Sub
'================================================
'过程名：ShowArticleComment
'作 用：文章评论
'================================================
Public Sub ShowArticleComment()
Dim ArticleTitle, HtmlFileUrl, HtmlFileName
Dim AverageGrade, TotalGrade, TotalComment, TempListContent
Dim strComment, strCheckBox, strAdminComment,BackUrl
Newasp.PreventInfuse
strCheckBox = ""
strAdminComment = ""
On Error Resume Next
ArticleID = Newasp.ChkNumeric(Request("ArticleID"))
If ArticleID = 0 Then
Response.Write "<Br><Br><Br>Sorry！错误的系统参数,请选择正确的连接方式。"
Response.end
End If
skinid = Newasp.ChkNumeric(Newasp.ChannelSkin)
Newasp.LoadTemplates ChannelID, 8, skinid
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)
HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
'HtmlContent = Replace(HtmlContent, "{$PageTitle}", Newasp.ModuleName & "评论")
HtmlContent = Replace(HtmlContent, "{$ArticleID}", ArticleID)
HtmlContent = Replace(HtmlContent, "{$MemberName}", Newasp.membername)
'获得文章标题
SQL = "SELECT TOP 1 A.ArticleID,A.ClassID,A.title,A.HtmlFileDate,A.ForbidEssay,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 Rs = Newasp.Execute(SQL)
If Rs.EOF And Rs.BOF Then
Response.Write "已经没有了"
Set Rs = Nothing
Exit Sub
Else
If CreateHtml <> 0 Then
HtmlFileUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("ArticleID"),1,"")
BackUrl = HtmlFileUrl
Else
If IsURLRewrite Then
BackUrl = Rs("ArticleID") & Newasp.HtmlExtName
Else
BackUrl = "show.asp?id=" & Rs("ArticleID")
End If
End If
ArticleTitle = "<a href=""" & BackUrl & """>" & Rs("title") & "</a>"
ForbidEssay = Rs("ForbidEssay")
HtmlContent = Replace(HtmlContent, "{$PageTitle}", Rs("title") & "评论")
HtmlContent = Replace(HtmlContent, "{$BackUrl}", BackUrl)
HtmlContent = Replace(HtmlContent, "{$ClassID}", Rs("ClassID"))
End If
Rs.Close
Set Rs = CreateObject("adodb.recordset")
SQL = "SELECT COUNT(CommentID) As TotalComment,AVG(Grade) As avgGrade,SUM(Grade) As TotalGrade FROM NC_Comment WHERE ChannelID=" & ChannelID & " And Audit=0 And postid = " & ArticleID
Set Rs = Newasp.Execute(SQL)
TotalComment = Rs("TotalComment")
AverageGrade = Rs("avgGrade")
TotalGrade = Rs("TotalGrade")
If IsNull(AverageGrade) Then AverageGrade = 0
If IsNull(TotalComment) Then TotalComment = 0
If IsNull(TotalGrade) Then TotalGrade = 0
AverageGrade = Round(AverageGrade)
Rs.Close: Set Rs = Nothing
HtmlContent = Replace(HtmlContent, "{$ArticleTitle}", ArticleTitle)
HtmlContent = Replace(HtmlContent, "{$TotalComment}", TotalComment)
HtmlContent = Replace(HtmlContent, "{$AverageGrade}", AverageGrade)
CurrentPage = Newasp.ChkNumeric(Request("page"))
If CurrentPage = 0 Then CurrentPage = 1
'每页显示评论数
maxperpage = Newasp.ChkNumeric(Newasp.PaginalNum)
If maxperpage = 0 Then maxperpage = 30
'记录总数
TotalNumber = TotalComment
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 * FROM NC_Comment WHERE ChannelID=" & ChannelID & " And Audit=0 And postid = " & ArticleID & " ORDER BY CommentID 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}", "暂时无人参加评论", 1, 1, 1)
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "")
HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
Else
Rs.MoveFirst
i = 0
If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
ListContent = ""
'获取模板标签[ShowRepetend][/ReadArticleList]中的字符串
TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
Do While Not Rs.EOF And i < CInt(maxperpage)
If Not Response.IsClientConnected Then Response.end
ListContent = ListContent & TempListContent
strComment = Newasp.HTMLEncode(Rs("Content"))
ListContent = Replace(ListContent, "{$CommentContent}", strComment)
ListContent = Replace(ListContent, "{$UserName}", Newasp.HTMLEncode(Rs("username")))
ListContent = Replace(ListContent, "{$CommentGrade}", Rs("Grade"))
ListContent = Replace(ListContent, "{$PostTime}", Rs("postime"))
ListContent = Replace(ListContent, "{$PostIP}", Rs("postip"))
If Session("AdminName") <> "" Or Newasp.membergrade = "999" Then
strCheckBox = "<input type='checkbox' name='selCommentID' value='" & Rs("CommentID") & "'>"
End If
ListContent = Replace(ListContent, "{$SelCheckBox}", strCheckBox)
Rs.MoveNext
i = i + 1
If i >= maxperpage Then Exit Do
Loop
End If
Rs.Close: Set Rs = Nothing
HtmlContent = Replace(HtmlContent, TempListContent, ListContent)
HtmlContent = Replace(HtmlContent, "[ShowRepetend]", "")
HtmlContent = Replace(HtmlContent, "[/ShowRepetend]", "")
If Session("AdminName") <> "" Or Newasp.membergrade = "999" Then
strAdminComment = "<input class=Button type=button name=chkall value='全选' onClick=""CheckAll(this.form)""><input class=Button type=button name=chksel value='反选' onClick=""ContraSel(this.form)"">" & vbNewLine
strAdminComment = strAdminComment & "<input type=hidden name=ArticleID value='" & ArticleID & "'>" & vbNewLine
strAdminComment = strAdminComment & "<input type=hidden name=action value='del'>" & vbNewLine
strAdminComment = strAdminComment & "<input class=Button type=submit name=Submit2 value='删除选中的评论' onclick=""{if(confirm('您确定执行该操作吗?')){this.document.selform.submit();return true;}return false;}"">"
End If
HtmlContent = Replace(HtmlContent, "{$AdminComment}", strAdminComment)
Call ShowCommentPage
Call ReplaceString
If Newasp.CheckStr(LCase(Request.Form("action"))) = "del" Then
Call CommentDel
End If
If Newasp.CheckStr(LCase(Request.Form("action"))) = "save" Then
Call CommentSave
End If
Response.Write HtmlContent
Exit Sub
End Sub
'================================================
'过程名：ShowCommentPage
'作 用：文章评论分页
'================================================
Private Sub ShowCommentPage()
Dim FileName, ii, n, strTemp
FileName = "comment.asp"
If TotalNumber Mod maxperpage = 0 Then
n = TotalNumber \ maxperpage
Else
n = TotalNumber \ maxperpage + 1
End If
strTemp = "<table cellspacing=1 width='100%' border=0><tr><td align=center> " & vbCrLf
If CurrentPage < 2 Then
strTemp = strTemp & " 共有评论 <font COLOR=#FF0000>" & TotalNumber & "</font> 个 首 页 上一页 "
Else
strTemp = strTemp & "共有评论 <font COLOR=#FF0000>" & TotalNumber & "</font> 个 <a href=" & FileName & "?page=1&ArticleID=" & Request("ArticleID") & ">首 页</a> "
strTemp = strTemp & "<a href=" & FileName & "?page=" & CurrentPage - 1 & "&ArticleID=" & Request("ArticleID") & ">上一页</a> "
End If
If n - CurrentPage < 1 Then
strTemp = strTemp & "下一页 尾 页 " & vbCrLf
Else
strTemp = strTemp & "<a href=" & FileName & "?page=" & (CurrentPage + 1) & "&ArticleID=" & Request("ArticleID") & ">下一页</a>"
strTemp = strTemp & " <a href=" & FileName & "?page=" & n & "&ArticleID=" & Request("ArticleID") & ">尾 页</a>" & vbCrLf
End If
strTemp = strTemp & " 页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
strTemp = strTemp & " <b>" & maxperpage & "</b>个/页 " & vbCrLf
strTemp = strTemp & "</td></tr></table>" & vbCrLf
HtmlContent = Replace(HtmlContent, "{$ReadListPage}", strTemp)
End Sub
'================================================
'过程名：CommentDel
'作 用：文章评论删除
'================================================
Private Sub CommentDel()
Dim selCommentID
If Newasp.CheckPost = False Then
Call OutAlertScript("您提交的数据不合法，请不要从外部提交表单。")
Exit Sub
End If
If Not IsEmpty(Request.Form("selCommentID")) Then
selCommentID = Newasp.CheckStr(Request("selCommentID"))
If Session("AdminName") <> "" Or Newasp.membergrade = "999" Then
Newasp.Execute ("DELETE FROM NC_Comment WHERE ChannelID=" & ChannelID & " And CommentID in (" & selCommentID & ")")
Call OutHintScript("评论删除成功！")
Else
Call OutAlertScript("非法操作！你没有删除评论的权限。")
Exit Sub
End If
End If
End Sub
'================================================
'过程名：CommentSave
'作 用：文章评论添加保存
'================================================
Public Sub CommentSave()
If Newasp.CheckPost = False Then
FoundErr = True
Call OutAlertScript("您提交的数据不合法，请不要从外部提交表单。")
Exit Sub
End If
On Error Resume Next
If CInt(Newasp.AppearGrade) <> 0 And Session("AdminName") = "" Then
If CInt(Newasp.AppearGrade) > CInt(Newasp.membergrade) Then
FoundErr = True
Call OutAlertScript("您没有发表评论的权限，如果您是会员请登陆后再参与评论。")
Exit Sub
End If
End If
If ForbidEssay <> 0 Then
FoundErr = True
Call OutAlertScript("此篇" & Newasp.ModuleName & "禁止发表评论！")
Exit Sub
End If
If Not Newasp.CodeIsTrue() Then
Call OutAlertScript("验证码校验失败，请返回刷新页面再试。")
Session("GetCode") = ""
Founderr = True
Exit Sub
End If
Session("GetCode") = ""
If Trim(Request.Form("UserName")) = "" Then
FoundErr = True
Call OutAlertScript("用户名不能为空！")
Exit Sub
End If
If Len(Trim(Request.Form("UserName"))) > 15 Then
FoundErr = True
Call OutAlertScript("用户名不能大于15个字符！")
Exit Sub
End If
If Newasp.IsValidStr(Request.Form("UserName")) = False Then
FoundErr = True
Call OutAlertScript("用户名中有非法字符！")
Exit Sub
End If
If Newasp.strLength(Request.Form("content")) < Newasp.LeastString Then
FoundErr = True
Call OutAlertScript("评论内容不能小于" & Newasp.LeastString & "字符！")
Exit Sub
End If
If Newasp.strLength(Request.Form("content")) > Newasp.MaxString Then
FoundErr = True
Call OutAlertScript("评论内容不能大于" & Newasp.MaxString & "字符！")
Exit Sub
End If
Dim ChkPostData
ChkPostData = Newasp.NeedIsAudit(Request.Form("content"), Request.Form("username"))
If ChkPostData = 1 Then
Founderr = True
Call OutAlertScript("请不要发表含有不适当内容的留言，请不要发表广告信息")
Exit Sub
End If
Call PreventRefresh
If FoundErr = True Then Exit Sub
ArticleID = Newasp.ChkNumeric(Request.Form("ArticleID"))
Set Rs = CreateObject("ADODB.RecordSet")
SQL = "SELECT * FROM NC_Comment WHERE (CommentID is null)"
Rs.Open SQL, Conn, 1, 3
Rs.AddNew
Rs("ChannelID") = ChannelID
Rs("postid") = ArticleID
Rs("UserName") = Newasp.ChkFormStr(Request.Form("UserName"))
Rs("Grade") = Newasp.ChkNumeric(Request.Form("Grade"))
Rs("content") = Server.HTMLEncode(Request.Form("content"))
Rs("postime") = Now()
Rs("postip") = Newasp.GetUserip
Rs("good") = 0
Rs("bad") = 0
Rs("apprize") = 0
If ChkPostData = 2 Then
Rs("Audit") = 1
Else
Rs("Audit") = 0
End If
Rs.Update
Rs.Close: Set Rs = Nothing
If CreateHtml <> 0 And ChkPostData = 0 Then CreateArticleContent (ArticleID)
Session("UserRefreshTime") = Now()
If ChkPostData = 2 Then
Founderr = True
Call OutAlertScript("评论发表成功，需等管理员审核后才能正式发表。")
Exit Sub
End If
Response.Redirect (Request.ServerVariables("HTTP_REFERER"))
Exit Sub
End Sub
Public Sub PreventRefresh()
Dim RefreshTime
RefreshTime = 20
If DateDiff("s", Session("UserRefreshTime"), Now()) < RefreshTime Then
FoundErr = True
Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; chaRset=gb2312"" /><meta http-equiv=""refresh"" content=""" & RefreshTime & """ /><br />本页面起用了防刷新机制，请不要在" & RefreshTime & "秒内连续刷新本页面<BR>正在打开页面，请稍后……"
Response.end
End If
End Sub
End Class
%>