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

'=================================================
'函数名：ContentPagination
'作  用：以分页方式显示文章具体的内容
'参  数：无
'=================================================
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>&nbsp;&nbsp;"
			Else
				TempContent = TempContent & "<a href='?id=" & ArticleID & "&Page=" & CurrentPage - 1 & "'>上一页</a>&nbsp;&nbsp;"
			End If
		End If
		For i = 1 To Paginate
			If i = CurrentPage Then
				TempContent = TempContent & "<font color='red'>[" & i & "]</font>&nbsp;"
			Else
				If CreateHtml <> 0 Then
					TempContent = TempContent & "<a href='" & ReadPagination(i) & "'>[" & i & "]</a>&nbsp;"
				Else
					TempContent = TempContent & "<a href='?id=" & ArticleID & "&Page=" & i & "'>[" & i & "]</a>&nbsp;"
				End If
			End If
		Next
		If CurrentPage < Paginate Then
			If CreateHtml <> 0 Then
				TempContent = TempContent & "&nbsp;<a href='" & ReadPagination(CurrentPage + 1) & "'>下一页</a>"
			Else
				TempContent = TempContent & "&nbsp;<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>"
				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
%>