<!--#include file="conn.asp"--> <!--#Include File="inc/Dv_ClsMain.asp"--> <!--#include file="inc/md5.asp"--> <!-- #include file="inc/myadmin.asp" --> <title>Dvbbs-Key管理员钥匙工具For Dv7.0</title> <link rel="stylesheet" href="forum_admin.css" type="text/css"> <meta NAME=GENERATOR Content="Microsoft FrontPage 3.0" CHARSET=GB2312> <BODY leftmargin="0" bottommargin="0" rightmargin="0" topmargin="0" marginheight="0" marginwidth="0" bgcolor="#DDEEFF"> <% REM ============================== REM Dvbbs.Yangzheng编改于 2004-4-3 REM ============================== Response.Buffer = True Server.ScriptTimeout = 999999 Dim Rs,Sql,I REM 加入管理员默认权限 Session("flag") = "1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36" Session("Userid") = "" Dim Flag Flag = "1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36" Dim Groupsname, Titlepic Sql = "SELECT Title, GroupPic FROM Dv_UserGroups WHERE (UserGroupID = 1)" Set Rs = Dvbbs.Execute(Sql) If Rs.Eof And Rs.Bof Then Groupsname = "管理员" '管理员等级 Titlepic = "level10.gif" '管理员代表图标 Else Groupsname = Rs(0) '管理员等级 Titlepic = Rs(1) '管理员代表图标 End If Rs.Close:Set Rs=Nothing
Dim AllPostTable Dim AllPostTableName AllPostTable1 AllPostTableName = Split(AllPostTableName,"|") '帖子表名称数组 AllPostTable = Split(AllPostTable,"|") '帖子表数组
Select Case Request("action") Case "newpsw" Call Newpsw() '新管理员 Case "changepsw" Call Changepsw() '更改管理员密码表单 Case "openbbs" Call Openbbs() '打开论坛 Case "saveedit" Call Saveedit() '保存更改密码 Case "boardchild" Call Boardchild() '计算子论坛数量 Case "fixtop" Call Fixtop() '修复固顶帖 Case "flower" Call Flower() '修复鲜花鸡蛋 Case "delfile" Call Delfile() '删除key管理文件 Case "DelallCache" Call DelallCache() '更新服务器缓存 Case "Fixusertopic" Call Fixusertopic() '更新用户数据 Case "fixonlinetime" Call Fixonlinetime() '更新用户数据 Case Else Call Main() '主菜单 End Select Response.Write "</body></html>"
REM ========== REM 主显示菜单 REM ========== Sub Main() 'On Error Resume Next Dim Boardnum '版块个数 Dim Usernum '用户个数 Dim Adminname '管理员名称 Dim Findadmin '是否找到管理员 Dim Bbstype '论坛类型 Dim Bbsopen '论坛是否开启状态 Dim Onlinetime '在线删除用户时间 Dim iForum_Setting Adminname = "admin" '要创建的管理员名，可更改。 Findadmin = False Sql = "SELECT COUNT(Boardid) FROM [Dv_Board]" Set Rs = Dvbbs.Execute(Sql) Boardnum = Rs(0) Rs.Close Sql = "SELECT COUNT(Userid) FROM [Dv_User]" Set Rs = Dvbbs.Execute(Sql) Usernum = Rs(0) Rs.Close Sql = "SELECT Userid From [Dv_User] Where Username = '" & Adminname & "'" Set Rs = Dvbbs.Execute(Sql) If Rs.Eof And Rs.Bof Then Findadmin = False Else Findadmin = True End If Rs.Close If IsSqlDataBase = 1 Then Bbstype = "SQL版" Else Bbstype = "ACCESS版" End If '判断论坛是否开启，与在线时间是否溢出 Set Rs = Dvbbs.Execute("SELECT Top 1 Forum_Setting FROM [Dv_Setup]") If Rs.Eof And Rs.Bof Then Bbsopen = False Onlinetime = 20 Else iForum_Setting = Split(Rs(0),"|||") If Split(iForum_Setting(1),",")(21) = "0" Then Bbsopen = True Else Bbsopen = False End If If Isnumeric(Split(iForum_Setting(1),",")(8)) Then Onlinetime = Split(iForum_Setting(1),",")(8) End If End If Rs.Close Response.Write "<br><br>" '输出站点信息 Call Ltinfo() Response.Write "<table cellpadding=1 cellspacing=0 border=0 align=center style=""border: outset 3px;width:95%;"">"&_ "<FORM METHOD=POST ACTION=""?action=newpsw"">"&_ "<tr>"&_ "<th width=80% height=19 colspan=2 id=tabletitlelink>Dvbbs-Key管理员钥匙工具 For " Response.Write Bbstype Response.Write " Dvbbs 7.0.0" If IsSp2 Then Response.Write ".Sp2" Else Response.Write ".Sp1 (请尽快升级到Sp2)" If IsSqlDataBase = 1 Then Response.Write " 商业版客服QQ：20522910" End If Response.Write "</th>"&_ "<th width=""20%"">Edit By Dv.Yz.2004-4-3</th>"&_ "</tr>"&_ "<tr>"&_ "<td width=20% height=23 class=forumrow>新建帐号</td>"&_ "<td width=50% height=23 class=forumrow>重新建立新的管理员帐号：" Response.Write Adminname Response.Write "</td>"&_ "<td width=30% height=23 class=forumrow valign=middle>" If Findadmin Then Response.Write "<input type=submit name=submit value=禁止新建 disabled>"&_ " <font color=gray>论坛已存在[" Response.Write Adminname Response.Write "]用户名</font>" Else Response.Write "<input type=submit name=submit value=新建帐号>"&_ "<input type=hidden name=newname value=" Response.Write Adminname Response.Write "> <font color=red>点击将创建[" Response.Write Adminname Response.Write "]为管理员</font>" End If Response.Write "</td>"&_ "</tr>"&_ "</FORM>"&_ "<FORM METHOD=POST ACTION=""?action=changepsw"">"&_ "<tr>"&_ "<td height=23 class=forumRowHighlight>修改密码</td>"&_ "<td height=23 class=forumRowHighlight>当管理员权限及密码丢失时，重新修改密码。</td>"&_ "<td width=30% height=23 class=forumRowHighlight valign=middle>"&_ "<input type=submit name=submit value=修改密码>"&_ "</td>"&_ "</tr>"&_ "</FORM>"&_ "<FORM METHOD=POST ACTION=""?action=openbbs"">"&_ "<tr>"&_ "<td height=23 class=forumRow>开启论坛</td>"&_ "<td height=23 class=forumRow>论坛关闭快速开启功能。</td>"&_ "<td width=30% height=23 class=forumRow valign=middle>" If Bbsopen Then Response.Write "<input type=submit name=submit value=无需开启 disabled>"&_ " <font color=gray>论坛处于开启状态</font>" Else Response.Write "<input type=submit name=submit value=开启论坛>"&_ " <font color=red>开启关闭中的论坛</font>" End If Response.Write "</td>"&_ "</tr>"&_ "</FORM>"&_ "<FORM METHOD=POST ACTION=""?action=boardchild"">"&_ "<tr>"&_ "<td height=23 class=forumRowHighlight>分版统计</td>"&_ "<td height=23 class=forumRowHighlight>重新统计下属论坛个数，论坛共[<font color=red>" Response.Write Boardnum Response.Write "</font>]个版面。</td>"&_ "<td width=30% height=23 class=forumRowHighlight valign=middle>"&_ "<input type=submit name=submit value=个数统计>"&_ "</td>"&_ "</tr>"&_ "</FORM>" Dim Mustfix '是否需要修复 Dim Mustfixnum '已删除的主题固顶 Set Rs = Dvbbs.Execute("SELECT COUNT(Topicid) FROM [Dv_Topic] WHERE (istop > 0) AND (Boardid = 444 OR Boardid = 777 OR Boardid = 0)") Mustfixnum = Rs(0) '主题表无发帖表情 Set Rs = Dvbbs.Execute("SELECT COUNT(Topicid) FROM [Dv_Topic] WHERE Expression IS NULL OR Expression = ''") Mustfixnum = Mustfixnum + Rs(0) '分版无分版设置 Set Rs = Dvbbs.Execute("SELECT COUNT(Boardid) FROM [Dv_Board] WHERE Board_User IS NULL") Mustfixnum = Mustfixnum + Rs(0) '修复以往版本有BOARDID444的分版自定义权限错误 Set Rs = Dvbbs.Execute("SELECT COUNT(uc_UserID) FROM [Dv_UserAccess] WHERE Uc_Boardid = 444 OR Uc_Boardid = 777") Mustfixnum = Mustfixnum + Rs(0) Rs.Close If Mustfixnum > 0 Then Mustfix = True Else Mustfix = False End If Response.Write "<FORM METHOD=POST ACTION=""?action=fixtop"">"&_ "<tr>"&_ "<td height=23 class=forumRow>修复多项</td>"&_ "<td height=23 class=forumRow>修复固顶帖，修复主题表情，修复分版Board_user字段。</td>"&_ "<td width=30% height=23 class=forumRow valign=middle>" If Mustfix Then Response.Write "<input type=submit name=submit value=开始修复>"&_ " <font color=red>论坛中有" Response.Write Mustfixnum Response.Write "处此项错误</font>" Else Response.Write "<input type=submit name=submit value=无需修复 disabled>"&_ " <font color=gray>论坛中无此项错误</font>" End If Response.Write "</td>"&_ "</tr>"&_ "</FORM>"&_ "<FORM METHOD=POST ACTION=""?action=DelallCache"">"&_ "<tr>"&_ "<td height=23 class=forumRowHighlight>清除缓存</td>"&_ "<td height=23 class=forumRowHighlight>清空本论坛所在服务器的缓存信息。</td>"&_ "<td width=30% height=23 class=forumRowHighlight valign=middle>"&_ "<input type=submit name=submit value=点击清除>"&_ "</td>"&_ "</tr>"&_ "</FORM>" Mustfixnum = 0 For i = 0 To Ubound(AllPostTable) Conn.CommandTimeOut = 0 Set Rs = Dvbbs.Execute("SELECT COUNT(*) FROM [" & AllPostTable(i) & "] WHERE ParentID = 0 AND ((Not IsAgree LIKE '%|%') Or (IsAgree IS NULL))") Mustfixnum = Mustfixnum + Rs(0) ' If Mustfixnum > 0 Then Exit For Next Rs.Close If Mustfixnum > 0 Then Mustfix = True Else Mustfix = False End If Response.Write "<FORM METHOD=POST ACTION=""?action=flower"">"&_ "<tr>"&_ "<td height=23 class=forumRow>鲜花鸡蛋</td>"&_ "<td height=23 class=forumRow>修复鲜花与鸡蛋显示undefined。</td>"&_ "<td width=30% height=23 class=forumRow valign=middle>" If Mustfix Then Response.Write "<input type=submit name=submit value=开始修复>"&_ " <font color=red>论坛中有" Response.Write Mustfixnum Response.Write "处此项错误</font>" Else Response.Write "<input type=submit name=submit value=无需修复 disabled>"&_ " <font color=gray>论坛中无此项错误</font>" End If Response.Write "</td>"&_ "</tr>"&_ "</FORM>" Set Rs = Dvbbs.Execute("SELECT COUNT(UserID) FROM [Dv_User] WHERE (UserTopic IS NULL)") Mustfixnum = Rs(0) If IsSqlDataBase = 1 Then Set Rs = Dvbbs.Execute("SELECT COUNT(UserID) FROM [Dv_User] WHERE (Joindate IS NULL) Or Joindate = ''") Mustfixnum = Mustfixnum + Rs(0) Else Set Rs = Dvbbs.Execute("SELECT COUNT(UserID) FROM [Dv_User] WHERE (Joindate IS NULL) Or NOT ISDATE(Joindate)") Mustfixnum = Mustfixnum + Rs(0) End If Set Rs = Dvbbs.Execute("SELECT COUNT(UserID) FROM [Dv_User] WHERE UserBirthday = '//'") Mustfixnum = Mustfixnum + Rs(0) Rs.Close If Mustfixnum > 0 Then Mustfix = True Else Mustfix = False End If Response.Write "<FORM METHOD=POST ACTION=""?action=Fixusertopic"">"&_ "<tr>"&_ "<td height=23 class=forumRowHighlight>修用户值</td>"&_ "<td height=23 class=forumRowHighlight>修复用户主题值、注册日期为空，星座显示undefined的错误，论坛共[<font color=red>" Response.Write Usernum Response.Write "</font>]名用户。</td>"&_ "<td width=30% height=23 class=forumRowHighlight valign=middle>" If Mustfix Then Response.Write "<input type=submit name=submit value=点击修复>"&_ " <font color=red>论坛中有" Response.Write Mustfixnum Response.Write "处此项错误</font>" Else Response.Write "<input type=submit name=submit value=无需修复 disabled>"&_ " <font color=gray>论坛中无此项错误</font>" End If Response.Write "</td>"&_ "</tr>"&_ "</FORM>"&_ "<FORM METHOD=POST ACTION=""?action=fixonlinetime"">"&_ "<tr>"&_ "<td height=23 class=forumRow>在线时间</td>"&_ "<td height=23 class=forumRow>删除不活动用户时间填写过大会影响论坛运行。</td>"&_ "<td width=30% height=23 class=forumRow valign=middle>" If Onlinetime < 32767 Then Response.Write "<input type=submit name=submit value=无需修复 disabled>"&_ " <font color=gray>时间数值正常(" Response.Write Onlinetime Response.Write "分钟)</font>" Else Response.Write "<input type=submit name=submit value=开始修复>"&_ " <font color=red>修正时间值(" Response.Write Onlinetime Response.Write "分钟)</font>" End If Response.Write "</td>"&_ "</tr>"&_ "</FORM>"&_ "<tr>"&_ "<th colspan=2 id=tabletitlelink>！！！切记使用完毕后立刻"&_ " <i>改名</i> 或"&_ " <i>删除</i> 此文件，不要留下后门哦^！^ --->>>"&_ "<a href=" Response.Write Dvbbs.ScriptName Response.Write "?action=delfile>点击删除</a>"&_ "</th>"&_ "<th align=left id=tabletitlelink>"&_ "<a href=index.asp><<<<回到论坛>>>></a></th>"&_ "</tr>"&_ "</table>" Set Rs = Nothing End Sub
REM ========================== REM 修改管理员与设置管理员页面 REM ========================== Sub Changepsw() Sql = "SELECT U.UserID, U.UserName, U.UserPassWord, U.LastLogin, A.UserName, A.PassWord, A.LastLogin, A.LastLoginIP FROM [Dv_User] U INNER JOIN [" & Admintable & "] A ON U.UserName = A.AddUser WHERE U.UserGroupID = 1 ORDER BY U.UserID" Set Rs = Conn.Execute(Sql) If Rs.Eof And Rs.Bof Then Sql = "" Else Sql = Rs.GetString(,,"</td><td>|","</td></tr><tr><td>|","") Sql = Left(Sql,Len(Sql)-9) Rs.Close:Set Rs = Nothing End If %> <p> </p> <p> </p> <FORM METHOD=POST ACTION="?action=saveedit"> <table cellpadding="1" cellspacing="0" border="0" align="center" style="border: outset 3px;width:95%;"> <tr> <th width="100%" height="19" colspan="2">请填写管理员修改资料</th> </tr> <tr> <td width="15%" height="24" class="ForumRowHighlight" align="right">现有管理员名单：</td> <td height="24" class="ForumRowHighlight"><table><tr><td>|<%=Sql%></table></td> </tr> <tr> <td height="24" class="ForumRow" align="right">前台登陆名:</td> <td height="24" class="ForumRow"><input TYPE="text" NAME="name1" size="20" value="admin"></td> </tr> <tr> <td height="24" class="ForumRowHighlight" align="right">新的前台登陆密码:</td> <td height="24" class="ForumRowHighlight"><input TYPE="password" name="pass1" size="20" value="admin888">(长度不能大于10小于6，默认密码为：admin888)</td> </tr> <tr> <td height="24" class="ForumRow" align="right">新的后台登名:</td> <td height="24" class="ForumRow"><input TYPE="text" NAME="name2" size="20" value="admin"></td> </tr> <tr> <td height="24" class="ForumRowHighlight" align="right">新的后台登陆密码:</td> <td height="24" class="ForumRowHighlight"><input TYPE="password" name="pass2" size="20" value="admin888">(长度不能大于10小于6，默认密码为：admin888)</td> </tr> <tr> <th height="19" align=right><input type="submit" value="提交" name="B1"> <input type="reset" value="全部重写" name="B2"></th> <th id=tabletitlelink><a href="<%=Dvbbs.ScriptName%>"><<返回上一层</a></th> </tr> </table> </FORM> <% End Sub
REM ============== REM 设置管理员密码 REM ============== Sub Saveedit() Dim Name1, Name2, Pass1, Pass2, LPass1, LPass2 Dim AdminID Name1 = CheckStr(trim(request.form("name1"))) Name2 = CheckStr(trim(request.form("name2"))) LPass1 = CheckStr(trim(request.form("pass1"))) LPass2 = CheckStr(trim(request.form("pass2"))) Response.Write "<font color=white><br><ul>" If Name1 = "" Then Response.Write "<li>请输入已存在的前台登陆用户名。" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Exit Sub End If If Name2 = "" Then response.write "<li>请输入后台登录用户名。" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Exit Sub End If If LPass1 = "" Or Len(LPass1) > 10 Or Len(LPass1) < 6 Then Response.write "<li>请输入新的前台登陆密码,(长度不能大于10小于6)。" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Exit Sub Else Pass1 = Md5(LPass1,16) End If If LPass2 = "" Or Len(LPass2) > 10 Or Len(LPass2) < 6 Then Response.write "<li>请输入新的后台登陆密码,(长度不能大于10小于6)。" Response.Write "<a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Exit Sub Else Pass2 = Md5(LPass2,16) End If '判断用户名是否已注册 Sql = "SELECT Userid, UserName FROM [Dv_User] WHERE UserName = '" & Name1 & "'" Set Rs = Dvbbs.Execute(Sql) If Rs.Eof And Rs.Bof Then '如果未注册则要求建立新管理员名。 Response.Write "<li>修改失败：" Response.Write "<li>您所填写的用户名不存在，请选择新建管理员帐号。" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Exit Sub Else AdminID = Rs(0) Rs.Close:Set Rs = Nothing REM ：判断用户是否已存在于管理员列表。 Sql = "SELECT * FROM [" & Admintable & "] WHERE Adduser = '"&Name1&"'" Set Rs = Conn.Execute(Sql) If Rs.Eof And Rs.Bof Then REM ：如果管理员名单没有填写的对应前台名则新建立。 Conn.Execute("INSERT INTO " & Admintable & " (Username, [Password], Flag, Adduser) VALUES ('" & Name2 & "', '" & Pass2 & "','" & Flag & "', '" & Name1 & "')") Else REM ：如果管理员名单存在填写的对应前台名则改写后台名与后台登录密码。 Conn.Execute("UPDATE " & Admintable & " SET Username = '" & Name2 & "', [Password] = '" & Pass2 & "', Flag = '" & Flag & "' WHERE Adduser = '" & Name1 & "'") End If Rs.Close:Set Rs = Nothing REM ：更新用户表的该用户的前台密码、等级。 Dvbbs.Execute("UPDATE Dv_User SET UserPassword = '" & Pass1 & "', Usergroupid = 1, Userclass = '" & Groupsname & "', Titlepic = '" & Titlepic & "' WHERE Userid = " & AdminID) End If Response.Write "<li>修改成功!" Response.Write "<li>请记好你的新密码：" Response.Write "<li>前台登录：用户名（" Response.Write Name1 Response.Write "） 密码（" Response.Write LPass1 Response.Write "）<li>后台登录：用户名（" Response.Write Name2 Response.Write "） 密码（" Response.Write LPass2 Response.Write "）<li><li><a href="&Request.ServerVariables("HTTP_REFERER")&"><font color=white><<返回上一页</font></a>" End Sub
REM ============ REM 建立新管理员 REM ============ Sub Newpsw() Dim Newname, Pass, Pass1, Adminmail, AdminIM Newname = Request("newname") If Newname = "" Or Isnull(Newname) Then Newname = "admin" Pass1 = "admin888" Adminmail = Newname & "@aspsky.net" AdminIM = "||||||||||||||||||" Pass = Md5(Pass1,16) '密码加密默认为16位，如果为32位请更改。 Response.Write "<font color=white><br><ul>" Sql = "SELECT * FROM Dv_User WHERE UserName = '" & Newname & "'" Set Rs = Server.Createobject("Adodb.Recordset") Rs.Open Sql,Conn,1,3 If Not (Rs.Eof AND Rs.Bof) Then REM 如果用户列表已存在该用户则要求运行修改密码程序。 Response.Write "<li>新建失败：" Response.Write "<li>用户名已存在请选择修改密码。" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Else '加入用户表 Rs.Addnew Rs("Username") = Newname Rs("Userpassword") = Pass Rs("Userclass") = Groupsname Rs("UserGroupID") = 1 Rs("Titlepic") = Titlepic Rs("UserWealth") = 100 Rs("Userep") = 30 Rs("Usercp") = 30 Rs("Userisbest") = 0 Rs("Userdel") = 0 Rs("Userpower") = 0 Rs("Lockuser") = 0 Rs("UserSex") = 1 Rs("UserEmail") = Adminmail Rs("UserFace") = "Images/userface/image1.gif" Rs("UserWidth") = 32 Rs("UserHeight") = 32 Rs("UserIM") = AdminIM Rs("UserFav") = "陌生人,我的好友,黑名单" Rs("LastLogin") = Now() Rs("JoinDate") = Now() Rs.Update '加入管理员表 Sql = "INSERT INTO [" & Admintable & "] (Username, [Password], Flag, Adduser) VALUES ('" & Newname & "','" & Pass & "','" & Flag & "','" & Newname & "')" Conn.Execute(Sql) Response.Write "<font color=white><br><ul><li>创建帐号完成：<li>用户名：" Response.Write Newname Response.Write "<li>密码：" Response.Write Pass1 Response.Write "</font>" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" End If Rs.Close:Set Rs = Nothing Response.Write "</Font>" End Sub
REM ============== REM 打开关闭的论坛 REM ============== Sub Openbbs() Dim iForum_Setting, Forum_Setting, Settingstr, Setting Response.Write "<font color=white><br><ul>" Set Rs = Dvbbs.Execute("SELECT Forum_Setting FROM [Dv_Setup]") iForum_Setting = Split(Rs(0),"|||") Rs.Close:Set Rs = Nothing Setting = Split(iForum_Setting(1),",") If Cint(Setting(21)) = 0 Then Response.Write "<li>开启失败：" Response.Write "<li>论坛并不处于关闭状态，无需打开。" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Response.Write "</Font>" Else Setting(21) = "0" For i = 0 To Ubound(Setting) IF Settingstr = "" Then Settingstr = Setting(i) Else Settingstr = Settingstr & "," & Setting(i) End if Next Forum_Setting = iforum_Setting(0) & "|||" & Settingstr & "|||" & iForum_Setting(2) & "|||" & iForum_Setting(3) & "|||" & iForum_Setting(4) & "|||" & iForum_Setting(5) Forum_Setting = Checkstr(Forum_Setting) Dvbbs.Execute("UPDATE [Dv_Setup] SET Forum_Setting = '" & Forum_Setting & "'") Dvbbs.Name = "setup" Dvbbs.ReloadSetup Response.Write "<li>论坛已经开启。" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Response.Write "</Font>" End If End Sub
REM ============================ REM 修正删除不活动用户时间值过大 REM ============================ Sub Fixonlinetime() Dim iForum_Setting, Forum_Setting, Settingstr, Setting Response.Write "<font color=white><br><ul>" Set Rs = Dvbbs.Execute("SELECT Forum_Setting FROM [Dv_Setup]") iForum_Setting = Split(Rs(0),"|||") Rs.Close:Set Rs = Nothing Setting = Split(iForum_Setting(1),",") If Not Isnumeric(Setting(8)) Then Setting(8) = "40" If Int(Setting(8)) < 32767 Then Response.Write "<li>删除不活动用户时间值正常，无需修复。" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Response.Write "</Font>" Else Setting(8) = "40" For i = 0 To Ubound(Setting) IF Settingstr = "" Then Settingstr = Setting(i) Else Settingstr = Settingstr & "," & Setting(i) End if Next Forum_Setting = iforum_Setting(0) & "|||" & Settingstr & "|||" & iForum_Setting(2) & "|||" & iForum_Setting(3) & "|||" & iForum_Setting(4) & "|||" & iForum_Setting(5) Forum_Setting = Checkstr(Forum_Setting) Dvbbs.Execute("UPDATE [Dv_Setup] SET Forum_Setting = '" & Forum_Setting & "'") Dvbbs.Name = "setup" Dvbbs.ReloadSetup Response.Write "<li>删除不活动用户时间值修复完毕。" Response.Write "<li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a>" Response.Write "</Font>" End If End Sub
REM ============== REM 统计分论坛个数 REM ============== Sub Boardchild() Dim cBoardNum, cBoardid Dim Trs Dim Bn Dvbbs.Execute("UPDATE Dv_Board SET Child = 0") Set Rs = Dvbbs.Execute("SELECT Boardid, Rootid, ParentID, Depth, Child, ParentStr FROM Dv_Board ORDER BY Boardid DESC") If Not (Rs.Eof And Rs.Bof) Then Sql = Rs.GetRows(-1) Rs.Close:Set Rs = Nothing For Bn = 0 To Ubound(Sql,2) If Isnull(Sql(4,Bn)) And Cint(Sql(3,Bn)) > 0 Then Dvbbs.Execute("UPDATE Dv_Board SET Child = 0 WHERE Boardid = " & Sql(0,Bn)) End If If Cint(Sql(2,Bn)) = 0 And Cint(Sql(3,Bn)) = 0 Then Set Trs = Dvbbs.Execute("SELECT COUNT(*) FROM Dv_Board WHERE RootID = " & Sql(1,Bn)) Cboardnum = Trs(0) - 1 Trs.Close:Set Trs = Nothing If Isnull(Cboardnum) Or Cboardnum < 0 Then Cboardnum = 0 Dvbbs.Execute("UPDATE Dv_Board SET Child = " & Cboardnum & " WHERE Boardid = " & Sql(0,Bn)) Elseif Cint(Sql(3,Bn)) > 1 Then cBoardid = Split(Sql(5,Bn),",") For i = 1 To Ubound(cBoardid) Dvbbs.Execute("UPDATE Dv_Board SET Child = Child + 1 WHERE Boardid = " & cBoardid(i)) Next End If Next End If Response.write "<font color=white><br><ul><li>论坛下属分版面个数统计更新完成。" Response.Write "<Li><a href="&Request.ServerVariables("HTTP_REFERER")&"><font color=white><<返回上一页</font></a></font>" End Sub
REM ======== REM 修复多项 REM ======== Sub Fixtop() Dim Tnum, Fnum, Snum, Unum Tnum = 0:Fnum = 0:Snum = 0:Unum = 0 Response.Write "<Font color=white><br><ul>" '修复已删除的主题固顶 Set Rs = Dvbbs.Execute("SELECT COUNT(Topicid) FROM [Dv_Topic] WHERE (istop > 0) AND (Boardid = 444 OR Boardid = 777 OR Boardid = 0)") Tnum = Rs(0) If Tnum > 0 Then Dvbbs.Execute("UPDATE Dv_Topic SET istop = 0 WHERE (istop > 0) AND (Boardid = 444 OR Boardid = 777 OR Boardid = 0)") '修复主题表无发帖表情 Set Rs = Dvbbs.Execute("SELECT COUNT(Topicid) FROM [Dv_Topic] WHERE Expression IS NULL OR Expression = ''") Fnum = Rs(0) If Fnum > 0 Then Dvbbs.Execute("UPDATE Dv_Topic SET Expression = 'face01.gif' WHERE Expression IS NULL OR Expression = ''") '修复分版无分版设置 Set Rs = Dvbbs.Execute("SELECT COUNT(Boardid) FROM [Dv_Board] WHERE Board_User IS NULL") Snum = Rs(0) If Snum > 0 Then Dvbbs.Execute("UPDATE Dv_Board SET Board_User = '100,5,2,7,1,1,1,0,5,0,50,3,1,5,1,10,5,3' WHERE Board_User IS NULL") '修复以往版本有BOARDID444的分版自定义权限错误 Set Rs = Dvbbs.Execute("SELECT COUNT(uc_UserID) FROM [Dv_UserAccess] WHERE Uc_Boardid = 444 OR Uc_Boardid = 777") Unum = Rs(0) If Unum > 0 Then Dvbbs.Execute("DELETE From Dv_UserAccess WHERE Uc_Boardid = 444 OR Uc_Boardid = 777") Rs.Close:Set Rs = Nothing '========== Response.Write "<li>[" & Tnum & "]个固顶帖与总固顶帖修复完成。" Response.Write "<li>[" & Fnum & "]个主题表情Expression修复完成。" Response.Write "<li>[" & Snum & "]个分版权限Board_user复完默认设置。" Response.Write "<li>[" & Unum & "]个以往分版号为444、777的自定义权限清理完成。" Response.Write "<Li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a></font>" End Sub
REM =============================== REM 修复鲜花与鸡蛋显示undefined错误 REM =============================== Sub Flower() Dim Anum Anum = 0 Response.Write "<Font color=white><br><ul>" '修复鲜花与鸡蛋 Conn.CommandTimeOut = 0 For i = 0 To Ubound(AllPostTable) Set Rs = Dvbbs.Execute("SELECT COUNT(AnnounceID) FROM [" & AllPostTable(i) & "] WHERE ParentID = 0 AND ((Not IsAgree LIKE '%|%') Or (IsAgree IS NULL))") If Rs(0) > 0 Then Anum = Anum + Rs(0) Dvbbs.Execute("UPDATE [" & AllPostTable(i) & "] SET IsAgree = '0|0' WHERE ParentID = 0 AND ((Not IsAgree LIKE '%|%') Or (IsAgree IS NULL))") End If Response.Write "<li>修复[" & AllPostTable(i) & "]表[" & Rs(0) & "]处错误。" Rs.Close Response.Flush Next Set Rs = Nothing '========== Response.Write "<li>共修复[" & Anum & "]处鲜花与鸡蛋undefined成功。" Response.Write "<Li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a></font>" End Sub
REM ====================== REM 删除本文件以防留下后门 REM ====================== Sub Delfile() Response.Write "<Font color=white><br><ul>" On Error Resume Next Dim ObjFSO Set ObjFSO = Server.CreateObject("Scripting.FileSystemObject") ObjFSO.DeleteFile(Server.MapPath(Dvbbs.ScriptName)) If Err.Number<>"0" Then Response.Write "<li>删除失败！" Response.Write "<li>系统提示：" & Err.Description Response.Write "<li>请手动在FTP中删除此文件！" Response.Write "<Li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a></font>" Else Response.Write "<li>删除管理员KEY程序成功！" Response.Write "<Li><a href=index.asp><font color=white><<返回论坛</font></a></font>" End If Set ObjFSO = Nothing End Sub
REM =============== REM 过滤SQL非法字符 REM =============== Function CheckStr(Str) If Isnull(Str) Then checkStr = "" Exit Function End If CheckStr = Replace(Str, "'", "''") End Function
REM ============== REM 更新服务器缓存 REM ============== Sub DelallCache() Response.Write "<Font color=white><br><ul>" Response.Write "<Iframe src=ReloadForumCache.asp frameborder=0 width=400 height=450></Iframe>" Response.Write "<li>更新服务器缓存成功！" Response.Write "<Li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a></font>" End Sub
REM ======================== REM 修复用户发帖主题数NULL值 REM ======================== Sub Fixusertopic() Dim Tnum, Jnum, Bnum Tnum = 0:Jnum = 0:Bnum = 0 Response.Write "<Font color=white><br><ul>" '修复主题数为NULL值的错误，避免后台统计用户分值时归零 Set Rs = Dvbbs.Execute("SELECT COUNT(UserID) FROM [Dv_User] WHERE (UserTopic IS NULL)") Tnum = Rs(0) If Tnum > 0 Then If IsSqlDataBase = 1 Then Dvbbs.Execute("UPDATE Dv_User SET UserTopic = (SELECT COUNT(*) FROM Dv_Topic WHERE Dv_Topic.PostUserID = Dv_User.UserId) WHERE UserTopic IS NULL") Else Sql = "SELECT Userid FROM Dv_User Where UserTopic IS NULL" Set Rs = Dvbbs.Execute(Sql) If Not Rs.Eof Then Sql = Rs.GetRows(-1) Rs.Close:Set Rs = Nothing For i = 0 To Ubound(Sql,2) Set Rs = Dvbbs.Execute("SELECT COUNT(*) FROM Dv_Topic WHERE PostUserID = " & Sql(0,i)) If Not Rs.Eof Then Dvbbs.Execute("UPDATE Dv_User SET UserTopic = " & Rs(0) & " WHERE UserID = " & Sql(0,i)) Rs.Close:Set Rs = Nothing End If Next End If End If End If '========== '修复注册日期NULL值 If IsSqlDataBase = 1 Then Set Rs = Dvbbs.Execute("SELECT COUNT(UserID) FROM [Dv_User] WHERE (Joindate IS NULL) Or Joindate = ''") Jnum = Rs(0) If Jnum > 0 Then Dvbbs.Execute("UPDATE Dv_User SET Joindate = " & SqlNowString & " WHERE (Joindate IS NULL) Or Joindate = ''") Else Set Rs = Dvbbs.Execute("SELECT COUNT(UserID) FROM [Dv_User] WHERE (Joindate IS NULL) Or NOT ISDATE(Joindate)") Jnum = Rs(0) If Jnum > 0 Then Dvbbs.Execute("UPDATE Dv_User SET Joindate = " & SqlNowString & " WHERE (Joindate IS NULL) Or NOT ISDATE(Joindate)") End If
'修复用户星座显示undefined Set Rs = Dvbbs.Execute("SELECT COUNT(UserID) FROM [Dv_User] WHERE UserBirthday = '//'") Bnum = Rs(0) If Bnum > 0 Then Dvbbs.Execute("UPDATE Dv_User SET UserBirthday = '' WHERE UserBirthday = '//'")
REM ================ REM 提取帖子列表数组 REM ================ Function AllPostTable1() Dim Trs Set Trs=Dvbbs.Execute("SELECT * FROM [Dv_TableList]") AllPostTable="" Do While Not TRs.EOF If AllPostTable="" Then AllPostTable=TRs("TableName") AllPostTableName=TRs("TableType") Else AllPostTable=AllPostTable&"|"&TRs("TableName") AllPostTableName=AllPostTableName&"|"&TRs("TableType") End If TRs.MoveNext Loop Trs.Close End Function
REM ========================== REM 论坛所在站点信息 2004-7-12 REM ========================== Sub Ltinfo() Dim theInstalledObjects(25) theInstalledObjects(0) = "MSWC.AdRotator" theInstalledObjects(1) = "MSWC.BrowserType" theInstalledObjects(2) = "MSWC.NextLink" theInstalledObjects(3) = "MSWC.Tools" theInstalledObjects(4) = "MSWC.Status" theInstalledObjects(5) = "MSWC.Counters" theInstalledObjects(6) = "IISSample.ContentRotator" theInstalledObjects(7) = "IISSample.PageCounter" theInstalledObjects(8) = "MSWC.PermissionChecker" theInstalledObjects(9) = "Scripting.FileSystemObject" theInstalledObjects(10) = "Adodb.Connection"
Response.Write "<table cellpadding=1 cellspacing=0 border=0 align=center style=""border: outset 3px;width:95%;"">"&_ "<tr>"&_ "<th height=19 colspan=4>站点信息</th>"&_ "</tr>"&_ "<tr>"&_ "<td width=50% height=23 class=forumrow colspan=2>服务器类型：" Response.Write Request.ServerVariables("OS") Response.Write "(IP:" Response.Write Request.ServerVariables("LOCAL_ADDR") Response.Write ")</td>"&_ "<td width=50% height=23 class=forumrow colspan=2>脚本解释引擎：" Response.Write ScriptEngine Response.Write "/" Response.Write ScriptEngineMajorVersion Response.Write "." Response.Write ScriptEngineMinorVersion Response.Write "." Response.Write ScriptEngineBuildVersion Response.Write "</td>"&_ "</tr>"&_ "<tr>"&_ "<td class=forumRowHighlight height=23 colspan=2>站点物理路径：" Response.Write Request.ServerVariables("APPL_PHYSICAL_PATH") Response.Write "</td>"&_ "<td class=forumRowHighlight height=23 colspan=2>数据库地址：" Response.Write Db Response.Write "</td>"&_ "</tr>"&_ "<tr>"&_ "<td class=forumRow height=23 width=25% >FSO 文本文件读写：</td>"&_ "<td class=forumRow height=23>" If Not IsObjInstalled(theInstalledObjects(9)) Then Response.Write "<font color=red><b>×</b></font>" Else Response.Write "<b>√</b>" End If Response.Write "</td>"&_ "<td class=forumRow width=25% >ASPemail 邮件发信：</td><td class=forumRow height=23>" If Not IsObjInstalled(theInstalledObjects(15)) Then Response.Write "<font color=red><b>×</b></font>" Else Response.Write "<b>√</b>" End If Response.Write "</td>"&_ "</tr>"&_ "<tr>"&_ "<td class=forumRowHighlight height=23>" If IsObjInstalled(theInstalledObjects(18)) Then Response.Write "Jmail4.3 邮件发信：" Else Response.Write "Jmail4.2 邮件发信：" End If Response.Write "</td><td class=forumRowHighlight height=23>" If IsObjInstalled(theInstalledObjects(18)) Or IsObjInstalled(theInstalledObjects(13)) Then Response.Write "<b>√</b>" Else Response.Write "<font color=red><b>×</b></font>" End If Response.Write "</td>"&_ "<td class=forumRowHighlight>CDONTS 虚拟SMTP发信：</td>"&_ "<td class=forumRowHighlight height=23>" If Not IsObjInstalled(theInstalledObjects(14)) Then Response.Write "<font color=red><b>×</b></font>" Else Response.Write "<b>√</b>" End If Response.Write "</td>"&_ "</tr>"&_ "<th height=19 colspan=4>动网上传组件探针</th>"&_ "<tr>"&_ "<td class=forumRow height=23>LyfUpload：</td>"&_ "<td class=forumRow height=23>" If Not IsObjInstalled(theInstalledObjects(16)) Then Response.Write "<font color=red><b>×</b></font>" Else Response.Write "<b>√</b>" End If Response.Write "</td>"&_ "<td class=forumRow>AspUpload：</td>"&_ "<td class=forumRow>" If Not IsObjInstalled(theInstalledObjects(19)) Then Response.Write "<font color=red><b>×</b></font>" Else Response.Write "<b>√</b>" End If Response.Write "</td>"&_ "</tr>"&_ "<tr>"&_ "<td class=forumRowHighlight height=23>SA-FileUp：</td>"&_ "<td class=forumRowHighlight height=23>" If IsObjInstalled(theInstalledObjects(20)) Then Response.Write "<b>√</b>" Else Response.Write "<font color=red><b>×</b></font>" End If Response.Write "</td>"&_ "<td class=forumRowHighlight>DvFile.Upload：</td>"&_ "<td class=forumRowHighlight>" If Not IsObjInstalled(theInstalledObjects(21)) Then Response.Write "<font color=red><b>×</b></font>" Else Response.Write "<b>√</b>" End If Response.Write "</td>"&_ "</tr>"&_ "<th height=19 colspan=4>动网图片组件探针</th>"&_ "<tr>"&_ "<td class=forumRow height=23>CreatePreviewImage：</td>"&_ "<td class=forumRow height=23>" If Not IsObjInstalled(theInstalledObjects(22)) Then Response.Write "<font color=red><b>×</b></font>" Else Response.Write "<b>√</b>" End If Response.Write "</td>"&_ "<td class=forumRow>AspJpeg：</td>"&_ "<td class=forumRow>" If Not IsObjInstalled(theInstalledObjects(23)) Then Response.Write "<font color=red><b>×</b></font>" Else Response.Write "<b>√</b>" End If Response.Write "</td>"&_ "</tr>"&_ "<tr>"&_ "<td class=forumRowHighlight height=23>SoftArtisans ImgWriter：</td>"&_ "<td class=forumRowHighlight height=23>" If IsObjInstalled(theInstalledObjects(24)) Then Response.Write "<b>√</b>" Else Response.Write "<font color=red><b>×</b></font>" End If Response.Write "</td>"&_ "<td class=forumRowHighlight>SJCatSoft：</td>"&_ "<td class=forumRowHighlight>" If Not IsObjInstalled(theInstalledObjects(25)) Then Response.Write "<font color=red><b>×</b></font>" Else Response.Write "<b>√</b>" End If Response.Write "</td>"&_ "</tr></table><br>" End Sub
REM ================ REM 是否支持组件函数 REM ================ Function IsObjInstalled(strClassString) On Error Resume Next IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function
REM ======= REM 是否Sp2 REM ======= Function IsSp2 On Error Resume Next IsSp2 = False Err = 0 Sql = "SELECT TOP 1 CID FROM Dv_Board" Set Rs = Dvbbs.Execute(Sql) Sql = "SELECT TOP 1 Forum_Cid, Forum_AvaSiteID, Forum_AvaSign FROM Dv_Setup" Set Rs = Dvbbs.Execute(Sql) 'Response.Write Err.Description If 0 = Err Then IsSp2 = True Set Rs = Nothing Err = 0 End Function %>
用户登录 
新用户注册 
网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！）
