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")%> <b>来源:</b><%=Rs("ComeFrom")%> <b>发布时间:</b><%=Rs("WriteTime")%>
<b>发 布 人:</b> <font color=blue><%=Rs("username")%></font>
<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>8){NewaspContentLabel.style.fontSize=(--newasp_fontsize)+"pt";NewaspContentLabel.style.lineHeight=(--newasp_lineheight)+"pt";}" 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<64){NewaspContentLabel.style.fontSize=(++newasp_fontsize)+"pt";NewaspContentLabel.style.lineHeight=(++newasp_lineheight)+"pt";}" 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>
<input type="button" onclick="javascript:history.go(-1)" value="返回上一页" name="B1" class=Button>
<input type="button" name="Submit1" onclick="javascript:location.href='#'" value="返回顶部" class=button>
<input type="button" name="Submit1" onclick="javascript:location.href='?action=edit&ChannelID=<%=ChannelID%>&ArticleID=<%=Rs("ArticleID")%>'" value="编辑<%=sModuleName%>" class=button>
[<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 + -
显示快捷键?