<% '============================ '7.2修改说明: = '优化参数提取流程 = '对奖励或惩罚数值做大小限制 = '============================ Dvbbs.Loadtemplates("") Dim username Dim locktype Dim ip,BoardID Dim TotalUseTable Dim AdminUserPer Dim UpdateBoardID,i,Rs,Sql AdminUserPer=false If (Dvbbs.master or Dvbbs.boardmaster or Dvbbs.superboardmaster) and Cint(Dvbbs.GroupSetting(42))=1 Then AdminUserPer=True Else AdminUserPer=False End If If Dvbbs.UserGroupID > 3 And CInt(Dvbbs.GroupSetting(42))=1 Then AdminUserPer=True End If If Dvbbs.FoundUserPer And CInt(Dvbbs.GroupSetting(42))=1 Then AdminUserPer=True ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(42))=0 Then AdminUserPer=False End If Dim userid Dim action action=Request("action") userid=Request("userid") username=Request("name") ip=Dvbbs.UserTrueIP Dvbbs.stats="管理用户" Dvbbs.nav() If username="" Then Response.redirect "showerr.asp?ErrCodes=
  • 请指定所操作的用户!&action=OtherErr" Else username=Dvbbs.CheckStr(username) End If Dvbbs.Head_Var 2,0,"","" Dvbbs.ShowErr() If userid<> "" Then userid=Dvbbs.CheckStr(userid) If Not IsNumeric(userid) Then Response.redirect "showerr.asp?ErrCodes=
  • 非法的参数。&action=OtherErr" Else Set Rs=Dvbbs.Execute("SELECT UserID FROM [Dv_User] WHERE Username = '"&Username&"' ") If Not Rs.EOF Then UserID=Rs(0) Else UserID=0 End If Set Rs=Nothing End If If Not Dvbbs.ChkPost() Then Response.redirect "showerr.asp?ErrCodes=
  • 您不要从外部提交数据&action=OtherErr" End If If action="power" Then Call Poweruser() ElseIf action="DelTopic" then Call DelTopic() ElseIf action="getpermission" then Call boardlist() ElseIf action="userBoardPermission" then Call GetUserPermission() ElseIf action="saveuserpermission" then Call saveuserpermission() ElseIf action="DelUserReply" then Call DelUserReply() Else Call lockuser() End If Dvbbs.activeonline() Dvbbs.footer() Dvbbs.PageEnd() Sub lockuser() Dim canlockuser canlockuser=false if (Dvbbs.master or Dvbbs.boardmaster or Dvbbs.superboardmaster) and Cint(Dvbbs.GroupSetting(28))=1 Then canlockuser=True Else canlockuser=False End If If Dvbbs.UserGroupID > 3 And CInt(Dvbbs.GroupSetting(28))=1 Then canlockuser=True If Dvbbs.FoundUserPer And Cint(Dvbbs.GroupSetting(28))=1 Then canlockuser=True ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(28))=0 Then canlockuser=False End If If Not canlockuser then Response.redirect "showerr.asp?ErrCodes=
  • 您没有权限执行此操作。&action=OtherErr" Dim UserStatus If action="lock_1" Then UserStatus = 1 locktype="锁定" ElseIf action="lock_2" then UserStatus= 2 locktype="屏蔽" ElseIf action="lock_3" then UserStatus = 0 locktype="解锁" Else Response.redirect "showerr.asp?ErrCodes=
  • 请指定正确的参数!&action=OtherErr" Exit Sub End If '----------------------------------------------------------------- '系统整合 '----------------------------------------------------------------- Dim DvApi_Obj,DvApi_SaveCookie,SysKey If DvApi_Enable Then Md5OLD = 1 SysKey = Md5(username&DvApi_SysKey,16) Md5OLD = 0 Set DvApi_Obj = New DvApi DvApi_Obj.NodeValue "syskey",SysKey,0,False DvApi_Obj.NodeValue "action","lock",0,False DvApi_Obj.NodeValue "username",username,1,False DvApi_Obj.NodeValue "userstatus",UserStatus,1,False DvApi_Obj.SendHttpData If DvApi_Obj.Status = "1" Then Response.redirect "showerr.asp?ErrCodes="& DvApi_Obj.Message &"&action=OtherErr" End If Set DvApi_Obj = Nothing End If '----------------------------------------------------------------- Dvbbs.Execute("update [dv_user] set LockUser="&UserStatus&" where userid="&userid&" and UserGroupID > 1") sql="insert into Dv_log (l_touser,l_username,l_content,l_ip,l_type) values ('"&username&"','"&Dvbbs.membername&"','用户操作:"&locktype& "','"&ip&"',6)" Dvbbs.Execute(sql) Dvbbs.Dvbbs_suc("
  • 您选择的用户已经"&locktype&"。您的操作已经记录在案。") End Sub Sub Poweruser() Dim title,content Dim canlockuser canlockuser=false If (Dvbbs.master or Dvbbs.boardmaster or Dvbbs.superboardmaster) And CInt(Dvbbs.GroupSetting(43))=1 Then canlockuser=True Else canlockuser=False End If If Dvbbs.UserGroupID > 3 And Cint(Dvbbs.GroupSetting(43))=1 Then canlockuser=True If Dvbbs.FoundUserPer And CInt(Dvbbs.GroupSetting(43))=1 Then canlockuser=True ElseIf Dvbbs.FoundUserPer And CInt(Dvbbs.GroupSetting(43))=0 Then canlockuser=False End If If Not canlockuser Then Response.redirect "showerr.asp?ErrCodes=
  • 您没有权限执行此操作。&action=OtherErr" If request("checked")="yes" Then Dim doWealth,douserEP,douserCP,douserPower Dim doWealthMsg,douserEPMsg,douserCPMsg,douserPowerMsg,allMsg doWealth=Request("doWealth") douserEP=Request("douserEP") douserCP=Request("douserCP") douserPower=Request("douserPower") If Not IsNumeric(doWealth) Then doWealth="0" doWealthMsg="" Else If CInt(doWealth)>50 Or CInt(doWealth)<-50 Then doWealth="0" doWealthMsg="" Else doWealthMsg="金钱" & doWealth & "," End If End If If Not IsNumeric(douserEP) Then douserEP="0" douserEPMsg="" Else If CInt(douserEP)>50 Or CInt(douserEP)<-50Then douserEP="0" douserEPMsg="" Else douserEPMsg="经验" & douserEP & "," End If End If If Not IsNumeric(douserCP) Then douserCP="0" douserCPMsg="" Else If CInt(douserCP)>50 Or CInt(douserCP)<-50 Then douserCP="0" douserCPMsg="" Else douserCPMsg="魅力" & douserCP & "," End If End If If Not IsNumeric(douserPower) Then douserPower="0" douserPowerMsg="" Else If CInt(douserPower)>5 Or CInt(douserPower)<-5 Then douserPower="0" douserPowerMsg="" Else douserPowerMsg="威望" & douserPower End If End If If doWealthMsg="" and douserEPMsg="" and douserCPMsg="" and douserPowerMsg="" Then allmsg="没有对用户进行分值操作" Else allmsg="用户操作:" & doWealthMsg & douserEPMsg & douserCPMsg & douserPowerMsg End If allmsg=Dvbbs.Checkstr(allmsg) title=request.form("title") content=request.form("content") content="原因:" & title & content content=Dvbbs.Checkstr(content) if request.form("title")="" and request.form("content")="" then Response.redirect "showerr.asp?ErrCodes=
  • 请写明操作原因。&action=OtherErr" sql="insert into Dv_log (l_touser,l_username,l_content,l_ip,l_type) values ('"&username&"','"&Dvbbs.membername&"','用户操作:"&content& ","&allmsg&"','"&ip&"',5)" Dvbbs.Execute(sql) If allmsg<>"" Then Dvbbs.Execute("update [dv_user] set userWealth=userWealth+"&doWealth&",userCP=userCP+"&douserCP&",userEP=userEP+"&douserEP&",userPower=userPower+"&douserPower&" where userid="&userid&"") End If locktype="成功操作" Dvbbs.Dvbbs_suc("
  • 您选择的用户已经"&locktype&"。
  • 您的操作已经记录。") Else %>
    论坛管理中心--您要进行的操作是奖励用户
    操作理由 *
    用户操作: 金钱  魅力  经验  威望 *
    请慎重使用管理员的管理职能,管理员所有操作将被记录 
    <% end if End Sub '删除用户1-10天内主题 Sub Deltopic() Dim DelDate, Suserid Dim Todaynum Dim Trs, ii, SplitBoardID Dim j DelDate = Dvbbs.checkstr(request.form("delTopicDate")) suserid = Dvbbs.checkstr(request.form("SetUserID")) Dim Canlockuser Canlockuser = False If (Dvbbs.Master Or Dvbbs.Boardmaster Or Dvbbs.Superboardmaster) And CInt(Dvbbs.GroupSetting(29)) = 1 Then Canlockuser = True Else Canlockuser = False End If If Dvbbs.UserGroupID >3 And CInt(Dvbbs.GroupSetting(29))=1 Then canlockuser=True If Dvbbs.FoundUserPer And CInt(Dvbbs.GroupSetting(29))=1 Then Canlockuser = True ElseIf Dvbbs.FoundUserPer And CInt(Dvbbs.GroupSetting(29))=0 Then Canlockuser = False End If If Not canlockuser Then Response.redirect "showerr.asp?ErrCodes=
  • 您没有权限执行此操作。&action=OtherErr" if DelDate="" or Not IsNumeric(DelDate) Then Response.redirect "showerr.asp?ErrCodes=
  • 非法的参数。&action=OtherErr" If suserid="" or not isnumeric(suserid) then Response.redirect "showerr.asp?ErrCodes=
  • 非法的参数。&action=OtherErr" '删除帖子表中数据 '更新用户帖子数,用户删除帖子数为该帖所有回复数,回复人的删除帖子数不更新 ii = 0 REM 查询加入TOPICID排序避免有百万主题时超时 2004-5-22 Dv.Yz If IsSqlDataBase=1 Then Set Rs = Dvbbs.Execute("SELECT TopicID, Child, BoardID, PostTable, Dateandtime FROM [Dv_Topic] WHERE (NOT Boardid IN (444, 777)) AND PostUserID = " & Suserid & " AND DateDiff(d, DateAndTime, " & SqlNowString & ") < " & DelDate & " ORDER BY TopicID") Else Set Rs = Dvbbs.Execute("SELECT TopicID, Child, BoardID, PostTable, dateandtime FROM [Dv_Topic] WHERE (NOT boardid IN (444, 777)) AND PostUserID = " & Suserid & " AND DateDiff('d', DateAndTime, " & SqlNowString & ") < " & DelDate & " ORDER BY TopicID") End If If Not Rs.EOF Then Sql=Rs.GetRows(-1) Rs.Close:Set Rs = Nothing For j = 0 To Ubound(Sql,2) ii = ii + 1 TotalUseTable = Sql(3,j) '更新发贴用户数据 Dvbbs.Execute("UPDATE [Dv_User] SET Userpost = Userpost - 1, UserDel = UserDel - "&Sql(1,j)&"-1 WHERE userid="&suserid) '更新主题状态 Dvbbs.Execute("UPDATE [Dv_topic] SET locktopic = boardid, boardid = 444 WHERE topicid = "&Sql(0,j)) '更新帖子状态 Dvbbs.Execute("UPDATE "&TotalUseTable&" SET locktopic = boardid, boardid=444 WHERE rootid = "&Sql(0,j)) If DateDiff("d",Sql(4,j),Now())=0 Then todaynum=Sql(1,j) Else todaynum=0 End If '得到该帖子所属论坛的上级论坛ID Set Trs=Dvbbs.Execute("SELECT ParentStr, ParentID FROM Dv_board WHERE boardid ="&Sql(2,j)) If Trs(1)=0 Then UpdateBoardID=Sql(2,j) Else UpdateBoardID=trs(0) & "," & Sql(2,j) End If '更新版面数据 Dvbbs.Execute("update Dv_board set postnum=postnum-"&Sql(1,j)&"-1,topicNum=topicNum-1,todayNum=todayNum-"&todayNum&" where boardid in ("&UpdateBoardID&")") '更新版面缓存 '更新总数据 Dvbbs.Execute("update dv_setup set Forum_TodayNum=Forum_todayNum-"&todaynum&",Forum_postNum=Forum_postNum-"&Sql(1,j)&"-1,Forum_TopicNum=Forum_topicNum-1") '更新总设置缓存 Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(7,0))-1,7 Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(8,0))-Sql(1,j)-1,8 Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(9,0))-todaynum,9 '更新最后回复数据 Dim UpdateBoardID1 UpdateBoardID1=UpdateBoardID LastCount Sql(2,j),Sql(0,j),0,1 Dvbbs.ReloadBoardInfo UpdateBoardID1 Next End If Set Rs = Nothing set Trs = Nothing Sql = "INSERT INTO Dv_Log (l_touser,l_username,l_content,l_ip,l_type) values ('"&username&"','"&Dvbbs.membername&"','用户操作:删除该用户主题 "&ii&" 条。','"&ip&"',6)" Dvbbs.Execute(SQL) Dvbbs.Dvbbs_suc("
  • 删除该用户主题 "&ii&" 条。
  • 该用户删除帖子数为所删帖所有回复数,回复人的删除帖子数不更新") End Sub '删除某用户指定日期内所有回复贴 Sub DelUserReply() Dim DelDate,suserid,DelBBS Dim todaynum Dim trs,ii,SplitBoardID Dim j DelDate=Dvbbs.checkstr(request.form("delTopicDate")) suserid=Dvbbs.checkstr(request.form("SetUserID")) DelBBS=Left(Replace(request.form("DelBBS"),"'",""),8) Dim canlockuser canlockuser=false if (Dvbbs.master or Dvbbs.boardmaster or dvbbs.superboardmaster) and Cint(Dvbbs.GroupSetting(29))=1 Then canlockuser=True Else canlockuser=False End If If Dvbbs.UserGroupID >3 And Cint(Dvbbs.GroupSetting(29))=1 Then canlockuser=True If Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(29))=1 Then canlockuser=True ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(29))=0 then canlockuser=False End If If Not canlockuser Then Response.redirect "showerr.asp?ErrCodes=
  • 您没有权限执行此操作。&action=OtherErr" If DelDate="" or not isnumeric(DelDate) Then Response.redirect "showerr.asp?ErrCodes=
  • 非法的参数。&action=OtherErr" If suserid="" or not isnumeric(suserid) Then Response.redirect "showerr.asp?ErrCodes=
  • 非法的参数。&action=OtherErr" '删除帖子表中数据 ii=0 If IsSqlDataBase=1 then Set Rs=Dvbbs.Execute("SELECT Announceid, rootid, boardid, dateandtime FROM "&DelBBS&" WHERE (NOT boardid IN (444, 777)) AND PostUserID = "&suserid&"AND NOT ParentID = 0 AND Datediff(d, Dateandtime, "&SqlNowString&") < "&DelDate) Else Set Rs=Dvbbs.Execute("SELECT Announceid, rootid, boardid, dateandtime FROM "&DelBBS&" WHERE (NOT boardid IN (444, 777)) AND PostUserID = "&suserid&" AND NOT ParentID = 0 AND Datediff('d', Dateandtime, "&SqlNowString&") < "&DelDate) End if If Not Rs.EOF Then Sql=Rs.GetRows(-1) Rs.Close:Set Rs=Nothing For j=0 To Ubound(Sql,2) ii=ii+1 '更新发贴用户数据 Dvbbs.Execute("UPDATE [dv_user] SET userpost = userpost - 1, UserDel = UserDel - 1, UserWealth = UserWealth - "&Dvbbs.Forum_user(3)&", userEP = userEP - "&Dvbbs.Forum_user(8)&", userCP = userCP - "&Dvbbs.Forum_user(13)&" WHERE userid = "&suserid) Dvbbs.Execute("UPDATE "&DelBBS&" SET locktopic = boardid, boardid = 444 WHERE Announceid = "&Sql(0,j)) isEndReply Sql(1,j),Sql(0,j),1 If DateDiff("d",Sql(3,j),Now())=0 Then todaynum=1 Else todaynum=0 End If '得到该帖子所属论坛的上级论坛ID Set trs=Dvbbs.Execute("SELECT ParentStr, ParentID FROM dv_board WHERE boardid = "&Sql(2,j)) If trs(1)=0 Then UpdateBoardID=Sql(2,j) Else UpdateBoardID=trs(0) & "," & Sql(2,j) End If '更新版面数据 Dvbbs.Execute("UPDATE dv_board SET postnum = postnum - 1, todayNum = todayNum - "&todayNum&" WHERE boardid IN ("&UpdateBoardID&")") '更新总数据 Dvbbs.Execute("UPDATE dv_setup SET Forum_TodayNum = Forum_todayNum - "&todaynum&", Forum_postNum = Forum_postNum - 1") '更新总设置缓存 Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(8,0))-1,8 Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(9,0))-todaynum,9 '更新最后回复数据 LastCount Sql(2,j),Sql(1,j),Sql(0,j),2 Next End if Set Rs=Nothing Set Trs=Nothing Sql="insert into Dv_log (l_touser,l_username,l_content,l_ip,l_type) values ('"&username&"','"&Dvbbs.membername&"','用户操作:删除该用户回复 "&ii&" 条。','"&ip&"',6)" Dvbbs.Execute(SQL) Dvbbs.Dvbbs_suc("
  • 删除该用户回复 "&ii&" 条。") End Sub Sub boardlist() Dim trs Dim dispboard If Not AdminUserPer Then Response.redirect "showerr.asp?ErrCodes=
  • 您没有权限执行此操作。&action=OtherErr" Else dispboard=True End If If Not IsNumeric (request("userid")) then Response.redirect "showerr.asp?ErrCodes=
  • 错误的用户参数。&action=OtherErr" Response.Write "" Response.Write "" Response.Write "" '----------------------boardinfo-------------------- Response.Write "
    编辑"&request("username")&"论坛权限(红色表示该用户在该版面有自定义权限)
    编辑该用户在其它页面的权限(主要针对短信部分设置)
    点击论坛名称进入编辑状态
    " Dim reBoard_Setting,FBoardMaster FBoardMaster=False sql="select * from dv_board order by rootid,orders" set rs=Dvbbs.iCreateObject("adodb.recordset") rs.open sql,conn,1,1 Do while Not rs.eof reBoard_Setting=split(rs("Board_Setting"),",") if rs("parentID")>0 and rs("depth")>0 then set trs=Dvbbs.Execute("select boardmaster from dv_board where boardid in ("&rs("ParentStr")&") order by orders") Do While Not trs.EOF If Cint(reBoard_Setting(40))=1 and not FBoardMaster Then If InStr("|"&trs(0)&"|","|"&Dvbbs.membername&"|")>0 Then FBoardMaster=True Else FBoardMaster=False End If End If i=i+1 If FBoardMaster Then Exit Do if i>9 Then Exit Do trs.MoveNext Loop End If If Dvbbs.boardmaster And InStr("|"&rs("BoardMaster")&"|","|"&Dvbbs.membername&"|")=0 then dispboard=False If FBoardMaster Then dispboard=True If Dvbbs.master or Dvbbs.superboardmaster Then dispboard=True if dispboard Then If Rs("depth")>0 Then for i=1 to rs("depth") Response.Write " " Next End If If rs("child")>0 Then Response.Write "" Else Response.Write "" End If %> &userid=<%=request("userid")%>&name=<%=request("name")%>"> <% set trs=Dvbbs.Execute("select uc_userid from dv_UserAccess where uc_Boardid="&rs("boardid")&" and uc_userid="&request("userid")) if not (trs.eof and trs.bof) then Response.Write "" if rs("parentid")=0 then Response.Write "" Response.Write rs("boardtype") if rs("parentid")=0 then Response.Write "" if rs("child")>0 then Response.Write "("&rs("child")&")" end if Response.Write "
    " FBoardMaster=false dispboard=false rs.MoveNext loop set trs=nothing set rs=nothing Response.Write "
    " End Sub Sub GetUserPermission() If Not AdminUserPer Then Response.redirect "showerr.asp?ErrCodes=
  • 您没有权限执行此操作。&action=OtherErr" Dim usertitle If Not IsNumeric(request("userid")) then Response.redirect "showerr.asp?ErrCodes=
  • 错误的用户参数。&action=OtherErr" If Not IsNumeric(Dvbbs.boardid) then Response.redirect "showerr.asp?ErrCodes=
  • 错误的用户参数。&action=OtherErr" Dim UserGroupID,membername,boardtype set rs=Dvbbs.Execute("select u.UserGroupID,ug.title,u.username from [dv_user] u inner join dv_UserGroups UG on u.userGroupID=ug.userGroupID where u.userid="&request("userid")) UserGroupID=rs(0) usertitle=rs(1) membername=rs(2) set rs=Dvbbs.Execute("select boardtype from dv_board where boardid="&Dvbbs.boardid) if rs.eof and rs.bof then boardtype="论坛其他页面" else boardtype=rs(0) end if Dim reGroupSetting Dim FoundGroup,FoundUserPermission,FoundGroupPermission FoundGroup=false FoundUserPermission=false FoundGroupPermission=false set rs=Dvbbs.Execute("select * from dv_UserAccess where uc_boardid="&Dvbbs.boardid&" and uc_userid="&request("userid")) If Not (rs.eof and rs.bof) Then reGroupSetting=rs("uc_Setting") FoundGroup=true FoundUserPermission=true End If if not foundgroup then set rs=Dvbbs.Execute("select * from dv_BoardPermission where boardid="&Dvbbs.boardid&" and groupid="&usergroupid) if not(rs.eof and rs.bof) then reGroupSetting=rs("PSetting") FoundGroup=true FoundGroupPermission=true end if end if if not foundgroup then set Rs=Dvbbs.Execute("select * from dv_usergroups where usergroupid="&usergroupid) If rs.eof And rs.bof Then Response.Write "未找到该用户组!" response.end Else FoundGroup=true FoundGroupPermission=true reGroupSetting=rs("GroupSetting") End If End If %>
    "/> <% GroupPermission(reGroupSetting) %>
    编辑 <%=membername%> 在 <%=boardtype%> 权限
    注意:该用户属于 <%=usertitle%> 用户组中,如果您设置了他的自定义权限,则该用户权限将以自定义权限为主
    checked<%end if%>>使用用户组默认值 (注意: 这将删除任何之前所做的自定义设置)
    checked="true"<%end if%>>使用自定义设置
    <% End Sub Sub SaveUserPermission() if not AdminUserPer then Response.redirect "showerr.asp?ErrCodes=
  • 您没有权限执行此操作。&action=OtherErr" if not isnumeric(request("userid")) then Response.redirect "showerr.asp?ErrCodes=
  • 错误的用户参数。&action=OtherErr" if not isnumeric(Dvbbs.boardid) then Response.redirect "showerr.asp?ErrCodes=
  • 错误的版面参数。&action=OtherErr" Dim trs '最后一次进行验证,主要为验证版主是否所操作的版面版主 Dim reboard_setting,fboardmaster fboardmaster=false if Dvbbs.boardmaster and (Not Dvbbs.FoundUserPer) and (not (Dvbbs.master or Dvbbs.superboardmaster)) Then set rs=Dvbbs.Execute("select boardmaster,parentid,depth,Board_Setting from dv_board where boardid="&Dvbbs.boardid) if not(rs.eof and rs.bof) then reBoard_Setting=split(rs(3),",") if rs("parentID")>0 and rs("depth")>0 then set trs=Dvbbs.Execute("select boardmaster from dv_board where boardid in ("&rs("ParentStr")&") order by orders") do while not trs.eof if Cint(reBoard_Setting(40))=1 And Not FBoardMaster Then if instr("|"&trs(0)&"|","|"&Dvbbs.membername&"|")>0 Then FBoardMaster=True else FBoardMaster=False end if end if i=i+1 if FBoardMaster then exit do if i>9 then exit do trs.movenext loop end if if not fboardmaster then if instr("|"&rs(0)&"|","|"&membername&"|")=0 then Dvbbs.AddErrMsg "您不是该版面的版主,无权进行用户权限操作。" end if Else Response.redirect "showerr.asp?ErrCodes=
  • 您不是该版面的版主,无权进行用户权限操作。&action=OtherErr" End If End If Dim myGroupSetting Dim IsGroupSetting,MyIsGroupSetting,FoundSetting myGroupSetting=GetGroupPermission If request("isdefault")=1 Then Dvbbs.Execute("delete from dv_UserAccess where uc_boardid="&Dvbbs.boardid&" and uc_userid="&Dvbbs.CheckStr(request("userid"))) Else set rs=Dvbbs.Execute("select * from dv_UserAccess where uc_boardid="&Dvbbs.boardid&" and uc_userid="&Dvbbs.CheckStr(request("userid"))) if rs.eof and rs.bof Then Dvbbs.Execute("insert into Dv_UserAccess (uc_userid,uc_boardid,uc_setting) values ("&Dvbbs.CheckStr(request("userid"))&","&Dvbbs.boardid&",'"&myGroupSetting&"')") else Dvbbs.Execute("update dv_UserAccess set uc_setting='"&myGroupSetting&"' where uc_boardid="&Dvbbs.boardid&" and uc_userid="&Dvbbs.CheckStr(request("userid"))) End If End If Dim IsGroupSetting1 IsGroupSetting=Get_board_AccUserList(Dvbbs.boardid) IsGroupSetting1=Get_Board_GroupSetting(Dvbbs.boardid) If IsGroupSetting="" Then IsGroupSetting=IsGroupSetting1 ElseIf IsGroupSetting1<>"" Then IsGroupSetting=IsGroupSetting&","& IsGroupSetting1 End If Dvbbs.Execute("update dv_Board set IsGroupSetting='"&IsGroupSetting&"' Where BoardID="&Dvbbs.boardid) sql="insert into Dv_log (l_touser,l_username,l_content,l_ip,l_type) values ('"&username&"','"&Dvbbs.membername&"','用户操作:设置权限。','"&ip&"',5)" Dvbbs.Execute(SQL) Dvbbs.Dvbbs_suc("
  • 设置用户权限成功。您的操作已经记录") Dvbbs.ReloadBoardCache Dvbbs.boardid End Sub '更新指定论坛信息,取主题和最后回复作者及时间 'flag=1为根据主题ID判断,2为根据回复ID判断是否版面最后回复 Function LastCount(boardid,topicid,ireplyid,flag) LastCount=false Dim LastTopic,LastRootid,LastPostTime,LastPostUser Dim LastPost,uploadpic_n,Lastpostuserid,Lastid Dim trs Dim LastPostInfo set trs=Dvbbs.Execute("select LastPost from dv_board where boardid="&boardid) if not (trs.eof and trs.bof) then LastPostInfo=split(trs(0),"$") if ubound(LastPostInfo)=7 then if flag=1 then if clng(LastPostInfo(6))=topicid then LastCount=true elseif flag=2 then if clng(LastPostInfo(1))=ireplyid then LastCount=true end if end if end if if LastCount then set trs=Dvbbs.Execute("select top 1 T.title,b.Announceid,b.dateandtime,b.username,b.postuserid,b.rootid from "&Dvbbs.NowUseBBS&" b inner join dv_Topic T on b.rootid=T.TopicID where b.boardid="&boardid&" order by b.announceid desc") if not(trs.eof and trs.bof) then Lasttopic=replace(left(trs(0),15),"$","") LastRootid=trs(1) LastPostTime=trs(2) LastPostUser=trs(3) LastPostUserid=trs(4) Lastid=trs(5) else LastTopic="无" LastRootid=0 LastPostTime=now() LastPostUser="无" LastPostUserid=0 Lastid=0 end if LastPost=LastPostUser & "$" & LastRootid & "$" & LastPostTime & "$" & LastTopic & "$" & uploadpic_n & "$" & LastPostUserID & "$" & LastID & "$" & BoardID LastPost = Dvbbs.CheckStr(LastPost) Dim SplitUpBoardID,SplitLastPost SplitUpBoardID=split(UpdateBoardID,",") For i=0 to ubound(SplitUpBoardID) set trs=Dvbbs.Execute("select LastPost from dv_board where boardid="&SplitUpBoardID(i)) if not (trs.eof and trs.bof) then SplitLastPost=split(trs(0),"$") if ubound(SplitLastPost)=7 and clng(LastRootID)<>clng(SplitLastPost(1)) then Dvbbs.Execute("update dv_board set LastPost='"&LastPost&"' where boardid="&SplitUpBoardID(i)) end if end if Next Dvbbs.ReloadBoardCache UpdateBoardID End if set trs=Nothing End function '删除回复过程中判断该回复是否最后发言,如果是则更新主题LastPost数据并回复-1 '入口: 'TopicID--主题ID 'iReplyID--回复ID 'isUpdate--是否更新时间 '出口:isEndReply=true/false Function IsEndReply(TopicID,iReplyID,isUpdate) isEndReply=false Dim trs Dim LastPostInfo,iTotalUseTable Dim LastTopic,body,LastRootid,LastPostTime,LastPostUser Dim LastPost,uploadpic_n,LastPostUserID,LastID,istop set trs=Dvbbs.Execute("select LastPost,PostTable,istop from dv_Topic where Topicid="&Topicid) if not (trs.eof and trs.bof) then LastPostInfo=split(trs(0),"$") iTotalUseTable=trs(1) istop=trs(2) if ubound(LastPostInfo)=7 then if Clng(LastPostInfo(1))=Clng(iReplyID) then isEndReply=true end if end if if isEndReply and isUpdate=1 then set trs=Dvbbs.Execute("select top 1 topic,body,Announceid,dateandtime,username,PostUserid,rootid,boardid from "&iTotalUseTable&" where (not boardid in (444,777)) and rootid="&TopicID&" order by Announceid desc") if not(trs.eof and trs.bof) then body=trs(1) LastRootid=trs(2) LastPostTime=trs(3) LastPostUser=replace(trs(4),"$","") LastTopic=left(replace(body,"$",""),20) LastPostUserID=trs(5) LastID=trs(6) BoardID=trs(7) else LastTopic="无" LastRootid=0 LastPostTime=now() LastPostUser="无" LastPostUserID=0 LastID=0 Boardid=0 end if if istop=1 then LastPostTime=dateadd("d",100,LastPostTime) LastPost=LastPostUser & "$" & LastRootid & "$" & LastPostTime & "$" & replace(left(LastTopic,20),"$","") & "$" & LastPostInfo(4) & "$" & LastPostUserID & "$" & LastID & "$" & BoardID LastPost = Dvbbs.CheckStr(LastPost) Dvbbs.Execute("update dv_topic set LastPost='"&LastPost&"',child=child-1,LastPostTime='"&LastPostTime&"' where topicid="&TopicID) elseif isupdate=1 and not isendreply then Dvbbs.Execute("update dv_topic set child=child-1 where topicid="&topicid) end if set trs=nothing End Function Function Get_board_AccUserList(bid) Dim Rs,tmp Set Rs=Dvbbs.Execute("Select uc_userid from dv_UserAccess where uc_boardid="&bid&"") tmp="" If Not Rs.EOF Then Do while Not Rs.EOF If tmp="" Then tmp="0_"&rs(0) Else tmp=tmp&",0_"&rs(0) End If Rs.MoveNext Loop Get_board_AccUserList=tmp Else Get_board_AccUserList="" End If Set Rs=Nothing End Function Function Get_Board_GroupSetting(bid) Dim Rs,tmp Set Rs=Dvbbs.Execute("select GroupID From Dv_BoardPermission Where BoardID="&bid) tmp="" If Not Rs.EOF Then Do while Not Rs.EOF If tmp="" Then tmp=rs(0) Else tmp=tmp&","&rs(0) End If Rs.MoveNext Loop Get_Board_GroupSetting=tmp Else Get_Board_GroupSetting="" End If Set Rs=Nothing End Function %>