<%
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 & ""
If CurrentPage > 1 Then
If CreateHtml <> 0 Then
TempContent = TempContent & "上一页 "
Else
TempContent = TempContent & "上一页 "
End If
End If
For i = 1 To Paginate
If i = CurrentPage Then
TempContent = TempContent & "[" & i & "] "
Else
If CreateHtml <> 0 Then
TempContent = TempContent & "[" & i & "] "
Else
TempContent = TempContent & "[" & i & "] "
End If
End If
Next
If CurrentPage < Paginate Then
If CreateHtml <> 0 Then
TempContent = TempContent & " 下一页"
Else
TempContent = TempContent & " 下一页"
End If
End If
TempContent = TempContent & "
"
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 = "您没有登录或者你的会员级别不够，不能阅览此文章！如果你是本站会员, 请先登陆"
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 = "非法操作~！"
Call ScriptMessage(Message)
Set rsMember = Nothing
Exit Function
Else
If DateDiff("D", CDate(rsMember("ExpireTime")), Now()) > 0 Or CInt(rsMember("UserClass")) = 999 Then
Message = "对不起！您的会员已到期，不能阅览此文章；如果你要阅览此文章请联系管理员。"
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 = "非法操作~！"
Call ScriptMessage(Message)
Set rsMember = Nothing
Exit Function
Else
If CInt(rsMember("UserGrade")) < CInt(UserGroup) Then
Message = "您的级别不够，阅览此文章需要" & GroupName & "以上级别的会员；如果你要阅览此文章请联系管理员。"
Call ScriptMessage(Message)
Set rsMember = Nothing
Exit Function
End If
If CLng(rsMember("userpoint")) < CLng(PointNum) Then
Message = "对不起!您的点数不足。不能阅览此文章阅览此文章所需的点数：" & PointNum & "如果你确实要阅览此文章请到会员中心充值。"
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
%>