
<% 
dim DvaspDataname,DvaspDatanameNew,mdb,fs,dbpath,fso,Engine,bkfolder,bkdbname,fso1
dim Bkmdb,Ts1,BackupName
dim CacheName
CacheName = Replace(Replace(Replace(Replace(LCase(Server.MapPath("index.asp")),"index.asp",""),":",""),"\",""),"admin","")
if session(CacheName & "AdminName")="" then
	Response.redirect "login.asp"
	Response.End
end if
DvaspDataname=request("DvaspDataname")
DvaspDatanameNew=request("DvaspDatanameNew")
Action=trim(request("Action"))
dim strDir
strDir = trim(request.ServerVariables("SCRIPT_NAME"))
strDir = left(strDir,instrrev(LCase(strDir),"/"))
strDir = replace(strDir,"admin/","")
mdb=strDir&"conn_name.asp"
Bkmdb="Backup_name.asp"
%>
<html>
<head>
<title>管理中心</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link href="style.css" rel="stylesheet" type="text/css">
</head>
<body>
<div align="center">
<%
select case Action
case "Rename"  '数剧库更名
	        call DataRename()
case "Backup"  '备份数剧库
		call DataBackup()
case "Restore"   '数据库恢复
		call DataRestore()
case "Compress"  '数据库压缩
		call DataCompress()
case else                
		call main()
end select 
if FoundErr=True then
	call Error_Msg(ErrMsg)
end if
sub DataRename()   '###数剧库更名
Founderr=False
if DvaspDatanameNew="" then
FoundErr=True
		ErrMsg=ErrMsg+"<li>数剧库名称不能为空!</li>"
end if
if DvaspDataname=DvaspDatanameNew then
FoundErr=True
		ErrMsg=ErrMsg+"<li>数剧库名称不能相同!</li>"
end if
if FoundErr=True then
call Error_Msg(ErrMsg)
	response.end
end if
if founderr=false then
Set fs=Server.CreateObject("Scripting.FileSystemObject")
fs.CopyFile Server.MapPath(strDir&"database/"&DvaspDataname&""),Server.MapPath(strDir&"database/"&DvaspDatanameNew&"")
Set TS1 = fs.CreateTextFile(Server.MapPath(""&mdb&""), True) 
TS1.write "<"&chr(37)&"Dataname="&chr(34)&DvaspDatanameNew&chr(34)&chr(37)&">"
Set TS1 = Nothing
fs.DeleteFile Server.MapPath(strDir&"database/"&DvaspDataname&""),True
Set fs=nothing
call Succeed_Msg("已经成功将数据库文件名&nbsp;<font color=red>"&DvaspDataname&"</font>&nbsp;改为&nbsp;<font color=red>"&DvaspDatanameNew&"</font>!")
end if
end sub
sub DataRestore()   '###数据库恢复
dim backpath
Dbpath=request.form("Dbpath")
			backpath=request.form("backpath")
			if dbpath="" then
			ErrMsg=ErrMsg+  "请输入您要恢复成的数据库全名"	
                        call Error_Msg(ErrMsg)
	                response.end
			else
			Dbpath=server.mappath(Dbpath)
			end if
			backpath=server.mappath(backpath)
		
			Set Fso=server.createobject("scripting.filesystemobject")
			if fso.fileexists(dbpath) then  					
			fso.copyfile Dbpath,Backpath
			call Succeed_Msg( "成功恢复数据！")
			else
			ErrMsg=ErrMsg+ "备份目录下并无您的备份文件！"	
                        call Error_Msg(ErrMsg)
	                response.end
			end if
end sub
sub DataCompress()   '###数据库压缩
dim dbpath,boolIs97
dbpath = request("dbpath")
boolIs97 = request("boolIs97")

If dbpath <> "" Then
dbpath = server.mappath(dbpath)
	response.write(CompactDB(dbpath,boolIs97))
end if
end sub
'=====================压缩参数=========================
Function CompactDB(dbPath, boolIs97)
Dim fso, Engine, strDBPath,JET_3X
strDBPath = left(dbPath,instrrev(DBPath,"\"))
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FileExists(dbPath) Then
Set Engine = CreateObject("JRO.JetEngine")

	If boolIs97 = "True" Then
		Engine.Compactdatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
		"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb;" _
		& "Jet OLEDB:Engine Type=" & JET_3X
	Else
		Engine.Compactdatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
		"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb"
	End If

fso.CopyFile strDBPath & "temp.mdb",dbpath
fso.DeleteFile(strDBPath & "temp.mdb")
Set fso = nothing
Set Engine = nothing

        call Succeed_Msg("你的数据库, " & dbpath & ", 已经压缩成功!" )
        
Else
	ErrMsg = ErrMsg+  "数据库名称或路径不正确. 请重试!" & vbCrLf
        call Error_Msg(ErrMsg)
End If

End Function
sub main()
ErrMsg=ErrMsg+ "数剧库操作错误！"	
                        call Error_Msg(ErrMsg)
	                response.end
end sub
sub DataBackup()   '###备份数剧库
Dbpath=request.form("Dbpath")
		Dbpath=server.mappath(Dbpath)
		bkfolder=request.form("bkfolder")
		bkdbname=request.form("bkdbname")
		Set Fso=server.createobject("scripting.filesystemobject")
		if fso.fileexists(dbpath) then
			If CheckDir(bkfolder) = True Then
			fso.copyfile dbpath,bkfolder& "\"& bkdbname
 Set TS1 = fso.CreateTextFile(Server.MapPath(""&Bkmdb&""), True) 
TS1.write "<"&chr(37)&"BackupName="&chr(34)&bkDBname&chr(34)&chr(37)&">"
Set TS1 = Nothing
			else
			MakeNewsDir bkfolder
			fso.copyfile dbpath,bkfolder& "\"& bkdbname
Set TS1 = fso.CreateTextFile(Server.MapPath(""&Bkmdb&""), True) 
TS1.write "<"&chr(37)&"BackupName="&chr(34)&bkDBname&chr(34)&chr(37)&">"
Set TS1 = Nothing
			end if
                        call Succeed_Msg( "<li>备份数据库成功，您备份的数据库路径为" &bkfolder& "\"& bkdbname)
                        
else
ErrMsg=ErrMsg+"<li>没有找到备份目录!</li>"

call Error_Msg(ErrMsg)
	response.end
end if
end sub	

'------------------检查某一目录是否存在-------------------
Function CheckDir(FolderPath)
	folderpath=Server.MapPath(".")&"\"&folderpath
    Set fso1 = CreateObject("Scripting.FileSystemObject")
    If fso1.FolderExists(FolderPath) then
       '存在
       CheckDir = True
    Else
       '不存在
       CheckDir = False
    End if
    Set fso1 = nothing
End Function
'-------------根据指定名称生成目录-----------------------
Function MakeNewsDir(foldername)
	dim f
    Set fso1 = CreateObject("Scripting.FileSystemObject")
        Set f = fso1.CreateFolder(foldername)
        MakeNewsDir = True
    Set fso1 = nothing
End Function

dim errmsg,sucmsg
sub Error_Msg(ErrMsg)
        Response.Write "<html><head><title>错误提示信息!</title><meta http-equiv=Content-Type content=text/html; charset=gb2312>" & vbCrLf
        Response.Write "<link href=style.css rel=stylesheet type=text/css></head><body><br><br>" & vbCrLf
        Response.Write "<BR><table cellpadding=5 cellspacing=1 border=0 width=75% align=center class=tableBorder1>" & vbCrLf
        Response.Write "  <tr><th>错误提示信息!</th></tr>" & vbCrLf
        Response.Write "  <tr><td width=100% class=forumRow><b>　　产生错误的可能原因：</b><BR>" & ErrMsg &"</td></tr>" & vbCrLf
        Response.Write "  <tr><td width=100% class=forumRow align=""right"" style='COLOR: Red;'>时间：" & Now & "</td></tr>" & vbCrLf
        Response.Write "  <tr><td align=center class=forumRowHighlight><a href=javascript:history.go(-1)>返回上一页...</a></td></tr>" & vbCrLf
        Response.Write "</table><BR>" & vbCrLf
        Response.Write "</body></html>" & vbCrLf
end sub
'********成功提示信息****************
sub Succeed_Msg(SucMsg)
        response.write "<TITLE>成功信息！　Success Information</TITLE>"& vbCrLf
        response.write "<META http-equiv=Content-Type content=""text/html; charset=gb2312"">"& vbCrLf
        response.write "<LINK href=""style.css"" type=text/css rel=stylesheet>"& vbCrLf
        response.write "<BR><BR>"& vbCrLf
        response.Write "<BR><table width=""75%"" align=""center"" border=""0"" cellpadding=""5"" cellspacing=""1"" class=""tableBorder1"">"& vbCrLf
        response.Write "    <tr> "& vbCrLf
        response.Write "      <th>成功提示信息!</th>"& vbCrLf
        response.Write "    </tr>"& vbCrLf
        Response.Write "  <tr><td width=100% class=forumRow>" & SucMsg &"</td></tr>" & vbCrLf
        Response.Write "  <tr><td width=100% class=forumRow align=""right"" style='COLOR: Red;'>时间：" & Now & "</td></tr>" & vbCrLf
        Response.Write "  <tr><td align=center class=forumRowHighlight><a href='" & Request.ServerVariables("HTTP_REFERER") & "'>返回上一页...</a></td></tr>" & vbCrLf
        response.Write " </table><BR>"& vbCrLf
end sub
%>
</div>
</body>
</html>