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 %>