admin_database.asp

本源代码为终点小说连载系统 v1.15 Build 0430 SQL清风修改版,欢迎大家下载,学习与交流

	End If
	If InStr(backpath, ":") = 0 Then
		backpath = Server.MapPath(backpath)
	Else
		backpath = backpath
	End If
	Set Fso = server.CreateObject("scripting.filesystemobject")
	If fso.FileExists(dbpath) Then
		fso.CopyFile Dbpath, Backpath
		Succeed("成功恢复数据！")
	Else
		FoundErr = True
		ErrMsg = "备份目录下并无您的备份文件！"
		Exit Sub
	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
'====================压缩数据库 =========================
Sub CompressData()

	If IsSqlDataBase = 1 Then
		SQLUserReadme()
		Exit Sub
	End If
%>
<table border="0"  cellspacing="1" cellpadding="5" height="1" align=center width="95%" class="tableBorder1">
<tr>
<th height=25 >
&nbsp;&nbsp;压缩数据库 ( 需要FSO支持，FSO相关帮助请看微软网站 )
</th>
<form action="?action=CompressData&act=Compress" method="post">
<tr>
<td class="TableRow1" height=25><b>注意：</b><br>输入数据库所在相对路径,并且输入数据库名称（正在使用中数据库不能压缩，请选择备份数据库进行压缩操作） </td>
</tr>
<tr>
<td class="TableRow1">压缩数据库：<input type="text" name="dbpath" size=45 value=<%=db%>>&nbsp;
<input type="submit" value="开始压缩" class=Button></td>
</tr>
<tr>
<td class="TableRow1"><input type="checkbox" name="boolIs97" value="True">如果使用 Access 97 数据库请选择
(默认为 Access 2000 数据库)<br><br></td>
</tr>
<form>
</table>
<%
End Sub

Sub CompressDatabase()
	Dim dbpath, boolIs97
	dbpath = request("dbpath")
	boolIs97 = request("boolIs97")

	If dbpath <> "" Then
		If InStr(Dbpath, ":") = 0 Then
			Dbpath = Server.MapPath(Dbpath)
		Else
			Dbpath = Dbpath
		End If
		Response.Write(CompactDB(dbpath, boolIs97))
	Else
		FoundErr = True
		ErrMsg = "请输入要压缩的数据库路径！"
		Exit Sub
	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
		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
		Succeed("你的数据库, " & dbpath & ", 已经压缩成功!")
	Else
		ReturnError("数据库名称或路径不正确. 请重试!")
	End If

End Function
'=====================系统空间参数=========================
Sub ShowSpaceInfo(drvpath)
	Dim fso, d, Size, showsize
	Set fso = server.CreateObject("scripting.filesystemobject")
	drvpath = server.mappath(drvpath)
	Set d = fso.GetFolder(drvpath)
	Size = d.Size
	showsize = Size & "&nbsp;Byte"
	If Size>1024 Then
		Size = (Size / 1024)
		showsize = FormatNumber(Size, 2) & "&nbsp;KB"
	End If
	If Size>1024 Then
		Size = (Size / 1024)
		showsize = FormatNumber(Size, 2) & "&nbsp;MB"
	End If
	If Size>1024 Then
		Size = (Size / 1024)
		showsize = FormatNumber(Size, 2) & "&nbsp;GB"
	End If
	response.Write "<font face=verdana>" & showsize & "</font>"
End Sub

Sub Showspecialspaceinfo(method)
	Dim fso, d, fc, f1, Size, showsize, drvpath
	Set fso = server.CreateObject("scripting.filesystemobject")
	drvpath = server.mappath("../../../")
	drvpath = Left(drvpath, (instrrev(drvpath, "\") -1))
	Set d = fso.GetFolder(drvpath)

	If method = "All" Then
		Size = d.Size
	ElseIf method = "Program" Then
		Set fc = d.Files
		For Each f1 in fc
			Size = Size + f1.Size
		Next
	End If

	showsize = Size & "&nbsp;Byte"
	If Size>1024 Then
		Size = (Size / 1024)
		showsize = FormatNumber(Size, 2) & "&nbsp;KB"
	End If
	If Size>1024 Then
		Size = (Size / 1024)
		showsize = FormatNumber(Size, 2) & "&nbsp;MB"
	End If
	If Size>1024 Then
		Size = (Size / 1024)
		showsize = FormatNumber(Size, 2) & "&nbsp;GB"
	End If
	response.Write "<font face=verdana>" & showsize & "</font>"
End Sub

Function Drawbar(drvpath)
	Dim fso, drvpathroot, d, Size, TotalSize, barsize
	Set fso = server.CreateObject("scripting.filesystemobject")
	drvpathroot = server.mappath("../pic")
	drvpathroot = Left(drvpathroot, (instrrev(drvpathroot, "\") -1))
	Set d = fso.GetFolder(drvpathroot)
	TotalSize = d.Size

	drvpath = server.mappath(drvpath)
	Set d = fso.GetFolder(drvpath)
	Size = d.Size

	barsize = CDbl((Size / TotalSize) * 400)
	Drawbar = barsize
End Function

Function Drawspecialbar()
	Dim fso, drvpathroot, d, fc, f1, Size, TotalSize, barsize
	Set fso = server.CreateObject("scripting.filesystemobject")
	drvpathroot = server.mappath("../pic")
	drvpathroot = Left(drvpathroot, (instrrev(drvpathroot, "\") -1))
	Set d = fso.GetFolder(drvpathroot)
	TotalSize = d.Size

	Set fc = d.Files
	For Each f1 in fc
		Size = Size + f1.Size
	Next

	barsize = CDbl((Size / TotalSize) * 400)
	Drawspecialbar = barsize
End Function

Sub CheckSql()
	If Trim(Request.Form("SqlDataName")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg & "<li>请输入SQL数据库名！</li>"
	End If
	If Trim(Request.Form("SqlUserPass")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg & "<li>请输入SQL数据库用户密码！</li>"
	End If
	If Trim(Request.Form("SqlUserID")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg & "<li>请输入SQL数据库用户名称！</li>"
	End If
	If Trim(Request.Form("SqlServer")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg & "<li>请输入SQL数据库连接名（本地用local，外地用IP）！</li>"
	End If
	If Trim(Request.Form("BackupSqlName")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg & "<li>请输入SQL数据库备份名称！</li>"
	End If
	If Trim(Request.Form("BackupSqlDir")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg & "<li>请输入SQL数据库备份目录！</li>"
	End If
End Sub
'====================备份SQL数据库=========================
Sub BackupSqlDatabase()
	On Error Resume Next
	Dim SqlDataName, SqlUserPass, SqlUserID, SqlServer, SqlLoginTimeout
	Dim srv, bak, BackupFilePath, BackupSqlDir, BackupSqlName,BackupFileName
	SqlDataName = Trim(Request.Form("SqlDataName"))
	SqlUserPass = Trim(Request.Form("SqlUserPass"))
	SqlUserID = Trim(Request.Form("SqlUserID"))
	SqlServer = Trim(Request.Form("SqlServer"))
	BackupSqlDir = Trim(Request.Form("BackupSqlDir"))
	BackupSqlName = Trim(Request.Form("BackupSqlName"))
	SqlLoginTimeout = 20 '登陆超时
	CheckSql
	If FoundErr = True Then Exit Sub
	If CheckDir(BackupSqlDir) = False Then
		MakeNewsDir BackupSqlDir
	End If
	BackupFileName = SqlDataName & "_" & Replace(FormatDateTime(now,2), "-", "") & "_" & Replace(FormatDateTime(now,3), ":", "")
	BackupFilePath = BackupSqlDir & "\" & BackupSqlName
	BackupFilePath = Replace(BackupFilePath, "$1", BackupFileName)
	Set srv = Server.CreateObject("SQLDMO.SQLServer")
	srv.LoginTimeout = SqlLoginTimeout
	srv.Connect SqlServer, SqlUserID, SqlUserPass
	Set bak = Server.CreateObject("SQLDMO.Backup")
	bak.Database = SqlDataName
	'bak.Devices = Files
	bak.Files = BackupFilePath
	bak.SQLBackup srv
	If Err.Number>0 Then
		Response.Write Err.Number & "<font color=red><br>"
		Response.Write Err.Description & "</font>"
	End If
	Set srv = Nothing
	Set bak = Nothing
	Succeed("<li>SQL数据库备份成功！</li>")
End Sub
'====================恢复SQL数据库=========================
Sub RestoreSqlDatabase()
	On Error Resume Next
	Dim SqlDataName, SqlUserPass, SqlUserID, SqlServer, SqlLoginTimeout
	Dim srv, rest, BackupFilePath, BackupSqlDir, BackupSqlName, FSO
	SqlDataName = Trim(Request.Form("SqlDataName"))
	SqlUserPass = Trim(Request.Form("SqlUserPass"))
	SqlUserID = Trim(Request.Form("SqlUserID"))
	SqlServer = Trim(Request.Form("SqlServer"))
	BackupSqlDir = Trim(Request.Form("BackupSqlDir"))
	BackupSqlName = Trim(Request.Form("BackupSqlName"))
	SqlLoginTimeout = 20 '登陆超时
	CheckSql
	If FoundErr = True Then Exit Sub
	BackupFilePath = BackupSqlDir & "/" & BackupSqlName
	BackupFilePath = Replace(BackupFilePath, "$1", SqlDataName)
	BackupFilePath = Server.MapPath(BackupFilePath)
	Set FSO = Server.CreateObject("scripting.filesystemobject")
	If FSO.FileExists(BackupFilePath) Then
		Set srv = Server.CreateObject("SQLDMO.SQLServer")
		srv.LoginTimeout = SqlLoginTimeout
		srv.Connect SqlServer, SqlUserID, SqlUserPass
		Set rest = Server.CreateObject("SQLDMO.Restore")
		rest.Action = 0
		rest.Database = SqlDataName
		'rest.Devices = Files
		rest.Files = BackupFilePath
		rest.ReplaceDatabase = True
		rest.SQLRestore srv
		If Err.Number>0 Then
			ErrMsg = ErrMsg & "<li>备份数据库时发生错误！</li>"
			ErrMsg = ErrMsg & "<li>错误代码："
			ErrMsg = ErrMsg & Err.Number & "</li><li><font color=red>"
			'Response.Write Err.Number&"<font color=red><br>"
			ErrMsg = ErrMsg &  Err.Description&"</font></li>"
			FoundErr = True
			Exit Sub
		End If
		Set srv = Nothing
		Set rest = Nothing
		Succeed("<li>SQL数据库恢复成功！</li>")
	Else
		FoundErr = True
		ErrMsg = "备份目录下并无您的备份文件！"
		Exit Sub
	End If
	Set FSO = Nothing
End Sub
%>