www.gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\admin_grade.asp
<!--#include file=conn.asp--> <!-- #include file="inc/const.asp" --> <!-- #include file="inc/DvADChar.asp" --> <!-- #include file="inc/GroupPermission.asp" --> <% Head() dim admin_flag admin_flag=",17," if not Mybbs.master or instr(","&session("flag")&",",admin_flag)=0 then Errmsg=ErrMsg + "<BR><li>本页面为管理员专用,请<a href=admin_index.asp target=_top>登录</a>后进入。<br><li>您没有管理本页面的权限。" dvbbs_error() Else if request("action")="save" then call savegrade() elseif request("action")="add" then call add() elseif request("action")="savenew" then call savenew() elseif request("action")="del" then call del() elseif request("action")="per" then call per() else call gradeinfo() end if Footer() End If sub gradeinfo() %> <form method="POST" action=admin_grade.asp?action=save> <table width="95%" border="0" cellspacing="1" cellpadding="3" align=center class="tableBorder"> <tr> <td height="23" colspan="5" class=forumrowHighlight> <table width="95%" border="0" cellspacing="1" cellpadding="3" align=center> <tr> <td valign=top> <B>关于用户等级设置的说明,请仔细阅读后做设置</B>:<BR> 相关用户组如果无对应等级名称,则注册用户自动按照文章升级<BR> 相关用户组的等级名称可以和用户组名不一样<BR> 各个等级可设定不自定义权限,权限类型和组权限一样。如果某个等级设定了自定义权限,这样该等级在论坛所有版面就有了自定义的权限,而且该等级将出现在版面权限定义的组菜单中(这样就可设定某个等级在某个版面中的权限),而且相关等级用户的组ID将变成等级ID </td> <td width="50%" valign=top> <B>在等级中设定用户组有什么用?</B><BR> 一般来说,只有注册用户拥有等级,所以在等级所属组中一般都设定对应注册用户组,如果设置成别的组,那么该用户在升级到这个等级的同时也将自动归入所设置的组<BR> 比如你新添加了一个用户组,并且给予了这个用户组某一些权限,那么你可以设置达到一定等级(帖子)的用户自动更新到这个用户组以使用这个用户组的权限。<BR>如果您想某个等级的用户不跟随帖子数而上升等级,那么就把最少发贴设置为<B>-1</B>,一般为特殊用户组需要这样的设置,设置某个级别最少发贴为<B>-1</B>后,该级别的用户将不能根据帖子增加而升级,别的用户也不能自动升级到该级别,只有在用户管理中方能更改其级别 </td> </tr> </table> </td> </tr> <tr> <th height="23" colspan="5" >用户等级设定</th> </tr> <tr> <td width="25%" class=forumrowHighlight><B>等级名称</B></td> <td width="15%" class=forumrowHighlight><B>最少发贴</B></td> <td width="20%" class=forumrowHighlight><B>图片</B></td> <td width="25%" class=forumrowHighlight><B>所属组</B></td> <td width="15%" class=forumrowHighlight><B>操作</B></td> </tr> <% Dim TempArray,DefaultLock Set Rs=Mybbs.Execute("select UserGroupID,title from dv_usergroups where issetting=1 And ParentGID=0 order by UserGroupID") TempArray = Rs.GetRows(-1) set rs=Mybbs.Execute("select * from dv_usergroups order by ParentGID,UserGroupID,minarticle desc") do while not rs.eof If Rs("ParentGID")=0 Then DefaultLock="1" Else DefaultLock="" End If %> <input type=hidden value="<%=rs("UserGroupID")%>" name="usertitleid"> <tr> <td width="25%" class=Forumrow><input size=15 value="<%=rs("usertitle")%>" name="usertitle" type=text></td> <td width="15%" class=Forumrow> <%If DefaultLock <>"1" Then %> <input size=5 value="<%=rs("MinArticle")%>" name="minarticle" type=text > <%Else%> <input type=hidden value="<%=rs("MinArticle")%>" name="minarticle" > <%=rs("MinArticle")%> <%End If%> </td> <td width="20%" class=Forumrow><input size=15 value="<%=rs("grouppic")%>" name="titlepic" type=text></td> <td width="25%" class=Forumrow> <%If DefaultLock <>"1" Then %> <select name="groupid" size=1> <%For i=0 To Ubound(TempArray,2)%> <%If Rs("ParentGID")=0 Then%> <option value="<%=TempArray(0,i)%>" <%If Rs("UserGroupID")=TempArray(0,i) Then Response.Write "selected"%>><%=TempArray(1,i)%></option> <%Else%> <option value="<%=TempArray(0,i)%>" <%If Rs("ParentGID")=TempArray(0,i) Then Response.Write "selected"%>><%=TempArray(1,i)%></option> <%End If%> <%Next%> </select> <%Else Response.Write "<input type=hidden value="""&Rs("UserGroupID")&""" name=""groupid"" >" For i=0 To Ubound(TempArray,2) If Rs("UserGroupID")=TempArray(0,i) Then Response.Write TempArray(1,i) End If Next End If%> </td> <td width="15%" class=Forumrow><%If Rs("UserGroupID")>8 Then%><a href="?action=del&id=<%=rs("UserGroupID")%>">删除</a> | <%End If%> <% If Rs("ParentGID")=0 Then Response.Write "<a href=admin_group.asp?action=editgroup&groupid="&Rs("UserGroupID")&">" Else If Rs("IsSetting")=1 Then Response.Write "<a href=admin_grade.asp?action=per&groupid="&Rs("UserGroupID")&"®roupid="&rs("UserGroupID")&">" Else Response.Write "<a href=admin_grade.asp?action=per&groupid="&Rs("ParentGID")&"®roupid="&rs("UserGroupID")&">" End If End If %>权限</a> <%If Rs("UserGroupID")>8 And Rs("IsSetting")=1 Then Response.Write " <font color=red>自</font>"%> </td> </tr> <% rs.movenext loop rs.close set rs=nothing %> <tr> <td width="100%" colspan=5 class=Forumrow> <input type="submit" name="Submit" value="提 交"> </td> </tr> </table> </form> <% end sub Sub savegrade() Server.ScriptTimeout=99999999 Dim usertitleid,iuserclass,usertitle,Minarticle,titlepic,groupid For i=1 to request.form("usertitleid").count usertitleid=replace(request.form("usertitleid")(i),"'","") usertitle=replace(request.form("usertitle")(i),"'","") minarticle=replace(request.form("minarticle")(i),"'","") titlepic=replace(request.form("titlepic")(i),"'","") groupid=replace(request.form("groupid")(i),"'","") if isnumeric(usertitleid) and isnumeric(iuserclass) and usertitle<>"" and isnumeric(minarticle) and titlepic<>"" and isnumeric(groupID) then set rs=Mybbs.Execute("select * from dv_usergroups where UserGroupID="&usertitleID) if rs("usertitle")<>trim(usertitle) or rs("grouppic")<>trim(titlepic) or (rs("parentgid")<>cint(groupid) and rs("parentgid")>0) then '如果有自定义权限,则UserGroupID为等级所在的ID,反之则为组ID if rs("issetting")=1 then groupid=rs("usergroupid") Mybbs.Execute("update [dv_user] set userclass='"&usertitle&"',titlepic='"&titlepic&"',usergroupid="&groupid&" where userclass='"&rs("usertitle")&"'") end if if rs("parentgid")=0 then groupid=0 Mybbs.Execute("update dv_usergroups set usertitle='"&usertitle&"',minarticle="&minarticle&",grouppic='"&titlepic&"',parentgid="&groupid&" where usergroupid="&usertitleID) end if next response.write "设置成功,请返回。" set rs=nothing End Sub sub add() %> <form method="POST" action=admin_grade.asp?action=savenew> <table width="95%" border="0" cellspacing="1" cellpadding="3" align=center class="tableBorder"> <tr> <th colspan="2">添加新的用户等级</th> </tr> <tr> <td width="40%" class=forumrow><B>所属用户组</B></td> <td width="60%" class=forumrow> <select size=1 name="usergroupid"> <% set rs=Mybbs.Execute("select * from dv_usergroups where parentgid=0 order by usergroupid") do while not rs.eof %> <option value="<%=rs("usergroupid")%>" <%if rs("usergroupid")=4 then%>selected<%end if%>><%=rs("title")%></option> <% rs.movenext loop rs.close set rs=nothing %> </select> </td> </tr> <tr> <td width="40%" class=forumrow><B>等级名称</B></td> <td width="60%" class=forumrow><input size=30 name="usertitle" type=text></td> </tr> <tr> <td width="40%" class=forumrow><B>最少发贴</B><BR>如果该等级是荣誉称号或者管理身份,这里可以填写-1,表示不跟随帖子增长而升级</td> <td width="60%" class=forumrow><input size=30 name="minarticle" type=text></td> </tr> <tr> <td width="40%" class=forumrow><B>等级图片</B></td> <td width="60%" class=forumrow><input size=30 name="titlepic" type=text> 这将体现在帖子内容显示左边的用户资料中</td> </tr> <tr> <td width="100%" colspan=2 class=forumrow> <input type="submit" name="Submit" value="提 交"> </td> </tr> </table> </form> <% end sub sub savenew() if request.form("minarticle")="" then Errmsg=ErrMsg + "<BR><li>请输入新的等级需要文章数。" dvbbs_error() exit sub elseif not isnumeric(request.form("minarticle")) then Errmsg=ErrMsg + "<BR><li>新的等级文章数只能是数字。" dvbbs_error() exit sub end if if request.form("titlepic")="" then Errmsg=ErrMsg + "<BR><li>请输入新的等级图片。" dvbbs_error() exit sub end if if request.form("usertitle")="" then Errmsg=ErrMsg + "<BR><li>请输入新的等级名称。" dvbbs_error() exit sub end if Dim GroupTitle,GroupSetting,GroupPic Set rs=Mybbs.execute("select * from dv_usergroups where usergroupid="&request.form("usergroupid")) GroupTitle=rs("title") GroupSetting=rs("GroupSetting") GroupPic=rs("titlepic") set rs = server.CreateObject ("Adodb.recordset") sql="select * from dv_usergroups where usertitle='"&request.form("usertitle")&"'" rs.open sql,conn,1,3 if rs.eof and rs.bof then rs.addnew rs("usertitle")=request.form("usertitle") rs("minarticle")=request.form("minarticle") rs("grouppic")=request.form("titlepic") rs("parentgid")=request.form("usergroupid") rs("title")=GroupTitle rs("GroupSetting")=GroupSetting rs("isdisp")=0 rs("IsSetting")=0 rs("titlepic")=GroupPic rs.update else Errmsg=ErrMsg + "<BR><li>该等级名称已经存在。" dvbbs_error() exit sub end if rs.close set rs=nothing response.write "添加成功!建议您到更新用户数据中进行更新操作!" end sub Sub Del() Server.ScriptTimeout = 99999999 Dim Minarticle, Minuserclass If Isnumeric(Request("Id")) Then If CLng(Request("id")) < 9 Then Errmsg = ErrMsg + "<BR><li>系统默认等级不能删除。" Dvbbs_Error() Exit Sub End If Set Rs = Mybbs.Execute("SELECT * FROM Dv_UserGroups WHERE UserGroupId = " & Request("id")) Minarticle = Rs("Minarticle") Minuserclass = Rs("Usertitle") Rem 修正删除等级后等级设置的错误 2004-5-1 Mybbs.YangZheng Set Rs = Mybbs.Execute("SELECT TOP 1 * FROM Dv_Usergroups WHERE ParentGId = " & Request("id") & " AND NOT MinArticle = -1 ORDER BY Minarticle") If Not (Rs.Eof And Rs.Bof) Then Mybbs.Execute("UPDATE [Dv_User] SET Userclass = '" & Rs("Usertitle") & "', Titlepic = '" & Rs("Grouppic") & "' WHERE Userclass = '" & Minuserclass & "'") Else Set Rs = Nothing Set Rs = Mybbs.Execute("SELECT TOP 1 * FROM Dv_UserGroups WHERE ParentGId = 4 ORDER By Minarticle Desc") If Not (Rs.Eof And Rs.Bof) Then Mybbs.Execute("UPDATE [Dv_User] SET UserGroupId = 4, Userclass = '" & Rs("Usertitle") & "', Titlepic = '" & Rs("Grouppic") & "' WHERE Userclass = '" & Minuserclass & "'") End If End If Mybbs.Execute("DELETE FROM Dv_Usergroups WHERE Usergroupid = " & Request("id")) Response.Write "删除成功!" Set Rs = Nothing End If End Sub sub per() if not isnumeric(request("groupid")) then response.write "错误的参数!" exit sub end if if request("groupaction")="yes" then dim GroupSetting,groupid,newgroupsetting GroupSetting=GetGroupPermission if request("isdefault")=1 then set rs=Mybbs.execute("select * from dv_usergroups where usergroupid="&request("groupid")) If Rs("ParentGID")=0 Then Dv_suc("您没有选择自定义等级选项,所做修改将无效") Exit Sub End If if rs("issetting")=1 then groupid=rs("parentgid") set rs=nothing set rs=Mybbs.execute("select * from dv_usergroups where usergroupid="&groupid) newgroupsetting=rs("groupsetting") Set Rs=Nothing Mybbs.execute("update dv_usergroups set issetting=0,groupsetting='"&newgroupsetting&"' where usergroupid="&request("regroupid")) '取消自定义设置,更新用户数据,更新为用户组ID Mybbs.execute("update [dv_user] set usergroupid="&groupid&" where userclass='"&request("usertitle")&"'") end if else Mybbs.execute("update dv_usergroups set issetting=1,groupsetting='"&GroupSetting&"' where usergroupid="&request("regroupid")) '更新用户数据 Mybbs.execute("update [dv_user] set usergroupid="&request("regroupid")&" where userclass='"&request("usertitle")&"'") End If ReloadGroup(request("regroupid")) Dv_suc("修改等级自定义权限成功") else Dim reGroupSetting,founduserper,usergrade If IsNumerIc(request("regroupid")) and request("regroupid")<>"" Then Set Rs=Mybbs.Execute("select * from dv_usergroups where usergroupid="&request("regroupid")) usergrade=rs("usertitle") End If founduserper=false set rs=Mybbs.Execute("select * from dv_usergroups where usergroupid="&request("groupid")) if rs.eof and rs.bof then response.write "未找到用户等级" exit sub end if If Rs("UserGroupID")<9 Then founduserper=false Else If Rs("IsSetting")=1 Then founduserper=true Else founduserper=false End If End If reGroupSetting=split(rs("GroupSetting"),",") %> <FORM METHOD=POST ACTION="?action=per"> <input type=hidden name="groupid" value="<%=request("groupid")%>"> <input type=hidden name="regroupid" value="<%=request("regroupid")%>"> <input type=hidden name="usertitle" value="<%=usergrade%>"> <table width="95%" border="0" cellspacing="1" cellpadding="3" align=center class="tableBorder"> <tr><td colspan=3 height=25 class="Forumrow"><B>说明</B>:<BR>在这里您可以设置各个等级在论坛中的默认权限,<font color=blue>默认为使用该等级所属用户组权限,如果要让该等级有自定义权限,则修改时请选择自定义设置选项</font></td></tr> <tr> <th height="23" colspan="3" >编辑论坛用户等级权限 >> <%=rs("usertitle")%><%if usergrade<>"" then Response.Write " >> "&usergrade&""%></th> </tr> <tr> <td height="23" colspan="3" class=forumrow><input type=radio name="isdefault" value="1" <%if not founduserper then%>checked<%end if%>><B>使用用户组默认值</B> (注意: 这将删除任何之前所做的自定义设置)</td> </tr> <tr> <td height="23" colspan="3" class=forumrow><input type=radio name="isdefault" value="0" <%if founduserper then%>checked<%end if%>><B>使用自定义设置</B> (选择自定义才能使以下设置生效) </td> </tr> <% GroupPermission(rs("GroupSetting")) %> <input type=hidden value="yes" name="groupaction"> </FORM> </table> <% set rs=nothing end if end sub Function ReloadGroup(UserGroupID) Dim Rs,SQL SQL = "Select GroupSetting From [Dv_UserGroups] where UserGroupID = " & UserGroupID & "" Set Rs = Mybbs.Execute(SQL) Mybbs.Name="GroupSetting_"& UserGroupID Mybbs.value=Rs(0) Set Rs = Nothing End Function %>