?? content.asp
字號:
<!--#include file="config.asp"-->
<%
Dim Rs,SQL,ArticleID,CurrentPage
Dim CreateHtml,sysInstallDir
Newasp.ReadChannel (ChannelID)
CreateHtml = CInt(Newasp.IsCreateHtml)
sysInstallDir = Newasp.InstallDir
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,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
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
'=================================================
'函數(shù)名：ContentPagination
'作 用：以分頁方式顯示文章具體的內(nèi)容
'參 數(shù)：無
'=================================================
Private Function ContentPagination(strContent)
Dim ContentLen, maxperpage, Paginate
Dim arrContent, TempContent, i
On Error Resume Next
strContent = Newasp.ReadContent(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
On Error Resume Next
strContent = Newasp.ReadContent(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
On Error Resume Next
CurrentPage = n
HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ArticleID"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, 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 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=""" & 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án)系管理員。</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án)系管理員。</li>"
Call ScriptMessage(Message)
Set rsMember = Nothing
Exit Function
End If
If CLng(rsMember("userpoint")) < CLng(PointNum) Then
Message = "<li>對不起!您的點數(shù)不足。不能閱覽此文章</li><li>閱覽此文章所需的點數(shù)：" & 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
%>?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -