Private Sub cmdRestore_Click()
On Error GoTo ErrHandler:
Dim oRestore As SQLDMO.Restore
Dim Msg As String
Dim Response As String
' Msg = "You must choose the right database name according to the data file name selected. Do you want to continue?"
' Response = MsgBox(Msg, vbYesNo, gTitle)
' If Response = vbNo Then
' Exit Sub
' End If
gDatabaseName = cmbDatabaseName.Text
Set oRestore = New SQLDMO.Restore
Set oRestoreEvent = oRestore ' enable events
ErrHandler:
'User pressed the Cancel button
Exit Sub
End Sub
' VB will create the right prototypes for you, if you select the oBackupEvent in
' the drop down listbox of your editor
Private Sub oBackupEvent_Complete(ByVal Message As String)
PrintStat "oBackupEvent_Complete -- " & Message
End Sub
Private Sub oBackupEvent_NextMedia(ByVal Message As String)
PrintStat "oBackupEvent_NextMedia -- " & Message
End Sub
Private Sub oBackupEvent_PercentComplete(ByVal Message As String, ByVal Percent As Long)
PrintStat "oBackupEvent_PercentComplete -- " & Message & " " & Percent
End Sub
Private Sub oRestoreEvent_Complete(ByVal Message As String)
PrintStat "oRestoreEvent_Complete -- " & Message
End Sub
Private Sub oRestoreEvent_NextMedia(ByVal Message As String)
PrintStat "oRestoreEvent_NextMedia -- " & Message
End Sub
Private Sub oRestoreEvent_PercentComplete(ByVal Message As String, ByVal Percent As Long)
PrintStat "oRestoreEvent_PercentComplete -- " & Message & " " & Percent
End Sub
Private Sub PrintStat(ByRef Message As String)
txtStatus.Text = txtStatus.Text + Message + vbCrLf
End Sub
Private Sub optSSAuth_Click()
If optSSAuth.Value = True Then
SSAuthOptionsOn
End If
End Sub
Private Sub optWinNTAuth_Click()
optWinNTAuth.Value = True
WinNTAuthOptionsOn
txtUserName.Text = ""
txtPassword.Text = ""
End Sub
Private Sub buttonsConnectClosed()
cmdConnect.Default = True
' Enable the Authorization stuff.
optWinNTAuth.Enabled = True
optSSAuth.Enabled = True
txtServerName.Enabled = True
lblServer.Enabled = True
If optWinNTAuth = True Then
WinNTAuthOptionsOn
Else
SSAuthOptionsOn
End If
End Sub
Private Sub WinNTAuthOptionsOn()
lblUserName.Enabled = False
lblPassword.Enabled = False
txtUserName.Enabled = False
txtPassword.Enabled = False
End Sub
Private Sub SSAuthOptionsOn()
lblUserName.Enabled = True
lblPassword.Enabled = True
txtUserName.Enabled = True
txtPassword.Enabled = True
End Sub
Private Sub FillDatabaseList()
cmbDatabaseName.Clear
' Enumerate all of the databases and add the names to the list box.
Dim oDB As SQLDMO.Database
For Each oDB In gSQLServer.Databases
If oDB.SystemObject = False Then
cmbDatabaseName.AddItem oDB.Name
End If
Next oDB
' Take care of the assignment of gBkupRstrFilePath.
Dim MyPos As Integer
gBkupRstrFilePath = CurDir
MyPos = InStr(1, CurDir, "DevTools", 1)
If MyPos > 0 Then
gBkupRstrFilePath = Left(gBkupRstrFilePath, MyPos - 1)
If Len(Dir(gBkupRstrFilePath + "backup", vbDirectory)) Then
gBkupRstrFilePath = gBkupRstrFilePath + "backup\"
Else
gBkupRstrFilePath = "c:\"
End If
Else
gBkupRstrFilePath = "c:\"
End If
' Select the first database in the list.
If cmbDatabaseName.ListCount > 0 Then
cmbDatabaseName.ListIndex = 0
' Assign the default backup/restore file name.
If Len(cmbDatabaseName.Text) > 0 Then
txtDataFileName.Text = gBkupRstrFilePath + cmbDatabaseName.Text + ".bak"
End If
End If
End Sub
Private Sub cmbDatabaseName_Click()
' Assign the default backup/restore file name.
If Len(cmbDatabaseName.Text) > 0 Then
txtDataFileName.Text = gBkupRstrFilePath + cmbDatabaseName.Text + ".bak"
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Backup Restore with Events Sample Application
' Microsoft Copyright 2000
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Dim gSQLServer As SQLDMO.SQLServer
Dim WithEvents oBackupEvent As SQLDMO.Backup
Attribute oBackupEvent.VB_VarHelpID = -1
Dim WithEvents oRestoreEvent As SQLDMO.Restore
Attribute oRestoreEvent.VB_VarHelpID = -1
Dim gbConnected As Boolean
Dim gDatabaseName As String
Dim gBkupRstrFileName As String
Dim gBkupRstrFilePath As String
Const gTitle = "Server Connection"
Private Sub Form_Load()
Set gSQLServer = Nothing
optWinNTAuth.Value = True
gbConnected = False
WinNTAuthOptionsOn
buttonsConnectClosed
End Sub
Private Sub Form_Unload(Cancel As Integer)
If gbConnected = True Then
Call gSQLServer.DisConnect
End If
If Not gSQLServer Is Nothing Then
Set gSQLServer = Nothing
End If
End Sub
Private Sub cmdConnect_Click()
Dim ServerName As String
Dim UserName As String
Dim Password As String
On Error GoTo ErrHandler:
If gSQLServer Is Nothing Then
Set gSQLServer = New SQLDMO.SQLServer
End If
' Put text box values into connection variables.
ServerName = txtServerName.Text
UserName = txtUserName.Text
Password = txtPassword.Text
' Set the login timeout.
gSQLServer.LoginTimeout = 15
' Decision code for login authorization type: WinNT or SQL Server.
If optWinNTAuth.Value = True Then
gSQLServer.LoginSecure = True
End If
' Change mousepointer while trying to connect.
Screen.MousePointer = vbHourglass
' List all of the database names.
FillDatabaseList
' Change mousepointer back to the default after connect.
Screen.MousePointer = vbDefault
' Notify user that connection was successful.
MsgBox "Connection to server successful.", vbOKOnly, gTitle
buttonsConnectOpen
' Clear up the status text in the "result field".
txtStatus.Text = ""
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Description
' Change mousepointer back if it's hourglass.
If Screen.MousePointer = vbHourglass Then
Screen.MousePointer = vbDefault
End If
End Sub
Private Sub cmdDisconnect_Click()
On Error GoTo ErrHandler:
Dim Msg As String
Dim Response As String
' Disconnect from a connected server.
If gbConnected = True Then
Msg = "Disconnect from Server?"
Response = MsgBox(Msg, vbOKCancel, gTitle)
If Response = vbOK Then
Call gSQLServer.DisConnect
Set gSQLServer = Nothing
cmbDatabaseName.Clear
txtDataFileName.Text = ""
txtStatus.Text = ""
gbConnected = False
buttonsConnectClosed
End If
End If
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Description
Resume Next
End Sub
Private Sub cmdBackup_Click()
On Error GoTo ErrHandler:
Dim oBackup As SQLDMO.Backup
gDatabaseName = cmbDatabaseName.Text
Set oBackup = New SQLDMO.Backup
Set oBackupEvent = oBackup ' enable events
' Delete the datafile to allow the application to create a brand new file.
' This will prevent attaching the new backup data to the old data if there
' is any.
If Len(Dir(gBkupRstrFileName)) > 0 Then
Kill (gBkupRstrFileName)
End If
' Change mousepointer while trying to connect.
Screen.MousePointer = vbHourglass
' Backup the database.
oBackup.SQLBackup gSQLServer
' Change mousepointer back to the default after connect.
Screen.MousePointer = vbDefault
Set oBackupEvent = Nothing ' disable events
Set oBackup = Nothing
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Description
Resume Next
End Sub