admin_confirm.asp

BBS源码 利用ASP的一个功能齐全的BBS论坛源码

		Else
			Grade=18
		End if
		Set Rs1=Nothing
			BBS94KK.execute("update [KK_User] set EssayNum="&EssayNum&",GoodNum="&GoodNum&",Grade="&Grade&" where Name='"&Rs(0)&"'")
		Rs.Movenext
		Loop
		rs.close
		Temp=ID1
		ID1=int(ID2)+1
		ID2=int(ID2)+int(ID2)-int(Temp)+1
		Go=" 继续整理 "
	End IF
	Caption="用户整理修复"
	Content="<form method=POST action='?Action=UpdateAllUser' onSubmit='ok.disabled=true;ok.value=""正在整理-请稍等。。。""'>请填写你要整理用户的开始ID和结束ID：（两者之间不要相差太大）<br>论坛注册用户最大的 ID 为："&MaxID&"<br>初始ID：<input type=text name='id1' size=20 value="&ID1&"><BR>结束ID：<input type=text name='id2' size=20 value="&ID2&"><BR><input name='ok'  type=submit value="&Go&" ><input type=reset value=' 重 置 '> </p></form>"
	Call ShowTable(caption,Content)
End Sub

Sub DelWuiong
	Dim ii,i,AllTable,content
	Content="<div align='center'><b><span id=BBS94KKT name=BBS94KKT>正在清理无效主题！请稍等。。。</span></b><table width='400' border='0' align='center' cellpadding='1' cellspacing='1'><tr><td bgcolor=#d7d7d7><table width='400' border='0' cellspacing='0' cellpadding='1'><tr><td bgcolor=ffffff height=9><img src='Images/hr1.gif' width=0 height=16 id=BBS94KKimg name=BBS94KKimg align=absmiddle></td></tr></table></td></tr></table><span id=BBS94KKtxt name=BBS94KKtxt style='font-size:9pt'>0</span><span style='font-size:9pt'>%</span></div>"
	Call ShowTable("论坛垃圾清理",Content)
	Response.Flush
	AllTable=Split(BBS94KK.BBSTable(0),",")
	For i=0 To uBound(AllTable)
		BBS94KK.execute("delete * from [KK_bbs"&AllTable(i)&"] where TopicID<>0 and not exists (select name from [KK_topic] where [KK_bbs"&AllTable(i)&"].TopicId=[KK_Topic].TopicID)")
		BBS94KK.execute("delete * from [KK_Topic] where SqlTableID="&AllTable(i)&" and not exists (select name from [KK_bbs"&AllTable(i)&"] where [KK_Topic].TopicID=[KK_bbs"&AllTable(i)&"].TopicId)")
	Next
	Call Table("无效主题清理完毕！","")

	Call PicPro(1,6,"正在清理无效回复帖子！请稍等。。。;")
	For i=0 To uBound(AllTable)
		Set Rs=BBS94KK.Execute("select ReplyTopicID from [KK_bbs"&AllTable(i)&"] where ReplyTopicID<>0")
		Do While Not Rs.eof
			If BBS94KK.execute("select TopicID from [KK_bbs"&AllTable(i)&"] where TopicID="&Rs(0)&"").eof Then
			BBS94KK.Execute("Delete From[KK_bbs"&AllTable(i)&"] where ReplyTopicID="&Rs(0))
			End IF
		Rs.MoveNext
		Loop
		Rs.Close
	Next
	Call Table("无效回复清理完毕！","")
	
	Call PicPro(2,6,"正在清理无效版主！请稍等。。。")
		BBS94KK.execute("delete * from [KK_admin] where (boardID<>0 and boardID<>-1) and (boardID not in(select BoardID from [KK_Board] where parentID<>0) or name not in(select name From [KK_user] where isdel=False))")
	Call Table("无效版主清理完毕！","")
	
	Call PicPro(3,6,"正在清理无效投票！请稍等。。。")
		BBS94KK.execute("delete * from [KK_TopicVote] where  not exists (select name from [KK_Topic] where [KK_TopicVote].TopicID=[KK_Topic].TopicId)")
		BBS94KK.execute("delete * from [KK_TopicVoteUser] where  not exists (select name from [KK_Topic] where [KK_TopicVoteUser].TopicID=[KK_Topic].TopicId)")
	Call Table("无效投票清理完毕！","")
	
	Call PicPro(4,6,"正在清理无效留言！请稍等。。。")
		BBS94KK.execute("delete * from [KK_Sms] where not exists (select name from [KK_User] where [KK_Sms].MyName=[KK_User].Name)")
	Call Table("无效留言清理完毕！","")
	
	Call PicPro(5,6,"正在清理无效公告！请稍等。。。;")
		BBS94KK.execute("delete * from [KK_Placard] where not exists (select name from [KK_User] where [KK_Placard].Name=[KK_User].Name)")
		If Not IsArray(BBS94KK.Board_Rs) Then BBS94KK.CacheBoard()
		If IsArray(BBS94KK.Board_Rs) Then
			For i=0 To Ubound(BBS94KK.Board_Rs,2)
			'如果是版块为类
			If BBS94kk.Board_Rs(0,i)=0 Then
				BBS94KK.execute("delete * from [KK_Placard] where BoardID<0 or BoardID="&BBS94kk.Board_Rs(1,i))
			End If
			Next
		End If
	Call Table("无效公告清理完毕！","")
	
	Call PicPro(5,6,"正在清理删除用户的帖子！请稍等。。。")
		For i=0 To uBound(AllTable)
		BBS94KK.execute("delete * from [KK_bbs"&AllTable(i)&"] where not exists (select name from [KK_User] where [KK_bbs"&AllTable(i)&"].Name=[KK_User].Name)")
		Next
		BBS94KK.execute("delete * from [KK_Topic] where not exists (select name from [KK_User] where [KK_Topic].Name=[KK_User].Name)")
	Call Table("无效用户的帖子清理完毕！","")
	
	Call PicPro(6,6,"正在清理无效的评帖记录")
		BBS94KK.execute("delete * from [KK_Appraise] where  not exists (select name from [KK_Topic] where [KK_Appraise].TopicID=[KK_Topic].TopicId)")
	Call Table("无效评帖记录清理完毕！","")
	Response.Write "<script>BBS94KKimg.width=400;BBS94KKtxt.innerHTML=""100"";BBS94KKT.innerHTML=""<font color=red>成功完成整理！</font>"";</script>"
End Sub

Sub CompressData()
	Dim DbPath,boolIs97,Caption,Content
	Caption="压缩数据库"
	Content="<b>注意：</b>输入数据库所在相对路径，并且输入数据库名称（如果正在使用中数据库不能压缩，请选择备份数据库进行压缩操作）<hr size=1>"&_
	"<form style='margin:0' method='post'>压缩数据库：<input type='text' name='DbPath' value='Data\94kk.asp'>&nbsp;<input type='submit' value='开始压缩'><br><form>"&_
	"<input type='checkbox' name='boolIs97' value='True'>如果使用 Access 97 数据库请选择(默认为 Access 2000 数据库)"
	Call ShowTable(Caption,Content)
	Response.flush
	DbPath = request("DbPath")
	boolIs97 = request("boolIs97")
	If DbPath <> "" Then
	If Session(BBS94KK.CacheName&"fso")="no" Then
		Call GoBack("","空间不支持FSO文件读写。无法进入下一步。")
		Exit Sub
	End If
	DbPath = server.mappath(DbPath)
	Content=CompactDB(DbPath,boolIs97)
	Call ShowTable(Caption,Content)
	End If
End sub

Function CompactDB(DbPath, boolIs97)
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) 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
	CompactDB = "<li>你的数据库 " & DbPath & "，已经压缩成功！" 
Else
	CompactDB = "<li>数据库名称或路径不正确！ 请重试！" 
End If
End Function

Sub BackupDate()
Dim Caption,Content
Caption="备份论坛数据"
Content="<b>注意事项：</b><br>论坛数据库备份几乎是站长每天必做的事！<br>为保证您的数据安全，备份时请不要用默认名称来命名备份数据库。<br>发现数据丢失的时候，就可以用你最后备份的数据库恢复。<br>注意：所有路径都是相对与程序空间根目录的相对路径<hr size=1>"&_
"<form style='margin:0' method='post' action='?Action=BackupDate&Go=Start'>当前数据库路径(相对路径)：<input type=text size=15 name=DbPath value='Data/94kk.asp'><br>"&_
"备份数据库目录(相对路径)：<input type=text size='15' name='BkFolder' value='Data_Backup'>&nbsp;如目录不存在，程序将自动创建<BR>"&_
"备份数据库名称(填写名称)：<input type=text size=15 name=BkDbName value='Bak_94kk.ASP'>&nbsp;如备份目录有该文件，将覆盖，如没有，将自动创建<BR>"&_
"<input type=submit value=' 开始备份 '></form>"
Call ShowTable(Caption,Content)
If request("Go")="Start" then
	If Session(BBS94KK.CacheName&"fso")="no" Then
		Call GoBack("","空间不支持FSO文件读写。无法进入下一步。")
		Exit Sub
	End If
 Dim fso,DbPath,BkFolder,BkDbName
		DbPath=BBS94KK.Fun.GetStr("DbPath")
		DbPath=server.mappath(DbPath)
		BkFolder=BBS94KK.Fun.GetStr("BkFolder")
		BkDbName=BBS94KK.Fun.GetStr("BkDbName")
		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
		Else
			Caption="错误信息":Content="找不到您所需要备份的文件。"
		End if
	Call 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="<b>注意事项：</b>恢复数据库 一般是用来恢复(数据丢失或被破坏)的当前使用数据库。<br>是用备份的数据库直接把当前使用的数据库直接覆盖，请注意！<br>下面的路径都是相对与程序空间根目录的相对路径。<hr size=1>"&_
"<form method='post' style='margin:0' action='?Action=RestoreData&Go=Start'>备份数据库(相对路径)：<input type='text' size='30' name='BackPath' value='Data_Backup\Bak_94kk.ASP'> 请填写用来恢复的备份文件<BR>"&_
"当前数据库(相对路径)：<input type='text' size='30' name='DbPath' value='Data/94KK.Asp'> 填写您当前使用的数据库<BR><input onclick=checkclick('您确定要用备份的数据库覆盖当然使用的数据库吗！？') type=submit value=' 恢复数据 '></form> "
Call ShowTable(Caption,Content)
If request("Go")="Start" then
	If Session(BBS94KK.CacheName&"fso")="no" Then
		Call GoBack("","空间不支持FSO文件读写。无法进入下一步。")
		Exit Sub
	End If
 Caption="错误信息"
 Dim FSO,Dbpath,BackPath
 	DbPath=BBS94KK.Fun.GetStr("DbPath")
	BackPath=BBS94KK.Fun.GetStr("BackPath")
	if BackPath="" or DbPath="" then
		Content="请把全名填写完整！"	
	'ElseIF Lcase(Dbpath)<>Lcase(Db) Then
		'Content="您输入的不是当前使用数据库全名!"	
	Else
		DbPath=server.mappath(DbPath)
		BackPath=server.mappath(BackPath)
		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="成功的恢复数据库！"
			Else
			Caption="错误信息":Content="不是当前使用的数据库全名"
			Err.clear
			End If
		else
		Content= "备份目录下并无您的备份文件！"	
	end if
 End IF
Call ShowTable(Caption,Content)
End If
End sub

Sub ExecuteSql
	Dim Sql,Caption,Content
	Sql=Request.Form("sql")
	Caption="执行SQL语句"
	Content="<form onSubmit=checkclick('注意！操作不当有可能破坏数据库！\n\n您确定要执行SQL语句吗？') method=post style='margin:0'>指令：<input type=text name='sql' value='"&Sql&"' style='width:90%'><br>注意：此操作不可恢复，如果对SQL语法不了解，请慎用！<input type=submit value=' 确定执行 '></Form>"
	Call ShowTable(Caption,Content)
	If Sql<>"" then
	Response.Write("<br>")
	On Error Resume Next 
	BBS94KK.Execute(Sql)
	If err.number=0 then
		Caption="执行成功":Content="<li>Sql语句正确，已经成功的执行了下面这条语句！<li><font color=red>"&Sql&"</font>"
	Else
		Caption="错误信息":Content="<li>不能执行，语句有问题，具体出错如下：<li>"&Err.Description&"<br>"
		Err.clear
	End if
	Call ShowTable(Caption,Content)
	End if
End Sub

Sub DelEssay
	Dim UserName,DateNum,BoardID,AllTable,I
	DateNum=BBS94KK.Fun.GetStr("DateNum")
	BoardID=BBS94KK.Fun.GetStr("BoardID")
	UserName=BBS94KK.Fun.GetStr("Name")
	AllTable=Split(BBS94KK.BBSTable(0),",")
	Select Case Request("Go")
	Case"Date"
		If not isnumeric(DateNum) Then Call GoBack("","天数必需用数字填写！"):Exit Sub
		If BoardID=0 Then
			For i=0 To uBound(AllTable)
			BBS94KK.Execute("Delete From[KK_Bbs"&AllTable(i)&"] where TopicID in (Select TopicID From [KK_Topic] where DATEDIFF('d',[AddTime],'"&BBS94KK.NowBbsTime&"')>"&DateNum&") or ReplyTopicID in (Select TopicID From [KK_Topic] where DATEDIFF('d',[AddTime],'"&BBS94KK.NowBbsTime&"')>"&DateNum&")")
			Next
			BBS94KK.Execute("Delete From[KK_Appraise] where TopicID in (Select TopicID From [KK_Topic] where DATEDIFF('d',[AddTime],'"&BBS94KK.NowBbsTime&"')>"&DateNum&")")
			BBS94KK.Execute("Delete From[KK_Topic] where  DATEDIFF('d',[AddTime],'"&BBS94KK.NowBbsTime&"')>"&DateNum&"")
			Call Suc("","已经成功删除所有论坛在"&DateNum&"天前发表的主题帖（包括其回复帖）！<li>删除后建议对论坛做一次<a href=Admin_Action.asp?Action=UpdateBbs>整理</a>","Admin_Action.asp?Action=DelEssay")
		Else
			For i=0 To uBound(AllTable)
			BBS94KK.Execute("Delete From[KK_Bbs"&AllTable(i)&"] where BoardID="&BoardID&" And (TopicID in (Select TopicID From [KK_Topic] where DATEDIFF('d',[AddTime],'"&BBS94KK.NowBbsTime&"')>"&DateNum&") or ReplyTopicID in (Select TopicID From [KK_Topic] where DATEDIFF('d',[AddTime],'"&BBS94KK.NowBbsTime&"')>"&DateNum&"))")
			Next
			BBS94KK.Execute("Delete From[KK_Appraise] where TopicID in (Select TopicID From [KK_Topic] where DATEDIFF('d',[AddTime],'"&BBS94KK.NowBbsTime&"')>"&DateNum&" And BoardID="&BoardID&")")
			BBS94KK.Execute("Delete From[KK_Topic] where BoardID="&BoardID&" And DATEDIFF('d',[AddTime],'"&BBS94KK.NowBbsTime&"')>"&DateNum&"")
			Call Suc("","已经成功删除在 "&BBS94KK.Execute("Select BoardName From[KK_Board]where BoardID="&BoardID&"")(0)&" 上 "&DateNum&" 天前发表的主题帖（包括其回复帖）！<li>删除后建议对论坛做一次<a href=Admin_Action.asp?Action=UpdateBbs>整理</a>","Admin_Action.asp?Action=DelEssay")
		End IF
	Case"DateNoRe"
		If not isnumeric(DateNum) Then Call GoBack("","天数必需用数字填写！"):Exit Sub
		If BoardID=0 Then
			For i=0 To uBound(AllTable)
			BBS94KK.Execute("Delete From[KK_Bbs"&AllTable(i)&"] where TopicID in (Select TopicID From [KK_Topic] where DATEDIFF('d',LastTime,'"&BBS94KK.NowBbsTime&"')>"&DateNum&") or ReplyTopicID in (Select TopicID From [KK_Topic] where DATEDIFF('d',LastTime,'"&BBS94KK.NowBbsTime&"')>"&DateNum&")")
			Next