admin_database.asp

网络上经典的图片程序

			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 & " Byte"
	If Size>1024 Then
		Size = (Size / 1024)
		showsize = FormatNumber(Size, 2) & " KB"
	End If
	If Size>1024 Then
		Size = (Size / 1024)
		showsize = FormatNumber(Size, 2) & " MB"
	End If
	If Size>1024 Then
		Size = (Size / 1024)
		showsize = FormatNumber(Size, 2) & " 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
%>