'**********************************************************************
' Using the record set produced from a query to the driver details proc
' process a backup plan (BackupScheduleSet} for the specified SQL server
'
'Expects global variables:
' Config SQL Server - location of admin.dbo.GetBackupInfo - I always
'                     keep the backup metadata on the server being backed 
'                     up but this is not required.
' Log File - file system location where a backup log is written. I use 
'            the path where the backups will be written and file name
'            of backup.log for the daily user db BackupScheduleSet 
'            and backupsys.log for the daily system db BackupScheduleSet
' BackupScheduleSet - a unique litereal used to group backups that will
'                     be done buy the same scheduled SQL Agent Job             
'
' reads the admin.dbo.BackupConfig table thru called procedure:
' admin.dbo.GetBackupInfo
'
' backup files can optionally be archived using "Archive a Backup Device" 
' Package for example or overwritten (WITH REPLACE) with each backup
'
' backup types can include any backup you can do in a DTS package. This
' should include any native or third party disk or tape backup, but have 
' to admit I haven't tested many. I use SQLLiteSpeed where possible. For
' examples see Packages "Backup a Database", "Differential Backup of a 
' Database", and "Log Backup of a Database"
'
' backups can optionally be restored using "Restore a Database", "Restore a
' Database Differential" or Log Restore of a Database" Packages for example.
'
' any custom action can be performed through optional packages that can 
' be called before and/or after each backup and restore. Examples would be
' Delete/Archive processing, removing users from a database before restore
' or drop a restored database after restore (the best way to verify that you 
' have a good backup;)
' 
' All called packages expect to receive:
'  a package name
'  a fully qualified file name to the Structured Storage File Package
'  all package parameters as a single string 
'
' '************************************************************************
Dim sDatabaseName
Dim sBackupServerName
Dim sIncludeRestore
Dim sRestoreServerName
Dim sBeforeBackupPackageName
Dim sBeforeBackupPackageUNCFile
Dim sBeforeBackupPackageGlobalVariables
Dim sArchivePackageName
Dim sArchivePackageUNCFile
Dim sArchivePackageGlobalVariables
Dim sBackupPackageName
Dim sBackupPackageUNCFile
Dim sBackupPackageGlobalVariables
Dim sAfterBackupPackageName
Dim sAfterBackupPackageUNCFile
Dim sAfterBackupPackageGlobalVariables
Dim sBeforeRestorePackageName
Dim sBeforeRestorePackageUNCFile
Dim sBeforeRestorePackageGlobalVariables
Dim sRestorePackageName
Dim sRestorePackageUNCFile
Dim sRestorePackageGlobalVariables
Dim sAfterRestorePackageName
Dim sAfterRestorePackageUNCFile
Dim sAfterRestorePackageGlobalVariables

Dim oFileSystem
Dim strLog
Dim oLog
  
'Set some constants
Const adOpenStatic = 3
Const adUseClient = 3
Const adLockBatchOptimistic = 4

Const TristateUseDefault = -2
Const ForWriting = 2
Const ForAppending = 8

Const QUOTE = """"

Function Main()

Dim sConfigDataSQLServer, sBackupScheduleSet
Dim sDriverProcedure, sDriverDB
Dim adoConnection, adoCommand, adoRecordset
Dim sConnect
Dim i
Dim DTSTaskExecResult
Dim sBackupLog

  sConfigDataSQLServer = DTSGlobalVariables("Config SQL Server")
  sBackupLog = DTSGlobalVariables("Log File")
  
  sDriverProcedure = "EXEC admin.dbo.GetBackupInfo " & QUOTE & DTSGlobalVariables("Backup Schedule Set") & QUOTE

  If Not (IsEmpty(sBackupLog) Or (sBackupLog = vbNullString)) Then
    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    LogOpen sBackupLog
  End If
  
  Set adoConnection = CreateObject("ADODB.Connection")

  sConnect = "Provider='sqloledb';Data Source='" & _
            sConfigDataSQLServer & "';" & _
            "Integrated Security='SSPI';Initial Catalog='" & sDriverDB & "';"
            
  adoConnection.Open sConnect
                           
  Set adoRecordset = CreateObject("ADODB.Recordset")

  With adoRecordset
    .ActiveConnection = adoConnection
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockBatchOptimistic
    .Source = sDriverProcedure
    .Open

    Set .ActiveConnection = Nothing
  End With
  
  adoConnection.Close
  Set adoConnection = Nothing

 ' somethings wrong if more than one ResultSet
 ' If oQueryResults.ResultSets = 1 Then
  
    ' plan for success
    DTSTaskExecResult = DTSTaskExecResult_Success
    
    ' process the backup plan database by database
    Do Until adoRecordset.EOF
    
      ' if an error occurs, log it, notify and proceed to the next database
      On Error Resume Next
          
      sDatabaseName = adoRecordset("DatabaseName")
      sBackupServerName = adoRecordset("BackupServerName")
      
      LogEvent "Processing database " & sDatabaseName & " on server " & sBackupServerName
      
      sIncludeRestore = adoRecordset("IncludeRestore")
    
      sBeforeBackupPackageName = adoRecordset("BeforeBackupPackageName")
      sBeforeBackupPackageUNCFile = adoRecordset("BeforeBackupPackageUNCFile")
      sBeforeBackupPackageGlobalVariables = adoRecordset("BeforeBackupPackageGlobalVariables")
    
      sArchivePackageName = adoRecordset("ArchivePackageName")
      sArchivePackageUNCFile = adoRecordset("ArchivePackageUNCFile")
      sArchivePackageGlobalVariables = adoRecordset("ArchivePackageGlobalVariables")
    
      sBackupPackageName = adoRecordset("BackupPackageName")
      sBackupPackageUNCFile = adoRecordset("BackupPackageUNCFile")
      sBackupPackageGlobalVariables = adoRecordset("BackupPackageGlobalVariables")
    
      sAfterBackupPackageName = adoRecordset("AfterBackupPackageName")
      sAfterBackupPackageUNCFile = adoRecordset("AfterBackupPackageUNCFile")
      sAfterBackupPackageGlobalVariables = adoRecordset("AfterBackupPackageGlobalVariables")
           
      sRestoreServerName = adoRecordset("RestoreServerName")
    
      sBeforeRestorePackageName = adoRecordset("BeforeRestorePackageName")
      sBeforeRestorePackageUNCFile = adoRecordset("BeforeRestorePackageUNCFile")
      sBeforeRestorePackageGlobalVariables = adoRecordset("BeforeRestorePackageGlobalVariables")
    
      sRestorePackageName = adoRecordset("RestorePackageName")
      sRestorePackageUNCFile = adoRecordset("RestorePackageUNCFile")
      sRestorePackageGlobalVariables = adoRecordset("RestorePackageGlobalVariables")
    
      sAfterRestorePackageName = adoRecordset("AfterRestorePackageName")
      sAfterRestorePackageUNCFile = adoRecordset("AfterRestorePackageUNCFile")
      sAfterRestorePackageGlobalVariables = adoRecordset("AfterRestorePackageGlobalVariables")
    
      If BackupDatabase Then

         ' process the restore plan if there is one
        If LCase(sIncludeRestore) = "yes" Then

          If Not (RestoreDatabase) Then
          
            LogEvent "Restore Failed. Database: " & adoRecordset("DatabaseName")
            DTSTaskExecResult = DTSTaskExecResult_Fail
            
          End If
          
        End If ' include restore
     
      Else
       
        DTSTaskExecResult = DTSTaskExecResult_Fail
        LogEvent "Backup Failed. Database: " & adoRecordset("DatabaseName")
     
      End If ' backup success/fail
 
      adoRecordset.MoveNext
 
    Loop ' Record
      
  On Error GoTo 0
      
  Set adoRecordset = Nothing
  
  If Not (IsEmpty(sBackupLog) Or (sBackupLog = vbNullString)) Then
    Set oFileSystem = Nothing
  End If
  
  Main = DTSTaskExecResult

End Function


Private Function BackupDatabase()
                    
  ' Keep going if theres and error
  On Error Resume Next
    
  BackupDatabase = False
  
  'run pre-backup structured storage file DTS package if required
  If RunSSFPackage(sBeforeBackupPackageName, _
                   sBeforeBackupPackageUNCFile, _
                   sBeforeBackupPackageGlobalVariables) Then
         
    'run archive structured storage file DTS package if required
    If RunSSFPackage(sArchivePackageName, _
                     sArchivePackageUNCFile, _
                     sArchivePackageGlobalVariables) Then
     
      'run backup structured storage file DTS package if required
      If RunSSFPackage(sBackupPackageName, _
                       sBackupPackageUNCFile, _
                       sBackupPackageGlobalVariables) Then
      
        'run post-backup structured storage file DTS package if required
        If RunSSFPackage(sAfterBackupPackageName, _
                         sAfterBackupPackageUNCFile, _
                         sAfterBackupPackageGlobalVariables) Then
          
          BackupDatabase = True
          
        End If
        
      End If
      
    End If
    
  End If

End Function

Private Function RestoreDatabase()
  
  ' keep going if there's an error
  On Error Resume Next
    
  RestoreDatabase = False
  
  'run pre-backup structured storage file DTS package
  If RunSSFPackage(sBeforeRestorePackageName, _
                   sBeforeRestorePackageUNCFile, _
                   sBeforeRestorePackageGlobalVariables) Then
                        
    'run restore structured storage file DTS package
    If RunSSFPackage(sRestorePackageName, _
                     sRestorePackageUNCFile, _
                     sRestorePackageGlobalVariables) Then
      
      'run post-restore structured storage file DTS package
      If RunSSFPackage(sAfterRestorePackageName, _
                       sAfterRestorePackageUNCFile, _
                       sAfterRestorePackageGlobalVariables) Then
                        
        RestoreDatabase = True
        
      End If
      
    End If
    
  End If

End Function

Private Function RunSSFPackage(sName, sUNCFile, sGlobalVariables)

' load and execute a structured storage file
  Dim oPackage, oStep, hr
  Dim sMessage, lErr, sSource, sDesc
  
  RunSSFPackage = True
      
  If Not (IsEmpty(sName) Or (sName = vbNullString)) _
     And Not (IsEmpty(sUNCFile) Or (sUNCFile = vbNullString)) Then
  
    On Error Resume Next
    
    Set oPackage = CreateObject("DTS.Package2")
  
    oPackage.LoadFromStorageFile sUNCFile, "", , , sName
    
    If Err.Number = 0 Then
       
      'set global variables now
      If Not (IsEmpty(sGlobalVariables) Or (sGlobalVariables = vbNullString)) Then
        SetGlobalVariables oPackage, sGlobalVariables
      End If

      ' Set Exec on Main Thread (apartment model)
'      For Each oStep In oPackage.Steps
'          oStep.ExecuteInMainThread = True
'      Next

      oPackage.Execute
   
        ' Get Status and Error Message
      sMessage = String(Len(oPackage.Name) + 4, "-") & vbCrLf & _
                 Space(2) & oPackage.Name & vbCrLf & _
                 String(Len(oPackage.Name) + 4, "-") & vbCrLf & vbCrLf
                 
      For Each oStep In oPackage.Steps
      
        If oStep.ExecutionResult = DTSStepExecResult_Failure Then
          oStep.GetExecutionErrorInfo lErr, sSource, sDesc
          sMessage = sMessage & "Step """ & oStep.Name & _
              """ Failed" & vbCrLf & _
              vbTab & "Error: " & lErr & vbCrLf & _
              vbTab & "Source: " & sSource & vbCrLf & _
              vbTab & "Description: " & sDesc & vbCrLf & vbCrLf
          RunSSFPackage = False
        Else
          sMessage = sMessage & "Step """ & oStep.Name & _
                """ Succeeded" & vbCrLf & vbCrLf
        End If
            
        LogEvent sMessage
            
      Next 'Step
    
      oPackage.UnInitialize
      Set oStep = Nothing
      Set oPackage = Nothing
    
    Else
      
      RunSSFPackage = False

    End If ' package oponed OK
    
  End If ' valid parameters

End Function

Private Function SetGlobalVariables(oPackage, sGlobalVariables)
' parameters always in format needed to run the package from SQL AGENT
' example:
'/A"Backup Folder:8=\\Dc-backupp101\NBU_Images\DEV_APOLLO"  /A"Database Name:8=pubs" /A"Backup Format:8=sls"

  Dim oGlobal 'As DTS.GlobalVariable
  Dim sParm, sName, sValue, sWorkList
    
  sWorkList = Replace(Trim(sGlobalVariables), """", "")
  While InStr(1, sWorkList, "/A") = 1
    sParm = StrReverse(Mid(StrReverse(sWorkList), 1, InStr(1, StrReverse(sWorkList), "A/") - 1))
    sName = Mid(sParm, 1, InStr(1, sParm, ":") - 1)
    sValue = Mid(sParm, InStr(1, sParm, "=") + 1)
    sWorkList = StrReverse(Mid(StrReverse(sWorkList), InStr(1, StrReverse(sWorkList), "A/") + 2))
    
    oPackage.GlobalVariables.item(CStr(sName)) = Trim(sValue)

  Wend

End Function
Function LogOpen(sLog)
Dim iErrorNbr, i
Dim sLogFile, sLogFileName

   On Error Resume Next
   Set oLog = oFileSystem.GetFile(sLog)
   
   'set the log file read only bit off
   'sourcesafe tries to keep this bit set on
   Select Case Err.Number
   
     Case 0 ' found so archive it and create a new one

       ' rename the log to the identified numeric extension              
       If (oFileSystem.FileExists(sLog)) Then

         sLogFile = strReverse(Mid(strReverse(sLog), 1, InStr(strReverse(sLog),"\") - 1))

         If InStr(sLogFile, ".") > 0 Then
           sLogFileName = Mid(sLogFile, 1, InStr(sLogFile, ".") - 1)
         Else
           sLogFileName = sLogFile       
         End If

         ' find the next available numeric extension                              
         i = 1
         While oFileSystem.FileExists(sLogFileName & "." & CStr(i))
           i = i + 1
         Wend

         Set oFile = oFileSystem.GetFile(sLog)
         oFile.Name = sLogFileName & "." & CStr(i)
         Set oFile = Nothing

       End If
       
     Case 53 ' file not found so everythings cool
     
     Case Else 'something bad happened - stop now
        On Error GoTo 0
        iErrorNbr = Err.Number
        Err.Raise iErrorNbr
    End Select

    On Error GoTo 0

    'create the log file
    oFileSystem.CreateTextFile sLog, True
    Set oLog = oFileSystem.GetFile(sLog)
  
    'init the log file
    Set strLog = oLog.OpenAsTextStream(ForWriting, TristateUseDefault)
    strLog.Close
  
End Function

Function LogEvent(sMessage)
      
  Set strLog = oLog.OpenAsTextStream(ForAppending, TristateUseDefault)
  strLog.WriteLine Now
  strLog.Write sMessage
  strLog.WriteBlankLines (1)
  strLog.Close
    
End Function