admin_article.asp

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

ASP
1,419
字号
		Set Rs = Nothing
	End If
	Succeed("<li>恭喜您!添加新的" & sModuleName & "成功。</li><li><a href=admin_article.asp?action=view&ChannelID=" & ChannelID & "&ArticleID=" & ArticleID & ">点击此处查看该" & sModuleName & "</a></li><li><a href=?action=add&ChannelID=" & ChannelID & "&classid=" & Request.Form("ClassID") & "><font color=blue>点击此处继续添加" & sModuleName & "</font></a></li>")
End Sub

Private Sub ModifyArticle()
	If Not ChkAdmin("AdminArticle" & ChannelID) Then
		Server.Transfer("showerr.asp")
		Response.End
	End If
	CheckSave
	If Founderr = True Then Exit Sub
	Dim Auditing
	Set Rs = Server.CreateObject("ADODB.Recordset")
	SQL = "SELECT * FROM NC_Article WHERE ArticleID=" & CLng(Request("ArticleID"))
	Rs.Open SQL,Conn,1,3
		Auditing = Rs("isAccept")
		Rs("ChannelID") = ChannelID
		Rs("ClassID") = Trim(Request.Form("ClassID"))
		Rs("SpecialID") = Trim(Request.Form("SpecialID"))
		Rs("title") = Newasp.ChkFormStr(Request.Form("title"))
		Rs("subtitle") = Newasp.ChkFormStr(Request.Form("subtitle"))
		Rs("ColorMode") = Trim(Request.Form("ColorMode"))
		Rs("FontMode") = Trim(Request.Form("FontMode"))
		Rs("content") = TextContent
		Rs("Related") = Newasp.ChkFormStr(Request.Form("Related"))
		Rs("Author") = Trim(Request.Form("Author"))
		Rs("ComeFrom") = Trim(Request.Form("ComeFrom"))
		Rs("star") = Trim(Request.Form("star"))
		Rs("isTop") = ArticleTop
		Rs("isBest") = ArticleBest
		If CInt(Request.Form("Update")) = 1 Then 
			Rs("WriteTime") = Now()
		Else
			Rs("WriteTime") = Formatime(Trim(Request.Form("WriteTime")))
		End If
		Rs("AllHits") = CLng(Request.Form("AllHits"))
		Rs("BriefTopic") = Trim(Request.Form("BriefTopic"))
		Rs("ImageUrl") = Trim(Request.Form("ImageUrl"))
		Rs("UploadImage") = Trim(Request.Form("UploadFileList"))
		Rs("UserGroup") = Trim(Request.Form("UserGroup"))
		Rs("PointNum") = Trim(Request.Form("PointNum"))
		Rs("isUpdate") = 1
		Rs("isAccept") = ArticleAccept
		Rs("ForbidEssay") = ForbidEssay
		Rs("AlphaIndex") = Newasp.ReadAlpha(ubb.CheckSpecialChar(Request.Form("title")))
		Rs("AutoPages") = Newasp.ChkNumeric(Request.Form("AutoPages"))
	Rs.update
	ArticleID = Rs("ArticleID")
	If ArticleAccept = 1 And Auditing = 0 Then
		AddUserPointNum Rs("username"),1
	End If
	If ArticleAccept = 0 And Auditing = 1 Then
		AddUserPointNum Rs("username"),0
	End If
	Rs.Close:Set Rs = Nothing
	Call RemoveCache
	If CInt(Newasp.IsCreateHtml) <> 0 Then
		Dim url
		Response.Write "<IE:Download ID=CreationID STYLE=""behavior:url(#default#download)"" />" & vbCrLf
		url = "admin_makenews.asp?ChannelID=" & ChannelID & "&ArticleID=" & ArticleID & "&showid=0"	
		Call ScriptCreation(url,ArticleID)
	End If
	Succeed("<li>恭喜您!修改" & sModuleName & "成功。</li><li><a href=admin_article.asp?action=view&ChannelID=" & ChannelID & "&ArticleID=" & ArticleID & ">点击此处查看该" & sModuleName & "</a></li>")
End Sub
Private Sub ArticleView()
	Call PageTop
	If Request("ArticleID") = "" Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>Sorry!您选择了错误的系统参数。</li>"
		Exit Sub
	End If
	If ChannelID = 0 Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>请指定频道。</li>"
		Exit Sub
	End If
	SQL = "select ArticleID,title,content,ColorMode,FontMode,Author,ComeFrom,WriteTime,username,isAccept from NC_Article where ChannelID=" & ChannelID & " And ArticleID=" & Request("ArticleID")
	Set Rs = Newasp.Execute(SQL)
	If Rs.bof And Rs.EOF Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>Sorry!没有找到任何" & sModuleName & "。或者您选择了错误的系统参数!</li>"
		Exit Sub
	Else
%>
<script language=javascript>
var newasp_fontsize=9;
var newasp_lineheight=12;
</script>
<table border="0" align="center" cellpadding="3" cellspacing="1" class="TableBorder">
	<tr>
	  <th>查看<%=sModuleName%></th>
	</tr>
	<tr>
	  <td align="center" class="TableRow2"><a href=?action=edit&ChannelID=<%=ChannelID%>&ArticleID=<%=Rs("ArticleID")%> onMouseOver="return window.status='键连至 www.newasp.net';"><font size=4><%=Newasp.ReadFontMode(Rs("title"),Rs("ColorMode"),Rs("FontMode"))%></font></a></td>
	</tr>
	<tr>
	  <td align="center" class="TableRow1"><b>作者:</b><%=Rs("Author")%>&nbsp;&nbsp;<b>来源:</b><%=Rs("ComeFrom")%>&nbsp;&nbsp;<b>发布时间:</b><%=Rs("WriteTime")%>&nbsp;&nbsp;
	  <b>发 布 人:</b> <font color=blue><%=Rs("username")%></font>&nbsp;&nbsp;
	  <b>审核状态:</b>
	  <%If Rs("isAccept") > 0 Then%>
	  <font color=blue>已审核</font>
	  <%Else%>
	  <font color=red>未审核</font>
	  <%End If%>
	  </td>
	</tr>
	<tr>
	  <td class="TableRow1"><p align="right"><a style="CURSOR: hand; POSITION: relative" onclick="if(newasp_fontsize&gt;8){NewaspContentLabel.style.fontSize=(--newasp_fontsize)+&quot;pt&quot;;NewaspContentLabel.style.lineHeight=(--newasp_lineheight)+&quot;pt&quot;;}" title="减小字体"><img src="images/1.gif" border="0" width="15" height="15"><font color="#FF6600">减小字体</font></a> 
                    <a style="CURSOR: hand; POSITION: relative" onclick="if(newasp_fontsize&lt;64){NewaspContentLabel.style.fontSize=(++newasp_fontsize)+&quot;pt&quot;;NewaspContentLabel.style.lineHeight=(++newasp_lineheight)+&quot;pt&quot;;}" title="增大字体"><img src="images/2.gif" border="0" width="15" height="15"><font color="#FF6600">增大字体</font></a></p>
					<div id="NewaspContentLabel"><%=Replace(ubb.UbbCode(Rs("content")), "[page_break]", "")%></div></td>
	</tr>
	<tr>
	  <td class="TableRow1">上一篇<%=sModuleName%>:<%=FrontArticle(Rs("ArticleID"))%>
	  <br>下一篇<%=sModuleName%>:<%=NextArticle(Rs("ArticleID"))%></td>
	</tr>
	<tr>
	  <td align="center" class="TableRow2">
	  <input type="button" onclick="{if(confirm('您确定要删除此文章吗?')){location.href='?action=del&ChannelID=<%=ChannelID%>&ArticleID=<%=Rs("ArticleID")%>';return true;}return false;}" value="删除文章" name="B2" class=Button>&nbsp;&nbsp;
	  <input type="button" onclick="javascript:history.go(-1)" value="返回上一页" name="B1" class=Button>&nbsp;&nbsp; 
	  <input type="button" name="Submit1" onclick="javascript:location.href='#'" value="返回顶部" class=button>&nbsp;&nbsp;
	  <input type="button" name="Submit1" onclick="javascript:location.href='?action=edit&ChannelID=<%=ChannelID%>&ArticleID=<%=Rs("ArticleID")%>'" value="编辑<%=sModuleName%>" class=button>&nbsp;&nbsp;
	   [<a href="?act=批量审核&ChannelID=<%=ChannelID%>&selArticleID=<%=Rs("ArticleID")%>" onclick="return confirm('您确定执行审核操作吗?');" ><font color=blue>直接审核</font></a>]</td>
	</tr>
</table>
<%
	End If
	Rs.Close
	Set Rs = Nothing 
End Sub
Private Function FrontArticle(ArticleID)
	Dim Rss, SQL
	SQL = "select Top 1 ArticleID,classid,title from NC_Article where ChannelID=" & ChannelID & " And isAccept <> 0 And ArticleID < " & ArticleID & " order by ArticleID desc"
	Set Rss = Newasp.Execute(SQL)
	If Rss.EOF And Rss.bof Then
		FrontArticle = "已经没有了"
	Else
		FrontArticle = "<a href=admin_article.asp?action=view&ChannelID=" & ChannelID & "&ArticleID=" & Rss("ArticleID") & ">" & Rss("title") & "</a>"
	End If
	Rss.Close
	Set Rss = Nothing
End Function
Private Function NextArticle(ArticleID)
	Dim Rss, SQL
	SQL = "select Top 1 ArticleID,classid,title from NC_Article where ChannelID=" & ChannelID & " And isAccept <> 0 And ArticleID > " & ArticleID & " order by ArticleID asc"
	Set Rss = Newasp.Execute(SQL)
	If Rss.EOF And Rss.bof Then
		NextArticle = "已经没有了"
	Else
		NextArticle = "<a href=admin_article.asp?action=view&ChannelID=" & ChannelID & "&ArticleID=" & Rss("ArticleID") & ">" & Rss("title") & "</a>"
	End If
	Rss.Close
	Set Rss = Nothing
End Function

Private Sub BatCreateHtml()
	Dim AllArticleID,url
	Response.Write "<IE:Download ID=CreationID STYLE=""behavior:url(#default#download)"" />" & vbCrLf
	Response.Write "<ol>"
	AllArticleID = Split(selArticleID, ",")
	For i = 0 To UBound(AllArticleID)
		ArticleID = CLng(AllArticleID(i))
		url = "admin_makenews.asp?ChannelID=" & ChannelID & "&ArticleID=" & ArticleID & "&showid=1"	
		Call ScriptCreation(url,ArticleID)
	Next
	Response.Write "</ol>"
	OutHintScript("开始生成HTML,共有" & i & "个HTML页面需要生成!")
End Sub

Private Function ClassUpdateCount(sortid,stype)
	Dim rscount,Parentstr
	On Error Resume Next
	Set rscount = Newasp.Execute("SELECT ClassID,Parentstr FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & CLng(sortid))
	If Not (rscount.BOF And rscount.EOF) Then
		Parentstr = rscount("Parentstr") &","& rscount("ClassID")
		If CInt(stype) = 1 Then
			Newasp.Execute ("UPDATE [NC_Classify] SET ShowCount=ShowCount+1,isUpdate=1 WHERE ChannelID = "& ChannelID &" And ClassID in (" & Parentstr & ")")
		Else
			Newasp.Execute ("UPDATE [NC_Classify] SET ShowCount=ShowCount-1,isUpdate=1 WHERE ChannelID = "& ChannelID &" And ClassID in (" & Parentstr & ")")
		End If
	End If
	Set rscount = Nothing
End Function

Private Sub ArticleDel()
	If Request("ArticleID") = "" Then
		ErrMsg = "<li>请选择正确的系统参数!</li>"
		Founderr = True
		Exit Sub
	End If
	Set Rs = Newasp.Execute("SELECT ArticleID,classid,username,HtmlFileDate FROM NC_Article WHERE ChannelID = "& ChannelID &" And ArticleID=" & Request("ArticleID"))
	If Not(Rs.BOF And Rs.EOF) Then
		ClassUpdateCount Rs("classid"),0
		AddUserPointNum Rs("username"),0
		DeleteHtmlFile Rs("classid"),Rs("ArticleID"),Rs("HtmlFileDate")
	End If
	Rs.Close:Set Rs = Nothing
	Newasp.Execute("Delete From NC_Article Where ChannelID = "& ChannelID &" And ArticleID = " & Request("ArticleID"))
	Newasp.Execute ("delete from NC_Comment where ChannelID = "& ChannelID &" And PostID = " & Request("ArticleID"))
	Call RemoveCache
	Response.redirect ("admin_article.asp?ChannelID=" & ChannelID)
End Sub

Private Sub batdel()
	Set Rs = Newasp.Execute("SELECT ArticleID,classid,username,HtmlFileDate FROM NC_Article WHERE ChannelID = "& ChannelID &" And ArticleID in (" & selArticleID & ")")
	Do While Not Rs.EOF
		ClassUpdateCount Rs("classid"),0
		AddUserPointNum Rs("username"),0
		DeleteHtmlFile Rs("classid"),Rs("ArticleID"),Rs("HtmlFileDate")
		Rs.movenext
	Loop
	Rs.Close:Set Rs = Nothing
	Newasp.Execute ("delete from NC_Article where ArticleID in (" & selArticleID & ")")
	Newasp.Execute ("delete from NC_Comment where ChannelID = "& ChannelID &" And PostID in (" & selArticleID & ")")
	Call RemoveCache
	OutHintScript ("批量删除操作成功!")
End Sub

Private Sub isCommend()
	Newasp.Execute ("update NC_Article set isBest=1 where ArticleID in (" & selArticleID & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

Private Sub noCommend()
	Newasp.Execute ("update NC_Article set isBest=0 where ArticleID in (" & selArticleID & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

Private Sub isTop()
	Newasp.Execute ("update NC_Article set isTop=1 where ArticleID in (" & selArticleID & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

Private Sub noTop()
	Newasp.Execute ("update NC_Article set isTop=0 where ArticleID in (" & selArticleID & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

Private Sub upindate()
	Newasp.Execute ("update [NC_Article] set WriteTime = " & NowString & " where ArticleID in (" & selArticleID & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

Private Sub BatAccept()
	Set Rs = Newasp.Execute("SELECT username FROM NC_Article WHERE ChannelID = "& ChannelID &" And ArticleID in (" & selArticleID & ")")
	Do While Not Rs.EOF
		AddUserPointNum Rs("username"),1
		Rs.movenext
	Loop
	Rs.Close:Set Rs = Nothing
	Newasp.Execute ("update NC_Article set isAccept=1 where ArticleID in (" & selArticleID & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub
Private Sub NotAccept()
	Set Rs = Newasp.Execute("SELECT username FROM NC_Article WHERE ChannelID = "& ChannelID &" And ArticleID in (" & selArticleID & ")")
	Do While Not Rs.EOF
		AddUserPointNum Rs("username"),0
		Rs.movenext
	Loop
	Rs.Close:Set Rs = Nothing
	Newasp.Execute ("update NC_Article set isAccept=0 where ArticleID in (" & selArticleID & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub
Private Function AddUserPointNum(username,stype)
	On Error Resume Next
	Dim rsuser,GroupSetting,userpoint
	Set rsuser = Newasp.Execute("SELECT userid,UserGrade,userpoint FROM NC_User WHERE username='"& username &"'")
	If Not(rsuser.BOF And rsuser.EOF) Then
		GroupSetting = Split(Newasp.UserGroupSetting(rsuser("UserGrade")), "|||")(9)
		If CInt(stype) = 1 Then
			userpoint = CLng(rsuser("userpoint") + GroupSetting)
			Newasp.Execute ("UPDATE NC_User SET userpoint="& userpoint &",experience=experience+2,charm=charm+1 WHERE userid="& rsuser("userid"))
		Else
			userpoint = CLng(rsuser("userpoint") - GroupSetting)
			Newasp.Execute ("UPDATE NC_User SET userpoint="& userpoint &",experience=experience-2,charm=charm-1 WHERE userid="& rsuser("userid"))
		End If
	End If
	Set rsuser = Nothing
End Function

Function InitSelect(UploadFileList, ImageUrl)
	Dim i
	InitSelect = "<select name='ImageFileList' onChange=""ImageUrl.value=this.value;"">"
	InitSelect = InitSelect & "<option value=''>不选择首页推荐图片</option>"

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?