?? admin_database.asp

?? 本人僅業(yè)余學習一些基礎的ASP知識以供系統設計之用,并非專業(yè)人員,相關服務器設置、MSSQL/MySQL數據庫方面的專業(yè)問題請自行解決。本人僅提供本系統相關的一些技術問題的解釋、解答。
?? ASP
?? 第 1 頁 / 共 2 頁
字號:
上一頁 12
		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
	response.Write("<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>備份數據庫時發(fā)生錯誤！</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
		response.Write("<li>SQL數據庫恢復成功！</li>")
	Else
		FoundErr = True
		ErrMsg = "備份目錄下并無您的備份文件！"
		Exit Sub
	End If
	Set FSO = Nothing
End Sub
%>
上一頁 12
?? 文件大小 542 K
?? 上傳用戶 foreverlovely
?? 所屬分類 Internet/網絡編程
??? 相關標簽

#MSSQL #MySQL #ASP #系統設計
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? admin_database.asp

?? 快捷鍵說明
