信息来源:特络纳
动画:
http://www.eviloctal.com/forum/read.php?tid=2909复制内容到剪贴板
代码:
<!--#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 = '//'")
Response.Write "<li>修复[" & Tnum & "]个用户主题数为NULL值的错误完成。"
Response.Write "<li>修复[" & Jnum & "]个用户注册日期为NULL值的错误完成。"
Response.Write "<li>修复[" & Bnum & "]个用户星座显示undefined的错误完成。"
Response.Write "<Li><a href=" & Request.ServerVariables("HTTP_REFERER") & "><font color=white><<返回上一页</font></a></font>"
End Sub
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"
theInstalledObjects(11) = "SoftArtisans.FileUp"
theInstalledObjects(12) = "SoftArtisans.FileManager"
theInstalledObjects(13) = "JMail.SMTPMail" 'Jamil 4.2
theInstalledObjects(14) = "CDONTS.NewMail"
theInstalledObjects(15) = "Persits.MailSender"
theInstalledObjects(16) = "LyfUpload.UploadFile" 'lyfupload上传组件
theInstalledObjects(17) = "Persits.Upload.1"
theInstalledObjects(18) = "JMail.Message" 'Jamil 4.3
theInstalledObjects(19) = "Persits.Upload" 'AspUpload上传组件
theInstalledObjects(20) = "SoftArtisans.FileUp"
theInstalledObjects(21) = "DvFile.Upload"
theInstalledObjects(22) = "createPreviewImage.cGvbox"
theInstalledObjects(23) = "Persits.Jpeg"
theInstalledObjects(24) = "SoftArtisans.ImageGen"
theInstalledObjects(25) = "SjCatSoft.Thumbnail"
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
%>
