"&tM&"<\/div>" UserMenu=UserMenu&uM TouristMenu=TouristMenu&tM If Rs(2)>"" Then S="　"&MNBoard.Fun.GetJsStr(Rs(1))&"<\/a>" Else S="　"&MNBoard.Fun.GetJsStr(Rs(1))&"<\/a>" End IF If Rs(3)<>2 Then UserMenu=UserMenu&S If Rs(3)<>1 Then TouristMenu=TouristMenu&S End IF Rs1.close Set Rs1=nothing End If Rs.movenext Loop Rs.Close UserMenu=Replace(UserMenu,"{用户名}","""+user+""") '生成版块菜单 Set Rs=MNBoard.Execute("Select Depth,BoardID,ParentID,Boardname,BoardImg,Introduce,BoardAdmin,PassUser,Child,ParentStr,RootID,Strings From[i_Board] order by RootID,Orders") If not Rs.Eof Then Board_Rs=Rs.GetRows(-1) End If If IsArrAy(Board_Rs) Then For i=0 To Ubound(Board_Rs,2) Po="" If Board_Rs(0,i)=0 Then'类 BoardMenu=BoardMenu&"" BoardSelect=BoardSelect&"□┬"&Board_Rs(3,i)&"" Else For II=2 to Board_Rs(0,i) Po=Po&"∣" Next BoardMenu=BoardMenu&"" BoardSelect=BoardSelect&"  "&po&"├ "&Board_Rs(3,i)&"" End IF Next BoardSelect="跳转论坛至..."&BoardSelect&"" BoardMenu="" End If On Error Resume Next Set objFSO = Server.CreateObject("Scr"&"ipting.Fil"&"eSystemOb"&"ject") Set objName=objFSO.CreateTextFile(Server.MapPath("Inc/setmenu.js"),True) objName.Write"function UserMenu(user){"&vbcrlf&"document.write("""&UserMenu&""");"&vbcrlf&"}"&vbcrlf&"function TouristMenu(){"&vbcrlf&"document.write("""&TouristMenu&""");"&vbcrlf&"}"&vbcrlf&"function BoardListMenu(){"&vbcrlf&"document.write("""&BoardMenu&""");"&vbcrlf&"}"&vbcrlf&"function BoardSelect(){"&vbcrlf&"document.write("""&BoardSelect&""");"&vbcrlf&"}" objName.Close Set objFso=Nothing If Err Then Goback"","更新失败，空间不支持FOS文件读写！。" err.Clear Exit Sub End If Suc "","成功的更新了前台的菜单:顶部各项菜单、版块下拉菜单!","javascript:history.go(-1)" MNBoard.netlog "操作后台_生成前台Js菜单成功!" end sub Sub saveagreement() On Error Resume Next dim objFSO,objname,S Set objFSO = Server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject") Set objname=objFSO.CreateTextFile(Server.MapPath("inc/agreement.html"),True) objname.Write replace(request("content"),"'","''") objname.close Set objfso=nothing If Err Then Goback"","修改失败，空间不支持FOS文件读写！请直接编辑inc/agreement.html这个文件。" err.Clear Exit Sub End If S="修改论坛注册协议成功!" MNBoard.netlog "操作后台_"&S Suc "修改成功",S,"Admin_SetHtmlEdit.asp?Action=Agreement" End Sub Sub DelPlacard Dim ID,S ID=Request.QueryString("ID") MNBoard.execute("Delete From [i_Placard] where ID="&ID&"") MNBoard.Cache.clean("Placard") S="删除公告成功!" MNBoard.netLog"操作后台_"&S Suc"",S,"Admin_ActionList.asp?Action=Placard" End Sub Sub Placard With MNBoard Dim ID,Caption,Content,Hits,Addtime,Name,B_ID,S ID=Request.Form("ID") Caption=.Fun.GetForm("Caption") Content=.Fun.GetForm("Content") Hits=.Fun.GetForm("Hits") AddTime=.Fun.GetForm("AddTime") Name=.Fun.GetForm("Name") B_ID=.Fun.GetForm("BoardID") If Caption="" or Content="" Then GoBack"","":Exit Sub S=.Fun.UbbString(Content) If ID<>"" Then MNBoard.execute("update [i_Placard] Set Caption='"&Caption&"',[Name]='"&Name&"',Content='"&Content&"',AddTime='"&AddTime&"',ubbString='"&S&"',BoardID="&B_ID&",Hits="&Hits&" where ID="&ID&"") S="公告编辑成功" Else MNBoard.execute("insert into[i_Placard](Caption,Content,AddTime,[Name],BoardID,Hits,UbbString)values('"&Caption&"','"&Content&"','"&AddTime&"','"&Name&"',"&B_ID&","&Hits&",'"&S&"')") S="公告发布成功" End If .NetLog"操作后台_"&S .Cache.clean("Placard") Suc"",S&"！","Admin_ActionList.asp?action=Placard" End With End Sub Sub DelLockIP Dim ID ID=Int(Request("ID")) MNBoard.Execute("Delete From [i_LockIP] Where ID="&ID&"") MNBoard.Cache.clean("IPData") MNBoard.netLog"操作后台_删除封IP记录成功!" Response.redirect "Admin_Action.asp?Action=LockIp" End Sub Sub LockIp Dim ID,StartIP,EndIP,Readme,S ID=Request("ID") StartIp=MNBoard.Fun.GetForm("StartIp") EndIp=MNBoard.Fun.GetForm("EndIp") Readme=MNBoard.Fun.GetForm("Readme") If StartIp="" Then GoBack"","" Exit Sub End If if EndIp="" then EndIp=StartIp If ID<>"" Then MNBoard.execute("update [i_LockIp]Set StartIp="&MNBoard.Fun.IpEnCode(StartIp)&",EndIp="&MNBoard.Fun.IpEnCode(EndIp)&",Readme='"&Readme&"' where ID="&ID&"") S="修改封锁IP成功!" Suc"",S,"Admin_Action.asp?Action=LockIp" Else MNBoard.execute("Insert into [i_LockIp](StartIp,EndIp,Readme,lock)values("&MNBoard.Fun.IpEnCode(StartIp)&","&MNBoard.Fun.IpEnCode(EndIp)&",'"&Readme&"',1)") S="网段封锁成功!" Suc"网段封锁成功","倒霉的孩子的IP已经被封!","Admin_Action.asp?action=LockIp" End If MNBoard.netLog"操作后台_"&S MNBoard.Cache.clean("IPData") End Sub Sub IsLockIp Dim ID,IsLock,S ID=Int(Request("ID")) IsLock=MNBoard.Execute("Select Lock From[i_LockIp] where Id="&ID&"")(0) If IsLock=1 Then S="解封IP成功!" MNBoard.Execute("update [i_LockIp] set Lock=0 where Id="&ID&"") Else S="封锁IP成功!" MNBoard.Execute("update [i_LockIp] set Lock=1 where Id="&ID&"") End IF MNBoard.netLog"操作后台_"&S MNBoard.Cache.clean("IPData") Response.redirect "Admin_Action.asp?Action=LockIp" End Sub Sub AuteSqlTable Dim Aute,S,AllTable,i Aute=MNBoard.Fun.GetStr("Aute") AllTable=Split(MNBoard.BBStable(0),",") S="" For i=0 To uBound(AllTable) If Aute=AllTable(i) Then S="yes" Next If S="" Then Goback"系统出错","无效的数据表名称！":Exit Sub IF Int(Aute)<>Int(MNBoard.BBStable(1)) Then S=MNBoard.BBStable(0)&"|"&Int(Aute) MNBoard.execute("Update [i_Config] Set BbStable='"&S&"' ") End If S="更改论坛默认数据表为 i_bbs"&Aute&" 成功!" MNBoard.netLog"操作后台_"&S Suc"",S,"Admin_Action.asp?Action=SqlTable" MNBoard.Cache.clean("parameter") End Sub Sub AddSqlTable Dim TableName,AllTable,I,S TableName=MNBoard.Fun.GetStr("TableName") If not MNBoard.Fun.isInteger(TableName) then GoBack"","请用正整数的数字填写！" Exit Sub End If If Int(TableName)=0 Then GoBack"","数据表名不能为0" Exit Sub End If AllTable=Split(MNBoard.BBStable(0),",") For i=0 To uBound(AllTable) If Int(TableName)=Int(AllTable(i)) then GoBack"","数据表名已经存在！" Exit Sub End if Next S=MNBoard.BBStable(0)&","&TableName&"|"&MNBoard.BBStable(1) MNBoard.execute("update [i_config] Set BbStable='"&S&"'") MNBoard.execute("CREATE TABLE [i_bbs"&TableName&"](BbsID int IDENTITY (1, 1) NOT NULL CONSTRAINT PrimaryKey PRIMARY KEY,TopicID int Default 0,ReplyTopicID int Default 0,BoardID int Default 0,Name varchar(20),Caption varchar(255),Content text,Face int Default 0,AddTime Datetime,LastTime datetime,IsDel byte Default 0,Ip varchar(40),IsAppraise byte Default 0,UbbString varchar(255))") MNBoard.execute("create index TopicID on [i_bbs"&TableName&"] (TopicID)") MNBoard.execute("create index BoardID on [i_bbs"&TableName&"] (BoardID)") MNBoard.execute("create index ReplyTopicID on [i_bbs"&TableName&"] (ReplyTopicID)") S="添加 i_Bbs"&TableName&" 数据表成功!" MNBoard.netLog"操作后台_"&S Suc"",S,"Admin_Action.Asp?Action=SqlTable" MNBoard.Cache.clean("parameter") End Sub Sub DelSqlTable Dim ID,S,AllTable,I ID=request.querystring("ID") If int(ID)=int(MNBoard.BBStable(1)) Then GoBack "","该表被设定为默认使用表，不能删除！" Exit Sub End if AllTable=Split(MNBoard.BBStable(0),",") S="" For i=0 To uBound(AllTable) If int(ID)=Int(AllTable(i)) Then S="yes" Next If S="" Then Goback"系统出错","无效的数据表名称！":Exit Sub End If S="" For i=0 To uBound(AllTable) If Int(ID)<>int(AllTable(i)) then S=S&AllTable(i)&"," End if Next S=Left(S,len(S)-1) S=S&"|"&MNBoard.BBStable(1) MNBoard.execute("update [i_Config] Set BbStable='"&S&"'") S=MNBoard.execute("Select Count(*) From[i_bbs"&ID&"]")(0) MNBoard.Execute("Drop table [i_bbs"&ID&"]") MNBoard.Execute("Delete * From [i_Topic] where SqlTableID="&ID&"") MNBoard.Cache.clean("parameter") S="删除名称为 i_Bbs"&ID&" 的数据表("&S&"篇帖子)!" MNBoard.netLog"操作后台_"&S Suc"","成功的"&S,"Admin_Action.asp?Action=SqlTable" End Sub Sub SqlTableUnite Dim ID1,ID2,S,AllTable,i ID1=request.form("SqlTableID1") ID2=request.form("SqlTableID2") If ID1="0" or ID1="" or ID2="" or ID2="0" Then GoBack"","没有选定！" Exit Sub End If If ID1=ID2 Then GoBack "","同一个数据表还用合并吗？晕~！" Exit Sub End If If int(ID1)=int(MNBoard.BBStable(1)) Then GoBack "","指定数据表是默认使用表，不能合并到目标表！" Exit Sub End if '检验 AllTable=Split(MNBoard.BBStable(0),",") For i=0 To uBound(AllTable) If int(ID1)=Int(AllTable(i)) Then S=S&"Y" If Int(ID2)=Int(AllTable(i)) Then S=S&"Y" Next If S<>"YY" Then Goback"系统出错","无效的数据表名称！":Exit Sub Set Rs=MNBoard.Execute("select * From [i_bbs]"&ID1&"") do while not rs.eof MNBoard.execute("insert into [i_bbs"&ID2&"](TopicID,ReplyTopicID,BoardID,[Name],Caption,Content,Face,AddTime,LastTime,IsDel,Ip,IsAppraise,UbbString)values("&Rs("TopicID")&","&Rs("ReplyTopicID")&","&Rs("BoardID")&",'"&Rs("Name")&"','"&Rs("Caption")&"','"&Rs("Content")&"',"&Rs("Face")&",'"&Rs("AddTime")&"','"&Rs("LastTime")&"',"&Rs("IsDel")&",'"&Rs("Ip")&"',"&Rs("IsAppraise")&",'"&Rs("UbbString")&"')") Rs.movenext Loop Rs.close MNBoard.Execute("update [i_Topic] set SqltableID="&ID2&" where SqlTableID="&ID1) MNBoard.Execute("Drop table [i_bbs"&ID1&"]") S="" For i=0 To uBound(AllTable) If Int(ID1)<>int(AllTable(i)) then S=S&AllTable(i)&"," End if Next S=Left(S,len(S)-1) S=S&"|"&MNBoard.BBStable(1) MNBoard.execute("update [i_Config] Set BbStable='"&S&"'") S="数据表i_BBS"&ID1&"合并到数据表i_BBS"&ID2&"成功!" MNBoard.netLog "操作后台_"&S Suc"",S,"Admin_Action.asp?Action=SqlTable" MNBoard.Cache.clean("parameter") End Sub Sub UpdateBbsDate Dim EssayNum,TopicNum,NewUser,TodayNum,UserNum,AllTable,I UserNum=MNBoard.Execute("Select Count(ID) From[i_User]")(0) NewUser=MNBoard.execute("select Top 1 Name from [i_User] order by ID desc")(0) AllTable=Split(MNBoard.BBStable(0),",") For i=0 To uBound(AllTable) EssayNum=EssayNum+MNBoard.Execute("Select Count(*) From[i_Bbs"&AllTable(i)&"] where IsDel=0")(0) TodayNum=TodayNum+MNBoard.Execute("Select Count(*) From[i_Bbs"&AllTable(i)&"] where IsDel=0 And DATEDIFF('d',LastTime,'"&MNBoard.NowBbsTime&"')<1")(0) Next TopicNum=MNBoard.Execute("Select Count(TopicID) From[i_Topic]")(0) MNBoard.Execute("update [i_Config] Set UserNum="&UserNum&",AllEssayNum="&EssayNum&",TopicNum="&TopicNum&",TodayNum="&TodayNum&",NewUser='"&NewUser&"'") MNBoard.netLog"操作后台_论坛系统整理成功!" Suc "","论坛系统整理成功!整理后：

总帖数："&EssayNum&" | 主题数："&TopicNum&" | 今日帖数："&TodayNum&" | 注册用户数："&UserNum&" | 最新注册用户："&NewUser&"","Admin_Action.asp?Action=UpdateBbs" MNBoard.Cache.clean("InfoUpdate") End Sub Sub UpdateTopic Dim Caption,Content,ID1,ID2,LastReply,Go,ReplyNum,Rs1,AllTable,i,S,MaxID,II ID1=MNBoard.Fun.GetStr("id1") ID2=MNBoard.Fun.GetStr("id2") MaxID=MNBoard.execute("select max(TopicID)from [i_Topic]")(0) IF ID1="" Then ID1=1:ID2=100 Go= "开始整理" Else IF not isnumeric(ID1) or not isnumeric(ID2) then GoBack"","

请用数字填写！":Exit Sub Set Rs=MNBoard.execute("Select TopicId,SqlTableID,Name From [i_Topic] where TopicID>="&ID1&" And Topicid<="&ID2&"") IF Not Rs.eof then AllTable=Split(MNBoard.BBStable(0),",") Do while not rs.eof For i=0 To uBound(AllTable) LastReply=Rs(2)&"|暂无回复" II=0 IF Int(Rs(1))=Int(AllTable(i)) Then ReplyNum=MNBoard.execute("select count(BbsID) from [i_bbs"&Rs(1)&"] where IsDel=0 and ReplyTopicID="&Rs(0)&"")(0) Set Rs1=MNBoard.Execute("Select Name,Content From [i_bbs"&Rs(1)&"] where IsDel=0 and ReplyTopicID="&Rs(0)&" order by BbsID desc") Do while Not Rs1.Eof II=II+1 If II=1 Then LastRePly=Rs1(0)&"|"&Replace(MNBoard.Fun.StrLeft(MNBoard.Fun.FixReply(Rs1(1)),40),"'","") Rs1.movenext Loop Rs1.close MNBoard.execute("update [i_Topic] Set ReplyNum="&ReplyNum&",LastReply='"&LastReply&"' where TopicID="&Rs(0)) Exit For End If Next Rs.Movenext Loop Rs.Close Set Rs1=Nothing End If S=ID1 ID1=int(ID2)+1 ID2=int(ID2)+int(ID2)-int(S)+1 Go="继续整理" End If If Int(ID1)>Int(MaxID) Then Suc"整理结束","全部整理成功!","Admin_Action.asp?Action=UpdateBbs" MNBoard.netLog"操作后台_整理修复主题帖子" Exit Sub End If Caption="主题帖子整理" Content="

请填写你要整理的主题帖子的开始ID和结束ID：（两者之间不要相差太大）
你的论坛主题帖子最大的 ID 为："&MaxID&"
初始ID：
结束ID：

" ShowTable caption,Content End Sub Sub UpdateAllUser Dim Content,ID1,ID2,GoodNum,EssayNum,Rs1,Go,AllTable,I,S,MaxID,Flag ID1=MNBoard.Fun.GetStr("id1"):ID2=MNBoard.Fun.GetStr("id2") MaxID=MNBoard.execute("select max(id) from [i_User]")(0) IF ID1="" Then ID1=1:ID2=100 Go= "开始整理" Else IF not isnumeric(ID1) or not isnumeric(ID2) then GoBack"","

请用数字填写！":Exit Sub Set Rs=MNBoard.execute("Select ID,name,IsVIP,GradeFlag,GradeID From [i_User] where Id>="&ID1&" and id<="&ID2&"") IF Not Rs.eof then AllTable=Split(MNBoard.BBStable(0),",") Do while not rs.eof EssayNum=0 GoodNum=0 For i=0 To uBound(AllTable) EssayNum=EssayNum+MNBoard.execute("select Count(BbsID) from [i_bbs"&AllTable(i)&"] where Name='"&Rs(1)&"'")(0) Next GoodNum=MNBoard.execute("select count(TopicID) from [i_Topic] where Name='"&Rs(1)&"' And IsGood=1")(0) '更新等级 Flag=Rs(3) If Flag>3 Then Set Rs1=MNBoard.Execute("select BoardID from [i_Admin] where name='"&Rs(1)&"' order by BoardID") IF Not Rs1.eof Then IF Rs1(0)=0 Then Flag=9 ElseIF Rs1(0)=-1 Then Flag=8 Else Flag=7 End if End If Rs1.Close If Rs(2)=1 and Flag=0 Then Flag=4 ElseIf Flag=1 Then'如果为特殊组 If MNBoard.Execute("Select ID From [i_grade] where ID="&Rs(4)).Eof Then Flag=0 End IF MNBoard.UpdateGrade Rs(0),EssayNum,Flag MNBoard.execute("update [i_User] set EssayNum="&EssayNum&",GoodNum="&GoodNum&" where ID="&Rs(0)&"") Rs.Movenext Loop rs.close Set Rs1=nothing End IF S=ID1 ID1=int(ID2)+1 ID2=int(ID2)+int(ID2)-int(S)+1 Go="继续整理" End If If Int(ID1)>Int(MaxID) Then MNBoard.netLog"操作后台_整理修复用户数据" Suc"整理结束","全部整理成功!","Admin_Action.asp?Action=UpdateBbs" Exit Sub End If Content="

请填写你要整理用户的开始ID和结束ID：（两者之间不要相差太大）
论坛注册用户最大的 ID 为："&MaxID&"
初始ID：
结束ID：

" ShowTable "用户整理修复",Content End Sub Sub DelWuiong Dim i,AllTable,content Response.Write"

论坛垃圾清理

"&_ "

"&_ "

0%

" Response.Flush 'MNBoard.execute("delete * from [i_Admin] where (boardID<>0 and boardID<>-1) and (boardID not in(select BoardID from [i_Board] where parentID<>0) or name not in(select name From [i_user] where isdel=1))") Call PicPro(0,8,"正在清理无效版主！请稍等。。。") Set Rs=MNBoard.execute("Select name,BoardID from [i_Admin] where boardID<>0 and boardID<>-1") do while not Rs.eof If MNBoard.Execute("Select * From [i_Board] where ParentID<>0 and BoardID="&Rs(1)&"").eof Then MNBoard.execute("delete * from [i_Admin] where name='"&Rs(0)&"' and boardID>0 ") ElseIf MNBoard.Execute("Select * From [i_User] where Name='"&Rs(0)&"' and Isdel=0").eof Then MNBoard.execute("delete * from [i_Admin] where name='"&Rs(0)&"' and boardID>0") End If Rs.Movenext Loop Rs.Close Show"清理无效版主完毕！" Call PicPro(1,8,"正在清理无效主题！请稍等。。。") AllTable=Split(MNBoard.BBStable(0),",") For i=0 To uBound(AllTable) MNBoard.execute("delete * from [i_bbs"&AllTable(i)&"] where TopicID<>0 and not exists (select name from [i_topic] where [i_bbs"&AllTable(i)&"].TopicId=[i_Topic].TopicID)") MNBoard.execute("delete * from [i_Topic] where SqlTableID="&AllTable(i)&" and not exists (select name from [i_bbs"&AllTable(i)&"] where [i_Topic].TopicID=[i_bbs"&AllTable(i)&"].TopicId)") Next Show"无效主题清理完毕！" Call PicPro(2,8,"正在清理无效的评帖记录") MNBoard.execute("delete * from [i_Appraise] where not exists (select name from [i_Topic] where [i_Appraise].TopicID=[i_Topic].TopicId)") Show "无效评帖记录清理完毕！" Call PicPro(3,8,"正在清理无效投票！请稍等。。。") MNBoard.execute("delete * from [i_TopicVote] where not exists (select name from [i_Topic] where [i_TopicVote].TopicID=[i_Topic].TopicId)") MNBoard.execute("delete * from [i_TopicVoteUser] where not exists (select name from [i_Topic] where [i_TopicVoteUser].TopicID=[i_Topic].TopicId)") Show"无效投票清理完毕！" Call PicPro(4,8,"正在清理无效留言！请稍等。。。") MNBoard.execute("delete * from [i_Sms] where not exists (select name from [i_User] where [i_Sms].MyName=[i_User].Name)") Show"无效留言清理完毕！" Call PicPro(5,8,"正在清理无效公告！请稍等。。。") MNBoard.execute("delete * from [i_Placard] where not exists (select name from [i_User] where [i_Placard].Name=[i_User].Name)") If Not IsArray(MNBoard.Board_Rs) Then MNBoard.GetBoardCache() If IsArray(MNBoard.Board_Rs) Then For i=0 To Ubound(MNBoard.Board_Rs,2) '如果是版块为类 If MNBoard.Board_Rs(0,i)=0 Then MNBoard.execute("delete * from [i_Placard] where BoardID<0 or BoardID="&MNBoard.Board_Rs(1,i)) End If Next End If Show"无效公告清理完毕！" Call PicPro(6,8,"正在清理删除用户的帖子！请稍等。。。") For i=0 To uBound(AllTable) MNBoard.execute("delete * from [i_bbs"&AllTable(i)&"] where not exists (select name from [i_User] where [i_bbs"&AllTable(i)&"].Name=[i_User].Name)") Next MNBoard.execute("delete * from [i_Topic] where not exists (select name from [i_User] where [i_Topic].Name=[i_User].Name)") Show "无效用户的帖子清理完毕！" Call PicPro(7,8,"正在清理无效回复帖子！时间会比较长。。请稍等。。。") For i=0 To uBound(AllTable) Set Rs=MNBoard.Execute("select ReplyTopicID from [i_bbs"&AllTable(i)&"] where ReplyTopicID<>0") Do While Not Rs.eof If MNBoard.execute("select TopicID from [i_bbs"&AllTable(i)&"] where TopicID="&Rs(0)&"").eof Then MNBoard.Execute("Delete * From [i_bbs"&AllTable(i)&"] where ReplyTopicID="&Rs(0)) End IF Rs.MoveNext Loop Rs.Close Next Show"无效回复清理完毕！" Response.Write "" MNBoard.netLog"操作后台_清理论坛拉圾" End Sub '进度条 Sub PicPro(i,sum,strtxt) Response.Write "" & VbCrLf Response.Flush End Sub Sub Show(Str) Response.Write"

"&Str&"

" Response.Flush End Sub Sub UpdateLink Dim ID,I,Orders,Pass,IsPic,IsIndex For i=1 to request.form("id").count ID = Replace(request.form("id")(i),"'","") Orders = Replace(request.form("orders")(i),"'","") Pass = Replace(request.form("pass"&i&""),"'","") IsPic= Replace(request.form("ispic"&i&""),"'","") IsIndex=Replace(request.form("isindex"&i&""),"'","") IF Not isnumeric(ID) or Not isnumeric(Orders) Then GoBack "","请用数字填写!" Exit Sub End IF If Pass<>"1" Then Pass="0" If Ispic<>"1" Then Ispic="0" If IsIndex<>"1" Then IsIndex="0" MNBoard.Execute("Update [i_Link] Set Orders="&Orders&",Pass="&pass&",IsPic="&IsPic&",IsIndex="&IsIndex&" where ID="&ID&"") Next SetLinkPage MNBoard.netLog"操作后台_批量更新论坛连盟" Response.Redirect Request.ServerVariables("HTTP_REFERER") End Sub Sub SetLinkPage Dim i,ii,TempText,TempPic Set Rs=MNBoard.Execute("Select ID,Orders,BbsName,Url,pic,Readme,pass,Ispic From[i_Link] where pass=true order by orders") i=0:ii=0 do while not rs.eof if len(Rs("pic"))<8 or isnull(rs("pic")) or Rs("isPic")=0 then i=i+1 TempText=TempText&""&rs("BbsName")&"" If i=7 Then i=0 : TempText=TempText&"" ElseIF Rs("IsPic")=1 Then ii=ii+1 TempPic=TempPic&"" If ii=7 Then ii=0 : TempPic=TempPic&"" End if Rs.movenext loop Rs.close dim objFSO,objname Set objFSO = Server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject") Set objname=objFSO.CreateTextFile(Server.MapPath("LinkInfo.asp"),True) objname.Write"<"&"% MNBoard.Head""LinkInfo.asp"","""",""本站友情链接"""&VbCrLf&"Call MNBoard.ShowTable(""

本站友情链接

"","""&TempText&""&TempPic&""")"&VbCrLf&"MNBoard.Footer()"&VbCrLf&"Set MNBoard =Nothing%"&">" objname.close Set objfso=nothing MNBoard.Cache.clean("LinkInfo") End Sub Sub SaveLink Dim BbsName,Url,Pic,Readme,Admin,S,IsPic,ID,Pass BbsName=MNBoard.Fun.Getform("bbsname") Url=MNBoard.Fun.HtmlCode(Request.form("url")) Pic=MNBoard.Fun.HtmlCode(Request.form("pic")) Readme=MNBoard.Fun.GetForm("Readme") Admin=MNBoard.Fun.GetForm("admin") Pass=Request.form("pass") IsPic=Request.form("ispic") ID=Request.form("id") If BbsName="" or url="" then GoBack"","" Exit Sub End if If ID<>"" Then MNBoard.execute("Update [i_Link] Set Url='"&Url&"',Pic='"&Pic&"',BbsName='"&BbsName&"',Readme='"&Readme&"',Admin='"&Admin&"',pass="&pass&",IsPic="&IsPic&" where ID="&ID&"") S="添加论坛联盟连接成功!" Else S=MNBoard.execute("select Count(ID) From[i_Link]")(0) S=Int(S+1) MNBoard.execute("insert into [i_Link] (Bbsname,Url,Pic,Readme,admin,Orders,IsPic,pass)values('"&BbsName&"','"&Url&"','"&Pic&"','"&Readme&"','"&Admin&"',"&S&","&IsPic&","&Pass&")") S="修改论坛联盟连接成功!" End If MNBoard.netLog "操作后台_"&S Suc"",S,"Admin_ActionList.asp?action=Link" SetLinkPage End Sub Sub DelLink Dim ID,S ID=request.querystring("ID") MNBoard.execute("delete from [i_link] where ID="&ID&"") SetLinkPage S="删除论坛联盟连接成功!" MNBoard.netLog"操作后台_"&S Suc"",S,"Admin_ActionList.asp?action=Link" End Sub Sub CompressData() Dim DbPath,boolIs97,Caption,Content DbPath = request("DbPath") If request("DbPath")<> "" Then boolIs97 = request("boolIs97") DbPath = server.mappath(DbPath) CompactDB DbPath,boolIs97 Else If Dbpath="" Then DbPath="Data\MNBoard.mdb" Caption="压缩数据库" Content="注意：输入数据库所在相对路径，并且输入数据库名称（如果正在使用中数据库不能压缩，请选择备份数据库进行压缩操作）

---

"&_ "

压缩数据库： 
"&_ "如果使用 Access 97 数据库请选择(默认为 Access 2000 数据库)" ShowTable Caption,Content End If End sub Sub CompactDB(DbPath, boolIs97) Set MNBoard =Nothing Dim fso,Engine,strDbPath,JET_3X,Content strDbPath = left(DbPath,instrrev(DbPath,"\")) Set fso = CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject") If fso.FileExists(DbPath) And IsAccess(DbPath) Then fso.CopyFile DbPath,strDbPath & "temp.mdb" Set Engine = CreateObject("JRO.JetEngine") If boolIs97 = "True" Then Engine.compactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPath & "temp.mdb", _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPath & "temp1.mdb;" _ & "Jet OLEDB:Engine Type=" & JET_3X Else Engine.compactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPath & "temp.mdb", _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPath & "temp1.mdb" End If fso.CopyFile strDbPath & "temp1.mdb",DbPath fso.DeleteFile(strDbPath & "temp.mdb") fso.DeleteFile(strDbPath & "temp1.mdb") Set fso = nothing Set Engine = nothing Response.Redirect "?action=OkCompactDB&path="&DbPath Else Response.Redirect "?action=NotCompactDB" End If End Sub Sub OkCompactDB MNBoard.netLog"操作后台_压缩数据库" Suc "","你的数据库 " & request("Path") & "，已经压缩成功!" ,"?Action=CompressData" End Sub Sub NotCompactDB MNBoard.netLog"操作后台_压缩数据库失败!" GoBack "", "数据库名称或路径不正确，或者压缩过程发生意外！ 请重试！" End Sub Sub BackupData() Dim Caption,Content Caption="备份论坛数据" Content="注意事项：
论坛数据库备份几乎是站长每天必做的事！
为保证您的数据安全，备份时请不要用默认名称来命名备份数据库。
发现数据丢失的时候，就可以用你最后备份的数据库恢复。
注意：所有路径都是相对与程序空间根目录的相对路径

---

"&_ "当前数据库路径(相对路径)：
"&_ "备份数据库目录(相对路径)： 如目录不存在，程序将自动创建
"&_ "备份数据库名称(填写名称)： 如备份目录有该文件，将覆盖，如没有，将自动创建
"&_ "

" ShowTable Caption,Content If request("Go")="Start" then Dim fso,DbPath,BkFolder,BkDbName On error resume next DbPath=MNBoard.Fun.GetForm("DbPath") DbPath=server.mappath(DbPath) BkFolder=MNBoard.Fun.GetForm("BkFolder") BkDbName=MNBoard.Fun.GetForm("BkDbName") If Not IsAccess(Dbpath) Then MNBoard.netLog"操作后台_备份数据库失败!" GoBack"","备份的文件不是合法的数据库。" Exit Sub End If Set Fso=server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject") if fso.fileexists(DbPath) then If CheckDir(BkFolder) = True Then fso.copyfile DbPath,BkFolder& "\"& BkDbName else MakeNewsDir BkFolder fso.copyfile DbPath,BkFolder& "\"& BkDbName end if Caption="备份成功":Content="备份数据库成功!您备份的数据库路径为 " &BkFolder& "\"& BkDbName MNBoard.netLog"操作后台_"&Content Else Caption="错误信息":Content="找不到您所需要备份的文件。" MNBoard.netLog"操作后台_备份数据库失败!" End if ShowTable Caption,Content End if End sub '---检查某一目录是否存在----- Function CheckDir(FolderPath) Dim Fso1 Folderpath=Server.MapPath(".")&"\"&folderpath Set fso1 = CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject") If fso1.FolderExists(FolderPath) then '存在 CheckDir = True Else '不存在 CheckDir = False End if Set fso1 = nothing End Function '---根据指定名称生成目录----- Function MakeNewsDir(foldername) Dim fso1 dim f Set fso1 = CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject") Set f = fso1.CreateFolder(foldername) MakeNewsDir = True Set fso1 = nothing End Function Sub RestoreData() Dim Caption,Content Caption="恢复论坛数据" Content="注意事项：恢复数据库 一般是用来恢复(数据丢失或被破坏)的当前使用数据库。
是用备份的数据库直接把当前使用的数据库直接覆盖，请注意！
下面的路径都是相对与程序空间根目录的相对路径。

---

"&_ "

备份数据库(相对路径)： 请填写用来恢复的备份文件
"&_ "当前数据库(相对路径)： 填写您当前使用的数据库

" ShowTable Caption,Content If request("Go")="Start" then Caption="错误信息" Dim FSO,Dbpath,BackPath DbPath=MNBoard.Fun.GetForm("DbPath") BackPath=MNBoard.Fun.GetForm("BackPath") if BackPath="" or DbPath="" then Content="请把全名填写完整！" 'ElseIF Lcase(Dbpath)<>Lcase(Db) Then 'Content="您输入的不是当前使用数据库全名!" Else On error resume next DbPath=server.mappath(DbPath) BackPath=server.mappath(BackPath) If Not IsAccess(BackPath) Then GoBack"",Content&" 备份的文件不是合法的数据库。" Exit Sub End If Set Fso=server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject") if fso.fileexists(DbPath) then On Error Resume Next fso.copyfile BackPath,DbPath If err.number=0 then Caption="恢复成功":Content="成功的恢复数据库！" MNBoard.netLog"操作后台_用"&BackPath&Content Else Content="备份目录下并无您的备份文件！" Err.clear End If else Content= "不是当前使用的数据库全名" End if End IF ShowTable Caption,Content End If End sub Sub AllUpdateGrade Dim ID,orders,GradeName,EssayNum,SqlEssayNum,PIC,Spic,Flag,i,S,UpdateUser,Grouping Grouping=Int(request.form("Grouping")) If Grouping=0 Then'发帖组 For i=1 to request.form("ID").count ID = Replace(request.form("ID")(i),"'","") GradeName = Replace(request.form("GradeName")(i),"'","") EssayNum = Replace(request.form("EssayNum")(i),"'","") If GradeName="" Then GoBack "","等级名称必需填写!" Exit Sub End IF IF Not isnumeric(ID) or Not isnumeric(EssayNum) Then GoBack "","帖数需用数字填写!" Exit Sub End IF If EssayNum=0 Then S="OK" Next If S<>"OK" Then GoBack "","更新失败，你必需设置一个等级组的帖数为0!" Exit Sub End If End If S="" For i=1 to request.form("ID").count ID = Replace(request.form("ID")(i),"'","") GradeName = Replace(request.form("GradeName")(i),"'","") PIC = Replace(request.form("PIC")(i),"'","") Spic = Replace(request.form("Spic")(i),"'","") SqlEssayNum="" If Grouping=0 Then EssayNum = Replace(request.form("EssayNum")(i),"'","") Set Rs=MNBoard.Execute("Select EssayNum FROM [i_Grade] where ID="&ID&" And Grouping=0") If Not Rs.eof Then If Int(EssayNum)<>Int(Rs(0)) Then SqlEssayNum = "EssayNum="&EssayNum&"," S=S&ID&"," End If End If Rs.Close End If MNBoard.execute("Update [i_Grade] Set GradeName='"&GradeName&"',"&SqlEssayNum&"PIC='"&PIC&"',Spic='"&Spic&"' where ID="&ID&" And Grouping="&Grouping) Next If Grouping=0 Then i=0 If S<>"" Then If S<>"" THen S=left(S,len(S)-1) Set Rs=MNBoard.execute("SELECT ID,EssayNum,IsVIP from [i_USER] where GradeID in("&S&") And GradeFlag=0") Do while not Rs.eof I=I+1 MNBoard.UpdateGrade Rs(0),Rs(1),0 Rs.movenext Loop Rs.Close End IF S="发帖升级等级组(同时更新了"&I&"位会员)" ElseIF Grouping=1 Then S="特殊定制等级组" ElseIF Grouping=2 Then S="系统固定等级组" End If MNBoard.Cache.Clean("GradeInfo") MNBoard.netLog"操作后台_更新"&S&"成功!" Suc"","更新"&S&"成功!","Admin_Action.asp?Action=Grade" End Sub Sub DelGrade Dim ID,S,I ID=request("ID") S=MNBoard.execute("Select GradeName from [i_Grade] where ID="&ID&"")(0) MNBoard.execute("Delete * from [i_Grade] where ID="&ID&"") Set Rs=MNBoard.execute("Select ID,EssayNum From [i_User] where GradeID="&ID) Do while Not Rs.eof I=I+1 MNBoard.UpdateGrade Rs(0),Rs(0),0 Rs.movenext Loop Rs.close MNBoard.Cache.Clean("GradeInfo") S="删除等级组 "&S&" 成功!同时修正了"&I&"位会员" MNBoard.netLog"操作后台_"&S Suc"","删除等级组 "&S,"Admin_Action.asp?Action=Grade" End Sub Sub SaveGrade Dim S,i,ID,Strings,GradeName,EssayNum,Pic,Spic,Grouping,Flag GradeName = MNBoard.Fun.GetStr("GradeName") EssayNum = MNBoard.Fun.GetStr("EssayNum") Pic = MNBoard.Fun.GetStr("Pic") Spic=MNBoard.Fun.GetStr("Spic") ID=Request.form("ID") Grouping=Request.form("Grouping") If GradeName="" Then GoBack "","等级名称必需填写!":Exit Sub Strings=MNBoard.Fun.GetStr("S0")&"|" If len(S)>8 Then GoBack"用户的颜色填写不正确","":Exit Sub For i=1 to 37 IF Request.form("S"&i)="" Then GoBack"","":Exit Sub If Not MNBoard.Fun.isInteger(Request.form("S"&i)) then GoBack "","一些参数必须填为正整数，否则论坛不能正常运行。" Exit Sub End if Strings=Strings&Request("S"&i)&"|" Next Strings=Strings&"0|0|0" If Grouping=2 And ID<>"" Then MNBoard.execute("Update [i_Grade] Set GradeName='"&GradeName&"',PIC='"&PIC&"',Spic='"&Spic&"',Strings='"&Strings&"' where Grouping=2 and ID="&ID) S="编辑系统固定等级组成功!" MNBoard.netLog"操作后台_"&S Suc"",S,"Admin_Action.asp?Action=Grade" Else If Grouping=0 Then IF Not MNBoard.Fun.isInteger(EssayNum) Then GoBack "","帖数需用数字填写!":Exit Sub Flag=0 S="发帖升级等级组" ElseIf Grouping=1 Then EssayNum=0 Flag=1 S="特殊定制等级组" End If If ID<>"" Then MNBoard.execute("Update [i_Grade] Set Grouping="&Grouping&",GradeName='"&GradeName&"',EssayNum="&EssayNum&",PIC='"&PIC&"',Spic='"&Spic&"',Strings='"&Strings&"',Flag="&Flag&" where ID="&ID) S="编辑"&S&"成功!" Else MNBoard.execute("insert into [i_Grade] (Grouping,GradeName,EssayNum,PIC,Spic,Flag,Strings)values("&Grouping&",'"&GradeName&"',"&EssayNum&",'"&PIC&"','"&Spic&"',"&Flag&",'"&Strings&"')") S="添加"&S&"成功!" End If MNBoard.Cache.Clean("GradeInfo") MNBoard.netLog"操作后台_"&S Suc"",S&"

注意：在线用户要在下次重新登陆才会生效

","Admin_Action.asp?Action=Grade" End If End Sub Sub AllSms Dim SmsContent,UserType,Sql,Mrs,I SmsContent=MNBoard.Fun.GetStr("content") UserType=MNBoard.Fun.GetStr("caption") If SmsContent="" Then GoBack"","":Exit Sub If Len(SmsContent) >3000 Then GoBack"","字符过多":Exit Sub If UserType="1" Then Dim Temp,OnlineCache,Eachonline OnlineCache=MNBoard.Cache.Value("OnlineCache") EachOnline=Split(OnlineCache,",") For I=0 to uBound(EachOnline) Temp=Split(EachOnline(I),"|") MNBoard.Execute("insert into [i_sms](name,MyName,Content,MyFlag) values('论坛小信使','"&Temp(1)&"','"&SmsContent&"',1)") MNBoard.Execute("update [i_user] set NewSmsNum=NewSmsNum+1,SmsSize=SmsSize+1 where Name='"&Temp(1)&"'") MNBoard.UpdageOnline Temp(1),1 Next Else Select case UserType case"8" sql="select name,max(BoardID) as BoardID from [i_Admin] where BoardID=-1 group by name" Case"7" sql="select name,max(BoardID) as BoardID from [i_Admin] where BoardID>0 group by name" case"9" sql="select name,max(BoardID) as BoardID from [i_Admin] where BoardID=0 group by name" case"10" sql="select name,max(BoardID) as boardID from [i_Admin] group by name" case"4" sql="select name from [i_user] where isdel=0 and IsVip=1" case"0" sql="select name from [i_user] where isdel=0" end select Set Rs=MNBoard.Execute(Sql) If Not Rs.Eof Then MRs=Rs.GetRows(-1) rs.close For I=0 to Ubound(MRs,2) MNBoard.Execute("insert into [i_sms](name,MyName,Content,MyFlag) values('论坛小信使','"&MRs(0,i)&"','"&SmsContent&"',1)") MNBoard.Execute("update [i_user] set NewSmsNum=NewSmsNum+1,SmsSize=SmsSize+1 where Name='"&MRs(0,i)&"'") MNBoard.UpdageOnline MRs(0,i),1 Next End If End IF Suc"","成功的群发了信件!","Admin_SetHtmlEdit.asp?Action=AllSms" MNBoard.netLog"操作后台_群发信件" End Sub Sub Bank Dim Coin,UserType,Sql,Mrs,I,S,Flag UserType=MNBoard.Fun.GetStr("user") Coin=MNBoard.Fun.GetStr("Coin") Flag=MNBoard.Fun.GetStr("Flag") If UserType="" Then GoBack"","请选择用户":Exit Sub If Coin="" or Coin="0" Then GoBack"","":Exit Sub If Not isnumeric(Coin) Then GoBack"","请用数字填写！":Exit Sub If UserType="1" Then Dim Temp,OnlineCache,Eachonline OnlineCache=MNBoard.Cache.Value("OnlineCache") EachOnline=Split(OnlineCache,",") For I=0 to uBound(EachOnline)-1 Temp=Split(EachOnline(I),"|") If Flag="1" Then MNBoard.Execute("update [i_user] set Coin=Coin+"&Coin&" where Name='"&Temp(1)&"'") Else MNBoard.Execute("update [i_user] set Coin=Coin-"&Coin&" where Name='"&Temp(1)&"'") End If MNBoard.UpdageOnline Temp(1),3 Next Else Select case UserType case"8" sql="select name,max(BoardID) as BoardID from [i_Admin] where BoardID=-1 group by name" Case"7" sql="select name,max(BoardID) as BoardID from [i_Admin] where BoardID>0 group by name" case"9" sql="select name,max(BoardID) as BoardID from [i_Admin] where BoardID=0 group by name" case"10" sql="select name,max(BoardID) as boardID from [i_Admin] group by name" case"4" sql="select name from [i_user] where isdel=0 and IsVip=1" case"0" sql="select name from [i_user] where isdel=0" end select Set Rs=MNBoard.Execute(Sql) If Not Rs.Eof Then MRs=Rs.GetRows(-1) rs.close For I=0 to Ubound(MRs,2) If Flag="1" Then MNBoard.Execute("update [i_user] set Coin=Coin+"&Coin&" where Name='"&MRs(0,i)&"'") Else MNBoard.Execute("update [i_user] set Coin=Coin-"&Coin&" where Name='"&MRs(0,i)&"'") End If MNBoard.UpdageOnline MRs(0,i),3 Next End If End IF If Flag=1 Then S="送钱" Else S="扣钱" Suc"","成功的"&S&Coin&"!","Admin_Action.asp?Action=bank" MNBoard.netLog"操作后台_银行"&Coin End Sub Sub AllBoardAdmin Dim BoardAdminName,Flag,BoardID,Temp,S,i,GradeFlag BoardAdminName=MNBoard.Fun.GetStr("Name") Flag=MNBoard.Fun.GetStr("Flag") If BoardAdminName="" Then GoBack"","":Exit Sub Set Rs=MNBoard.execute("Select ID,Name,password,GradeFlag,EssayNum,IsVIP From[i_user] where name='"&BoardAdminName&"'") If Rs.eof Then GoBack"","不能操作，该用户名称还没有注册。":Exit Sub End If If Flag="Add" Then If not MNBoard.Execute("select Name From[i_Admin] where name='"&BoardAdminName&"' and BoardID<1").eof Then GoBack"","该用户已经是超级版主或站长了。":Exit Sub End If MNBoard.execute("Insert into[i_Admin](name,[password],BoardID)values('"&Rs(1)&"','"&Rs(2)&"',-1)") MNBoard.UpdateGrade Rs(0),0,8 S="成功的添加了超级版主 "&BoardAdminName&" !" Else If MNBoard.Execute("select Name From[i_Admin] where name='"&BoardAdminName&"' and BoardID=-1").eof Then GoBack"","该用户不是超级版主":Exit Sub MNBoard.Execute("Delete From[i_Admin] where BoardID=-1 And Name='"&BoardadminName&"'") If Not MNBoard.Execute("select Name From[i_Admin]").eof Then GradeFlag=7 Else GradeFlag=0 If Rs(5)=1 Then GradeFlag=4 End If MNBoard.UpdateGrade Rs(0),Rs(3),GradeFlag S="成功撤消了超级版主 "&BoardAdminName&" 的职位！" End if '在线刷新 MNBoard.UpdageOnline BoardAdminName,3 Rs.Close MNBoard.netLog "操作后台_"&S MNBoard.Cache.clean("BoardInfo") Suc"",S,"Admin_Action.asp?Action=BoardAdmin" End Sub Sub BoardAdmin Dim BoardAdminName,Flag,BoardID,Temp,S,i BoardAdminName=MNBoard.Fun.GetStr("Name") Flag=MNBoard.Fun.GetStr("Flag") BoardID=MNBoard.Fun.GetStr("BoardID") If BoardAdminName="" Then GoBack"","" Exit Sub ElseIf BoardID="" Then GoBack"","请先选择管理的论坛版块" Exit Sub End If Set Rs=MNBoard.execute("Select ID,Name,password,GradeFlag,EssayNum,IsVIP From[i_user] where name='"&BoardAdminName&"'") If Rs.eof Then GoBack"","不能添加版主，该用户名称还没有注册。":Exit Sub End If If Flag="Add" Then If Not MNBoard.Execute("select Name From[i_Admin] where BoardID="&BoardID&" and Name='"&BoardadminName&"'").eof Then GoBack"","该用户已经是本版的版主了。":Exit Sub Else Temp=MNBoard.Execute("Select BoardAdmin From[i_Board] where BoardID="&BoardID&"")(0) If Temp="" or isnull(Temp) Then Temp=BoardAdminName Else Temp=Temp&"|"&BoardAdminName End If MNBoard.execute("Insert into[i_Admin](name,[password],BoardID)values('"&Rs(1)&"','"&Rs(2)&"',"&BoardID&")") MNBoard.execute("update [i_Board] Set BoardAdmin='"&Temp&"' where BoardID="&BoardID) If Rs(3)<7 Then MNBoard.UpdateGrade Rs(0),0,7 End If S="成功的添加了版主 "&BoardAdminName&" !" End If Else Temp=MNBoard.Execute("Select BoardAdmin From[i_Board] where BoardID="&BoardID&"")(0) Temp=split(Temp,"|") For i=0 To uBound(temp) IF lcase(BoardAdminName)<>lcase(Temp(i)) Then S=S&Temp(i)&"|" Next If S<>"" Then S=left(S,len(S)-1) MNBoard.Execute("Delete From[i_Admin] where BoardID="&BoardID&" And Name='"&BoardadminName&"'") MNBoard.Execute("Update [i_Board] Set BoardAdmin='"&S&"' where BoardID="&BoardID&"") If Rs(3)=7 Then If Rs(5)=1 Then'如果是VIP MNBoard.UpdateGrade Rs(0),0,4 Else MNBoard.UpdateGrade Rs(0),Rs(3),0 End If End If S="成功撤消了版主 "&BoardAdminName&" 的职位！" End if Rs.Close '在线刷新 MNBoard.UpdageOnline BoardAdminName,3 MNBoard.netLog "操作后台_"&S MNBoard.Cache.clean("BoardInfo") Suc"",S,"Admin_Action.asp?Action=BoardAdmin" End Sub Sub DelFaction Dim Name Name=Request.QueryString("Name") MNBoard.Execute("Delete * From[i_Faction] where Name='"&Name&"'") MNBoard.Execute("update [i_User] Set Faction='' where Faction='"&Name&"'") MNBoard.netLog "操作后台_删除帮派 "&Name Suc"","成功删除了帮派！","Admin_Action.asp?Action=Faction" End Sub Sub SaveFaction Dim Name,FullName,Note,User,BuildDate,ID,S ID=MNBoard.Fun.GetStr("ID") Name=MNBoard.Fun.GetStr("Name") FullName=MNBoard.Fun.GetStr("FullName") Note=MNBoard.Fun.GetStr("Note") User=MNBoard.Fun.GetStr("User") BuildDate=MNBoard.Fun.GetStr("BuildDate") IF Name="" Or FullName="" Or Note="" or User="" Then Call Goback("",""):Exit Sub If Not isDate(BuildDate) Then BuildDate=MNBoard.NowBBSTime IF MNBoard.Execute("select name From[i_User] where Name='"&User&"'").eof Then GoBack"","掌门人必须是注册会员！":Exit Sub End If If ID<>"" Then Set Rs=MNBoard.Execute("Select Name From[i_Faction] where ID="&ID) If Rs.Eof Then Goback"","记录已被删除了！" If Name<>Rs(0) Then MNBoard.Execute("update [i_User] Set Faction='"&Name&"' where Faction='"&Rs(0)&"'") End If Rs.Close MNBoard.Execute("update [i_Faction] Set [Name]='"&Name&"',FullName='"&FullName&"',[Note]='"&Note&"',[User]='"&User&"',BuildDate='"&BuildDate&"' where ID="&ID) S="成功修改了帮派："&Name Else MNBoard.execute("Insert into[i_Faction](Name,FullName,[Note],BuildDate,[User])Values('"&Name&"','"&FullName&"','"&Note&"','"&BuildDate&"','"&User&"')") MNBoard.Execute("update [i_User] Set Faction='"&Name&"' where Name='"&User&"'") S="成功添加了帮派："&Name End If Suc"",S,"Admin_Action.asp?Action=Faction" MNBoard.netLog "操作后台_"&S End Sub Sub DelEssay Dim UserName,DateNum,BoardID,AllTable,I,SqlWhere,S DateNum=MNBoard.Fun.GetStr("DateNum") BoardID=MNBoard.Fun.GetStr("BoardID") UserName=MNBoard.Fun.GetStr("Name") AllTable=Split(MNBoard.BBStable(0),",") Select Case Request("Go") Case"Date" If not isnumeric(DateNum) Then GoBack"","天数必需用数字填写！":Exit Sub If BoardID=0 Then SQlwhere="" S="成功删除"&DateNum&"天前发表的主题帖（包括其回复帖）！" Else S="成功删除在 "&MNBoard.Execute("Select BoardName From[i_Board]where BoardID="&BoardID&"")(0)&" 上"&DateNum&"天前发表的主题帖（包括其回复帖）！" Sqlwhere=" And BoardID="&BoardID End If Set Rs=MNBoard.Execute("Select TopicID,SqlTableID,BoardID From [i_Topic] where DATEDIFF('d',[AddTime],'"&MNBoard.NowBbsTime&"')>"&DateNum&Sqlwhere&"") Do while not Rs.eof MNBoard.Execute("Delete From[i_Bbs"&Rs(1)&"] where (TopicID="&Rs(0)&" or ReplyTopicID="&Rs(0)&") "&SqlWhere&"") MNBoard.Execute("Delete From[i_Appraise] where TopicID="&Rs(0)) MNBoard.execute("Delete From [i_TopicVote] where TopicID="&Rs(0)) MNBoard.execute("Delete From [i_TopicVoteUser] where TopicID="&Rs(0)) Rs.MoveNext Loop Rs.close MNBoard.Execute("Delete From[i_Topic] where DATEDIFF('d',[AddTime],'"&MNBoard.NowBbsTime&"')>"&DateNum&Sqlwhere) Suc"",S&"

删除后建议对论坛做一次整理，来重计版面的帖数","Admin_Action.asp?Action=DelEssay" MNBoard.netLog"操作后台_"&S Case"DateNoRe" If not isnumeric(DateNum) Then GoBack"","天数必需用数字填写！":Exit Sub If BoardID=0 Then SQlwhere="" S="成功删除"&DateNum&"天前没有回复的所有主题帖（包括其回复）！！" Else S="成功删除在 "&MNBoard.Execute("Select BoardName From[i_Board]where BoardID="&BoardID&"")(0)&" 上"&DateNum&"天前没有回复的所有主题帖（包括其回复帖）！" Sqlwhere=" And BoardID="&BoardID End If Set Rs=MNBoard.Execute("Select TopicID,SqlTableID,BoardID From [i_Topic] where DATEDIFF('d',LastTime,'"&MNBoard.NowBbsTime&"')>"&DateNum&Sqlwhere&"") Do while not Rs.eof MNBoard.Execute("Delete From[i_Bbs"&Rs(1)&"] where (TopicID="&Rs(0)&" or ReplyTopicID="&Rs(0)&") "&SqlWhere&"") MNBoard.Execute("Delete From [i_Appraise] where TopicID="&Rs(0)) MNBoard.execute("Delete From [i_TopicVote] where TopicID="&Rs(0)) MNBoard.execute("Delete From [i_TopicVoteUser] where TopicID="&Rs(0)) Rs.MoveNext Loop Rs.close MNBoard.Execute("Delete From [i_Topic] where DATEDIFF('d',LastTime,'"&MNBoard.NowBbsTime&"')>"&DateNum&Sqlwhere) Suc"",S&"

删除后建议对论坛做一次整理，来重计版面的帖数","Admin_Action.asp?Action=DelEssay" MNBoard.netLog"操作后台_"&S Case"User" If UserName="" Then GoBack"","":Exit Sub IF MNBoard.Execute("select name From[i_User] where Name='"&UserName&"'").eof Then GoBack"","这个用户根本不存在！":Exit Sub End If If BoardID=0 Then SQlwhere="" S="成功删除用户 "&UserName&" 的所有帖子！！" Else S="成功删除用户 "&UserName&"在 "&MNBoard.Execute("Select BoardName From[i_Board]where BoardID="&BoardID&"")(0)&" 的帖子！" Sqlwhere=" And BoardID="&BoardID End If Set Rs=MNBoard.Execute("select TopicID,SqltableID From[i_Topic] where Name='"&UserName&"'"&SqlWhere&"") do while not Rs.eof MNBoard.Execute("Delete From[i_Bbs"&Rs(1)&"] where (TopicID="&Rs(0)&" or ReplyTopicID="&Rs(1)&") "&SqlWhere&"") MNBoard.Execute("Delete From [i_Appraise] where TopicID="&Rs(0)) MNBoard.execute("Delete From [i_TopicVote] where TopicID="&Rs(0)) MNBoard.execute("Delete From [i_TopicVoteUser] where TopicID="&Rs(0)) Rs.movenext Loop MNBoard.Execute("Delete From[i_Topic] where Name='"&UserName&"'"&SqlWhere&"") For i=0 To uBound(AllTable) MNBoard.Execute("Delete From[i_Bbs"&AllTable(i)&"] where Name='"&UserName&"'"&SqlWhere&"") Next Suc"",S&"

删除后建议对论坛做一次整理，来重计版面的帖数","Admin_Action.asp?Action=DelEssay" MNBoard.netLog"操作后台_"&S Case Else GoBack"","提交的路径不正确" End Select End Sub Sub DelSms Dim UserName,DateNum,BoardID,S DateNum=MNBoard.Fun.GetStr("DateNum") Select Case Request("Go") Case"Date" If not isnumeric(DateNum) Then GoBack"","天数必需用数字填写！":Exit Sub MNBoard.Execute("Delete From[i_Sms] where DATEDIFF('d',[AddTime],'"&MNBoard.NowBbsTime&"')>"&DateNum&"") S="已经成功删除在"&DateNum&"天前的所有留言信件！" Case"User" UserName=MNBoard.Fun.GetStr("Name") IF UserName="" Then GoBack"","":Exit Sub IF MNBoard.Execute("select name From[i_User] where Name='"&UserName&"'").eof Then GoBack"","这个用户根本不存在！":Exit Sub MNBoard.Execute("Delete From[i_Sms] where MyName='"&UserName&"'") S="成功删除了用户 "&UserName&" 的所有留言信件！" Case"Auto" If not isnumeric(DateNum) Then GoBack"","天数必需用数字填写！":Exit Sub MNBoard.Execute("Delete From[i_Sms] where DATEDIFF('d',[AddTime],'"&MNBoard.NowBbsTime&"')>"&DateNum&" And Name In ('自动送信系统','论坛小信使')") S="成功删除在"&DateNum&"天前的所有论坛自动送信的留言信件！" End Select MNBoard.netLog "操作后台_"&S Suc"",S,"Admin_Action.asp?Action=DelSms" End Sub Sub MoveEssay Dim BoardID1,BoardID2,DateNum,UserName,AllTable,I,S BoardID1=MNBoard.Fun.GetStr("BoardID1") BoardID2=MNBoard.Fun.GetStr("BoardID2") IF BoardID1=BoardID2 Then GoBack"","您还没有选择目标论坛！":Exit Sub AllTable=Split(MNBoard.BBStable(0),",") DateNum=MNBoard.Fun.GetStr("DateNum") UserName=MNBoard.Fun.GetStr("Name") Select Case Request("Go") Case"Date" If not isnumeric(DateNum) Then GoBack"","天数必需用数字填写！":Exit Sub Set Rs=MNBoard.Execute("Select TopicID,SqlTableID from[i_Topic] Where DATEDIFF('d',[AddTime],'"&MNBoard.NowBbsTime&"')>"&DateNum&" and BoardID="&BoardID1) Do while not Rs.eof MNBoard.Execute("update [i_Bbs"&Rs(1)&"] Set BoardID="&BoardID2&" where BoardID="&BoardID1&" and (TopicID="&Rs(0)&" or ReplyTopiciD="&Rs(0)&")") Rs.movenext Loop Rs.Close MNBoard.Execute("update [i_Topic] Set BoardID="&BoardID2&" where BoardID="&BoardID1&" And DATEDIFF('d',[AddTime],'"&MNBoard.NowBbsTime&"')>"&DateNum&"") S="成功的把"&DateNum&"天前的帖子从 " Case"User" If UserName="" Then GoBack"","":Exit Sub IF MNBoard.Execute("select name From[i_User] where Name='"&UserName&"'").eof Then GoBack"","这个用户根本不存在！":Exit Sub End IF Set Rs=MNBoard.Execute("Select TopicID,SqlTableID from[i_Topic] Where Name='"&UserName&"' And BoardID="&BoardID1) Do while not Rs.eof MNBoard.Execute("update [i_Bbs"&Rs(1)&"] Set BoardID="&BoardID2&" where BoardID="&BoardID1&" and (TopicID="&Rs(0)&" or ReplyTopiciD="&Rs(0)&")") Rs.movenext Loop Rs.Close MNBoard.Execute("update [i_Topic] Set BoardID="&BoardID2&" Where BoardID="&BoardID1&" and Name='"&UserName&"'") S="成功的把"&UserName&"的帖子从 " End Select S=S&MNBoard.Execute("select BoardName From[i_Board] where BoardID="&BoardID1&"")(0)&" 移动到 "&MNBoard.Execute("select BoardName From[i_Board] where BoardID="&BoardID2&"")(0)&"！" MNBoard.netLog"操作后台_"&S Suc"",S&"！现在进行一次 版面整理 ！","Admin_Action.asp?Action=MoveEssay" End Sub Sub Clean Application.Contents.RemoveAll Suc "","更新缓存成功","Admin_Action.asp?Action=Clean" MNBoard.netLog"操作后台_更新缓存" End Sub Sub TopAdmin Dim TopAdminName,Flag,S,GradeFlag TopAdminName=Replace(Request("Name"),"'","") Flag=Request("Flag") If TopAdminName="" Then GoBack"","":Exit Sub End If Set Rs=MNBoard.execute("Select Name,password,ID,IsVip,EssayNum From[i_user] where name='"&TopAdminName&"'") If Rs.eof Then GoBack"","该用户名称还没有注册。":Exit Sub If Flag="1" Then If Not MNBoard.Execute("select Name From[i_Admin] where BoardID<1 and Name='"&TopadminName&"'").eof Then GoBack"","该用户已经是管理员！":Exit Sub End If MNBoard.execute("Insert into[i_Admin](name,[password],BoardID)values('"&Rs(0)&"','"&Rs(1)&"',0)") MNBoard.UpdateGrade Rs(2),0,9 S="成功添加了" Else MNBoard.Execute("delete * from [i_Admin] where name='"&TopAdminName&"' and boardID=0") GradeFlag=0 If Rs(3)=1 Then Flag=4 If Not MNBoard.Execute("select BoardID from [i_Admin] where name='"&TopAdminName&"'").eof Then GradeFlag=7 End if MNBoard.UpdateGrade Rs(2),Rs(4),GradeFlag S="成功撒销了" End If Rs.Close S=S&MNBoard.GetGradeName(0,9)&":"&TopadminName&" !" MNBoard.UpdageOnline TopadminName,3 MNBoard.netLog"操作后台_"&S Suc"",S,"Admin_Action.asp?Action=TopAdmin" End Sub Sub GapAd Dim content Dim Temp,I,objFSO,objname,TmpStr,ad_num,ad_tmp,adv_num,ii Set objFSO = Server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject") Set objName=objFSO.OpenTextFile(Server.MapPath("inc/ads.js")) tmpstr=objName.readall temp=split(tmpstr,chr(13)&chr(10)) ad_num=replace(Temp(1),";if(a==0){a=1}","") ad_num=Int(replace(ad_num,"a=","")) objName.close Set objFSO=nothing Content="" ii=0 for i=1 to ad_num+1 ad_tmp=Replace(Request.form("ad_v"&i&""),"'","") if Trim(ad_tmp)<>"" or isnull(ad_tmp)then ii=ii+1 Content=Content&"b["&ii&"].under=' "&ad_tmp&"'"&vbcrlf end if next Set objFSO = Server.CreateObject("Scr"&"ipting"&".Fil"&"eSy"&"stemOb"&"ject") Set objname=objFSO.CreateTextFile(Server.MapPath("Inc/Ads.js"),True) objname.Write"" objname.close set objfso=nothing MNBoard.netLog"操作后台_修改帖间广告" Response.redirect"Admin_Action.asp?Action=GapAd" End Sub '检验是否是数据库 Function IsAccess(AccessPath) On Error Resume Next IsAccess=False Dim TempConn Set TempConn=Server.CreateObject("Adodb.connection") TempConn.Open "Provider=Microsoft.jet.oledb.4.0;data source="&AccessPath If Err.Number<>0 Then IsAccess=False Else IsAccess=True End If TempConn.Close Set TempConn=Nothing End Function %>