www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/qianmingsheji/content.asp
<!--#include file="config.asp"--> <% Dim Rs,SQL,ArticleID,CurrentPage Dim CreateHtml,sysInstallDir,ChannelRootDir Newasp.ReadChannel (ChannelID) CreateHtml = CInt(Newasp.IsCreateHtml) sysInstallDir = Newasp.InstallDir ChannelRootDir = Newasp.InstallDir & Newasp.ChannelDir ubb.BasePath = ChannelRootDir ubb.setUbbcode = Join(Newasp.setUserEditor,"|") ubb.Keyword = Newasp.ContentKeyword Call Article_Content() Call CloseConn() Public Sub Article_Content() Dim ArticleContent ArticleID = Newasp.ChkNumeric(Request.Querystring("ArticleID")) CurrentPage = Newasp.ChkNumeric(Request.Querystring("page")) If CurrentPage = 0 Then CurrentPage = 1 ArticleID = CLng(ArticleID) If ArticleID = 0 Then Exit Sub SQL = "SELECT A.ArticleID,A.ClassID,A.content,A.UserGroup,A.PointNum,A.HtmlFileDate,A.AutoPages,C.ClassName,C.UserGroup As User_Group,C.UseHtml 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 Set Rs = Nothing Exit Sub End If '--是否自动分页 ubb.Pagination = true'Newasp.ChkNumeric(Rs("AutoPages")) If CheckUserRead (Rs("ArticleID"), Rs("PointNum"), Rs("UserGroup"), Rs("User_Group")) Then ArticleContent = ContentPagination(Rs("content")) Call ScriptContent(ArticleContent) Else ArticleContent = "" End If Set Rs = Nothing End Sub '================================================= '函数名:ContentPagination '作 用:以分页方式显示文章具体的内容 '参 数:无 '================================================= Private Function ContentPagination(strContent) Dim ContentLen, maxperpage, Paginate Dim arrContent, TempContent, i strContent = ubb.UBBCode(strContent) strContent = Replace(strContent, "[NextPage]", "[page_break]") strContent = Replace(strContent, "[Page_Break]", "[page_break]") ContentLen = Len(strContent) If InStr(strContent, "[page_break]") <= 0 Then TempContent = strContent 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 TempContent = TempContent & arrContent(CurrentPage - 1) End If ContentPagination = TempContent End Function Private Function ContentPaginations(strContent) Dim ContentLen, maxperpage, Paginate Dim arrContent, TempContent, i strContent = ubb.UBBCode(strContent) strContent = Replace(strContent, "[NextPage]", "[page_break]") strContent = Replace(strContent, "[Page_Break]", "[page_break]") ContentLen = Len(strContent) If InStr(strContent, "[page_break]") <= 0 Then TempContent = strContent 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 TempContent = TempContent & arrContent(CurrentPage - 1) TempContent = TempContent & "</p><p align=""center""><b>" If CurrentPage > 1 Then If CreateHtml <> 0 Then TempContent = TempContent & "<a href=""" & ReadPagination(CurrentPage - 1) & """>上一页</a> " Else TempContent = TempContent & "<a href=""?id=" & ArticleID & "&Page=" & CurrentPage - 1 & """>上一页</a> " End If End If For i = 1 To Paginate If i = CurrentPage Then TempContent = TempContent & "<font color=""red"">[" & i & "]</font> " Else If CreateHtml <> 0 Then TempContent = TempContent & "<a href=""" & ReadPagination(i) & """>[" & i & "]</a> " Else TempContent = TempContent & "<a href=""?id=" & ArticleID & "&Page=" & i & """>[" & i & "]</a> " End If End If Next If CurrentPage < Paginate Then If CreateHtml <> 0 Then TempContent = TempContent & " <a href=""" & ReadPagination(CurrentPage + 1) & """>下一页</a>" Else TempContent = TempContent & " <a href=""?id=" & ArticleID & "&Page=" & CurrentPage + 1 & """>下一页</a>" End If End If TempContent = TempContent & "</b></p>" End If ContentPaginations = TempContent End Function Private Function ReadPagination(n) Dim HtmlFileName, CurrentPage CurrentPage = n 'HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ArticleID"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, CurrentPage) HtmlFileName = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("ArticleID"),CurrentPage,"") ReadPagination = HtmlFileName End Function Function EncodeJS(str) str = Replace(Replace(Replace(Replace(str,"\","\\"),"'","\'"),VbCrLf,"\n"),Chr(13),"") EnCodeJs = str End Function Private Function CheckUserRead(ByVal ArticleID, ByVal PointNum, ByVal UserGroup, ByVal User_Group) Dim Message, CookiesID Dim GroupSetting, GroupName, gradeid CheckUserRead = False If CInt(Newasp.membergrade) = 999 Then CheckUserRead = True Exit Function End If 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=""" & sysInstallDir & "user/"" class=""style1"" target=""_blank"">登陆</a></li>" Call ScriptMessage(Message) Exit Function End If On Error Resume Next 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>" Call ScriptMessage(Message) Set rsMember = Nothing Exit Function Else If DateDiff("D", CDate(rsMember("ExpireTime")), Now()) > 0 Or CInt(rsMember("UserClass")) = 999 Then Message = "<li>对不起!您的会员已到期,不能阅览此文章;</li><li>如果你要阅览此文章请联系管理员。</li>" Call ScriptMessage(Message) Set rsMember = Nothing Exit Function Else Set rsMember = Nothing CheckUserRead = True Exit Function End If End If rsMember.Close: Set rsMember = Nothing CheckUserRead = True 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>" Call ScriptMessage(Message) Set rsMember = Nothing Exit Function Else If CInt(rsMember("UserGrade")) < CInt(UserGroup) Then Message = "<li>您的级别不够,阅览此文章需要<font color=blue>" & GroupName & "</font>以上级别的会员;</li><li>如果你要阅览此文章请联系管理员。</li>" Call ScriptMessage(Message) Set rsMember = Nothing Exit Function End If If CLng(rsMember("userpoint")) < CLng(PointNum) Then Message = "<li>对不起!您的点数不足。不能阅览此文章</li><li>阅览此文章所需的点数:" & PointNum & "</li><li>如果你确实要阅览此文章请到<a href=""" & sysInstallDir & "user/"" class=""style1"" target=""_blank"">会员中心</a>充值。</li>" Call ScriptMessage(Message) Set rsMember = Nothing Exit Function End If rsMember("userpoint") = CLng(rsMember("userpoint") - PointNum) rsMember.Update Response.Cookies("ReadArticle")(CookiesID) = ArticleID End If rsMember.Close: Set rsMember = Nothing End If CheckUserRead = True End Function Public Sub ScriptMessage(str) str = EncodeJS(str) Response.Write "var oMessages=document.getElementById(""Messages"");" & vbNewLine Response.Write "var oMessage=document.getElementById(""Message"");" & vbNewLine Response.Write "if (oMessages!=null) {" & vbNewLine Response.Write " oMessages.innerHTML='" & str & "';" & vbNewLine Response.Write "}else{" & vbNewLine Response.Write " if (oMessage!=null) {" & vbNewLine Response.Write " oMessage.innerHTML='" & str & "';" & vbNewLine Response.Write " }" & vbNewLine Response.Write "}" & vbNewLine End Sub Public Sub ScriptContent(str) str = EncodeJS(str) Response.Write "var strContent='" & str & "';" & vbNewLine Response.Write "var oContents=document.getElementById(""NewsContentLabels"");" & vbNewLine Response.Write "var oContent=document.getElementById(""NewsContentLabel"");" & vbNewLine Response.Write "if (oContents!=null) {" & vbNewLine Response.Write " oContents.innerHTML=strContent;" & vbNewLine Response.Write " if (oContent!=null) {" & vbNewLine Response.Write " oContent.innerHTML='';" & vbNewLine Response.Write " }" & vbNewLine Response.Write "}else{" & vbNewLine Response.Write " if (oContent!=null) {" & vbNewLine Response.Write " oContent.innerHTML=strContent;" & vbNewLine Response.Write " }" & vbNewLine Response.Write " if (oContents!=null) {" & vbNewLine Response.Write " oContents.innerHTML='';" & vbNewLine Response.Write " }" & vbNewLine Response.Write "}" & vbNewLine End Sub %>