%
'============================
'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()
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 ""
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
Response.Write ""
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
Response.Write "编辑 "&membername&" 在 "&boardtype&" 权限 |
"
Response.Write "注意:该用户属于 "&usertitle&" 用户组中,如果您设置了他的自定义权限,则该用户权限将以自定义权限为主 |
"
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
%>
<%
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
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
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
%>