Código: Selecionar todos
<html><head>
<STYLE TYPE="text/css">
BODY {font-family: "Verdana, Arial, Helvetica, sans-serif";
font-size:x-small;
background-color:#dfe0e5;
}
table {font-family: "Verdana, Arial, Helvetica, sans-serif";
font-size:x-small;}
#RestoreCompleted {
font-weight:bold;
color:green;
}
#RestoreInProgress {
font-weight:bold;
color:blue;
}
#RestoreError {
font-weight:bold;
color:red;
}
#Footer {
font-weight:bold;
font-size:10px;
}
</STYLE>
<script language="vbscript" OnLoad="Main()">
option explicit
Const HKEY_LOCAL_MACHINE = &H80000002
Const adVarChar = 200
Const adParamInput = 1
Const intAppWidth = 600
Const intAppHeight = 280 ' 255
' Set app size and centre screen on load
Sub Window_Onload()
Dim objWMIService,objItem,intHorizontal,intVertical
Dim intLeft, intTop
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
For Each objItem in objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
Next
If IsNull(intHorizontal) = False And IsNull(intVertical) = False Then
intLeft = (intHorizontal - intAppWidth) / 2
intTop = (intVertical - intAppHeight) / 2
window.moveTo intLeft, intTop
End If
window.resizeTo intAppWidth,intAppHeight
LoadSQLServerInstances()
End Sub
' Populate list box with local SQL Server instances
Sub LoadSQLServerInstances()
Dim strComputer,strKeyPath,strValueName,strValue
Dim oReg,arrValues, d
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Microsoft SQL Server\"
strValueName = "InstalledInstances"
oReg.GetMultiStringValue HKEY_LOCAL_MACHINE,strKeyPath, _
strValueName,arrValues
If ISArray(arrValues) = false then
msgbox "No local SQL Server instances found",vbCritical
Close()
end If
set d = createobject("Scripting.Dictionary")
For Each strValue In arrValues
Dim objOption
Set objOption = Document.createElement("OPTION")
if strValue = "LOCAL" OR strValue="MSSQLSERVER" then
strValue = "(local)"
else
strValue = ".\" & strValue
end if
objOption.Text = strValue
objOption.Value = strValue
if d.Exists(strValue) = false then
if selInstances.Contains(objOption) = false then
selInstances.Add(objOption)
end if
d.Add strValue,strValue
end if
Next
End Sub
' Prompt user to select backup file
Sub SelectBackupFile()
Dim oDLG
Set oDLG=CreateObject("MSComDlg.CommonDialog")
With oDLG
.DialogTitle="Open"
.Filter="Backup Files|*.bak|All files|*.*"
.MaxFileSize=255
.Flags=.Flags Or &H1000 'FileMustExist (OFN_FILEMUSTEXIST)
.ShowOpen
If .FileName<>"" Then
txtFileName.Value =.FileName
End If
End With
Set oDLG=Nothing
End Sub
' Prompt user for location of database restore
Sub SelectRestoreFolder()
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Dim objShell,objFolder,objFolderItem,strPath
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder:", OPTIONS, strPath)
If not objFolder Is Nothing Then
Set objFolderItem = objFolder.Self
txtRestoreFolder.Value = objFolderItem.Path
End If
End Sub
' Show/Hide username/password textbox depending on integrated security option
Sub ShowAuth()
if chkIntegrated.Checked = true then
trUserName.Style.Display = "none"
trPassword.Style.Display = "none"
window.resizeTo intAppWidth,intAppHeight
else
trUserName.Style.Display = "block"
trPassword.Style.Display = "block"
window.resizeTo intAppWidth,intAppHeight + 50
end if
End Sub
' Generate connection string for the local database
Private Function GetConnectionString
Dim strInstance,strUserName,strPassword
strInstance = selInstances.Value
strUserName = txtUserName.Value
strPassword = txtPassword.Value
if chkIntegrated.Checked = true then
GetConnectionString = "Provider=SQLOLEDB.1;Data Source=" & strInstance & ";Integrated Security=SSPI;"
else
GetConnectionString = "Provider=SQLOLEDB.1;Data Source=" & strInstance & ";UID=" & strUserName & ";PWD=" & strPassword
end if
End Function
' Check if the specified database name already exists
Function DatabaseExists(byval dbName)
Dim strSQL,objCn,objCmd,strCn, objRs,pName
strCn = GetConnectionString()
strSQL = "SELECT COUNT(*) FROM sysdatabases where name = ?"
set objCn = CREATEOBJECT("ADODB.Connection")
set objCmd = CREATEOBJECT("ADODB.Command")
set pName = objCmd.CreateParameter("@name",advarchar,adParamInput,128,dbname)
objCmd.Parameters.Append pName
objCn.Open strCn
objCmd.ActiveConnection = objCn
objCmd.CommandText = strSQL
set objRs = objCmd.Execute
if objRs(0) = 0 then
DatabaseExists = false
else
DatabaseExists = true
end if
objRs.Close
objCn.Close
end function
' Perform validations before the restore
Private Function Validate()
dim objFSO, strCn, objCn,dbName
set objFSO=createobject("Scripting.FileSystemObject")
' Check backup file exists
if NOT objFSO.FileExists(txtFileName.Value) then
RestoreError.InnerHTML = "File specified does not exist"
Validate = false
exit function
end if
' Check restore folder exists
if not objFSO.FolderExists(txtRestoreFolder.Value) then
RestoreError.InnerHTML = "Folder specified does not exist"
Validate = false
exit function
end if
err.clear
on error resume next
' Check connection to database
strCn = GetConnectionString
set objCn = CREATEOBJECT("ADODB.Connection")
objCn.Open strCn
objCn.Close
if err.number <> 0 then
RestoreError.InnerHTML= "Connection error:" & err.number
Validate = false
exit function
end if
' Get database name from backup file.
' Just a quick check that backup file is readable
GetDatabaseNameFromBackupFile()
if err.number <> 0 then
RestoreError.InnerHTML = "Error:" & err.number & " - " & err.description
Validate = false
exit function
end if
on error goto 0
' Get database name.
dbName = GetDatabaseName()
' Check if database with same name already exists
if DatabaseExists(dbName) then
RestoreError.InnerHTML = "Error: Database '" & dbname & "' already exists"
Validate = false
exit function
end if
Validate = True
End Function
' Return database name for restore (either from backup file or user specified name)
Private Function GetDatabaseName
if chkDBNameDefault.Checked = True then
GetDatabaseName = GetDatabaseNameFromBackupFile()
Else
GetDatabaseName = txtDBName.Value
end if
End Function
' Retreive database name from backup file
Private Function GetDatabaseNameFromBackupFile
Dim strSQL,objCn,objCmd,strCn, objRs,pRestoreFile
strCn = GetConnectionString()
strSQL = "RESTORE HEADERONLY FROM DISK = ?"
set objCn = CREATEOBJECT("ADODB.Connection")
set objCmd = CREATEOBJECT("ADODB.Command")
set pRestoreFile = objCmd.CreateParameter("@RestoreFile",advarchar,adParamInput,255,txtFileName.Value)
objCmd.Parameters.Append pRestoreFile
objCn.Open strCn
objCmd.ActiveConnection = objCn
objCmd.CommandText = strSQL
set objRs = objCmd.Execute
GetDatabaseNameFromBackupFile = objRs("DatabaseName")
objCn.Close
end function
' Similar to SQL Server QUOTENAME function
' Wraps quotes around string and performs escapes
Private Function QuoteName(byval Value, quoteChar)
if quotechar = "[" or quotechar = "]" then
QuoteName = "[" & REPLACE(Value,"]","]]") & "]"
elseif quoteChar = "'" then
QuoteName = "'" & REPLACE(Value,"'","''") & "'"
else
QuoteName = ""
end if
End Function
' Function to get the SQL statement used to perform the DB restore
Private Function GetRestoreSQL
Dim strSQL,objCn,objCmd,strCn, objRs,pRestoreFile
Dim dbName
dbName = GetDatabaseName()
strCn = GetConnectionString()
strSQL = "RESTORE FILELISTONLY FROM DISK = ?"
set objCn = CREATEOBJECT("ADODB.Connection")
set objCmd = CREATEOBJECT("ADODB.Command")
set pRestoreFile = objCmd.CreateParameter("@RestoreFile",advarchar,adParamInput,255,txtFileName.Value)
objCmd.Parameters.Append pRestoreFile
objCn.Open strCn
objCmd.ActiveConnection = objCn
objCmd.CommandText = strSQL
on error resume next
set objRs = objCmd.Execute
if err.number <> 0 then
msgbox(err.description & err.number)
exit function
end if
Dim strFolder
strFolder = txtRestoreFolder.Value
if not RIGHT(strFolder,1) = "\" then
strFolder = strFolder & "\"
end if
Dim strRestore,strPath
while objRs.EOF <> True AND objRs.BOF <> True
strPath = strFolder + dbname & "_" & objRs("LogicalName")
if objRs("Type") = "L" then 'LOG
strPath = strPath & ".ldf"
elseif objRs("Type") = "S" then 'FILESTREAM
' Folder don't add extension
else 'DATA
if objRs("FileID") = "1" then 'Primary File
strPath = strPath & ".mdf"
else
strPath = strPath & ".ndf"
end if
end if
if LEN(strRestore)> 0 then
strRestore = strRestore & ", "
end if
strRestore = strRestore & "MOVE N" & QuoteName(objRs("LogicalName"),"'") & " TO " & QuoteName(strPath,"'")
objRs.MoveNext
wend
objCn.Close
strRestore = "RESTORE DATABASE " & QuoteName(dbName,"]") & " FROM DISK=N" & QuoteName(txtFileName.Value,"'") & " WITH FILE=1," & strRestore
GetRestoreSQL = strRestore
End Function
' Perform database restore
Sub RestoreDatabase()
Dim strSQL,strCn, objCn, objCmd
' Clear any existing error/completed notifications
RestoreError.InnerHTML = ""
RestoreCompleted.Style.Display = "none"
' Perform validation checks prior to restore
if Validate() = false then
exit sub
end if
' Set restore notification
RestoreInProgress.Style.Display = "block"
UpdateScreen
' Get SQL for Restore
strSQL = GetRestoreSQL()
strCn = GetConnectionString()
set objCn = CREATEOBJECT("ADODB.Connection")
set objCmd = CREATEOBJECT("ADODB.Command")
objCn.Open strCn
objCmd.ActiveConnection = objCn
objCmd.CommandText = strSQL
objCmd.CommandTimeout = 0
on error resume next
objCmd.Execute
objCn.Close
if err.number <> 0 then
RestoreError.InnerHTML = "Error: " & err.Number & " - " & err.description
else
RestoreCompleted.Style.Display = "block"
end if
RestoreInProgress.Style.Display = "none"
End Sub
' Causes a refresh
Sub UpdateScreen()
' this is used to allow screen updates
dim CMD, WSHShell
Set WSHShell = CreateObject("WScript.Shell")
CMD = WSHShell.ExpandEnvironmentStrings("%comspec%")
WSHShell.run CMD + " /c ", 0, true
Set WSHShell = Nothing
End Sub
' Enables/Disables database name textbox
Sub DefaultOptionChanged()
if chkDBNameDefault.Checked = True then
txtDBName.Disabled = "Disabled"
txtDBName.style.backgroundcolor = "#dfe0e5"
else
txtDBName.Disabled = ""
txtDBName.style.backgroundcolor = "#ffffff"
end if
End Sub
</script>
</head>
<HTA:APPLICATION
APPLICATIONNAME="Restore Database Utility" ID="RestoreDBHTA" INNERBORDER="no" >
<body leftmargin=30 topmargin=20 rightmargin=30>
<table>
<tr>
<td>Backup File:</td><td><input id="txtFileName" style="width=300px;" type="Text" Value=""/><input type="submit" value="Open" OnClick="SelectBackupFile()" /></td>
</tr>
<tr>
<td>Restore Folder:</td><td><input id="txtRestoreFolder" style="width=300px;" type="Text" Value="" /><input type="submit" value="Open" OnClick="SelectRestoreFolder()" /></td>
</tr>
<tr>
<td>SQL Server Instance:</td>
<td>
<select name="selInstances">
</select>
<input id="chkIntegrated" type="checkbox" checked="true" OnClick="ShowAuth()">Integrated Security</input>
</td>
<tr id="trUserName" style="display:none">
<td>UserName:</td><td><input id="txtUserName" style="width=200px;" type="Text" /></td>
</tr>
<tr id="trPassword" style="display:none">
<td>Password</td><td><input id="txtPassword" style="width=200px;" type="password" /></td>
</tr>
<tr>
<td>Database Name:</td><td><input id="txtDBName" style="width=200px;background-color:#dfe0e5" disabled="disabled" type="Text" /><input id="chkDBNameDefault" type="checkbox" checked="true" OnClick="DefaultOptionChanged">Use Default</input></td>
</tr>
</table>
<br/>
<input type="submit" value="Restore Database" OnClick="RestoreDatabase()" /> <input type="submit" value="Close" OnClick="Close()" />
<br/>
<span id="RestoreInProgress" style="display:none">Database is been restored - this might take a while depending on the size of the database. Please wait...</span>
<span id="RestoreCompleted" style="display:none">Restore Completed.</span>
<span id="RestoreError"></span>
<div id="Footer">
<hr/>
<div style="float:left;">Version 1.0</div>
<div style="float:right;">By David Wiseman<br />
</div>
</div>
</body></html>