newschannel.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 1,462 行 · 第 1/5 页

<!--#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 MakeHtmlMode,MakePageDone,MakeListNum,strBasicPath

	Private Sub Class_Initialize()
		On Error Resume Next
		FoundErr = False
		UserArticle = False
		ChannelID = 1
		IsShowFlush = 0
		strlen = 0
		MakeHtmlMode = 0
		MakePageDone = 0
		'--每页生成数
		MakeListNum = 50
	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()
		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 & "/"
			If Len(Newasp.NamedPath) > 2 Then
				strBasicPath = Newasp.NamedPath
			Else
				strBasicPath = Server.MapPath(Newasp.InstallDir & Newasp.ChannelDir)
			End If
			
		End If
		strIndexName = "<a href=""" & ChannelRootDir & """>" & Newasp.ChannelName & "</a>"
		ubb.BasePath = ChannelRootDir
		ubb.setUbbcode = Join(Newasp.setUserEditor,"|")
		ubb.Keyword = Newasp.ContentKeyword
	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
		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,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
		
		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)