VBS runs... then gets tired?

Discussion in 'backup, imaging & disk mgmt' started by lotharkrepke, Jul 5, 2011.

Thread Status:
Not open for further replies.
  1. lotharkrepke

    lotharkrepke Registered Member

    Joined:
    Dec 22, 2008
    Posts:
    1
    Howdy,

    I have a Macrium Reflect VBS script that generates an image of a small partition every thirty minutes, and sends an email when the script runs. The script launches at system startup. The system running Reflect is a peer-to-peer "Server." That is, it runs XP, but the system is not used as a workstation, it is simply a repository for shared files.

    The script works just fine, until it "decides" to stop!

    Sometimes, it runs perfectly for more than a week, and then it stops.

    When it stops, there is no error, and there is nothing in the Reflect log. The script simply stops running, and I am baffled.

    The complete VBS code is just below, and I would certainly appreciate any help in sorting this out,

    Lothar



    '******************************************************************************
    '*
    '*
    '* Module Name: Server-Data-Diff-K06.vbs
    '*
    '* Abstract: This is a template VB Script file generated by Reflect v4.2
    '* Modify to add your own functionality if required
    '*
    '*
    '******************************************************************************

    OPTION EXPLICIT

    ' call the main function
    Call VBMain()


    '******************************************************************************
    '* Sub: VBMain
    '*
    '* Purpose: This is main function to start execution
    '*
    '* Input: None
    '*
    '* Output: None
    '*
    '******************************************************************************
    Sub VBMain()
    Dim objShell
    Dim ExitCode

    Set objShell = WScript.CreateObject("WScript.Shell")

    While true
    ' Do the backup
    ExitCode = Backup ("""C:\Program Files\Macrium\Reflect\reflect.exe"" -e -w ""C:\Documents and Settings\KS\My Documents\Reflect\Server-Data-Diff-K06.xml""")
    DeleteDifferentialFiles ExitCode, 4
    ' Sleep for 30 minutes
    WScript.Sleep(1800 * 1000)
    Wend

    ' done
    Set objShell = nothing
    wscript.quit(ExitCode)
    End Sub

    '******************************************************************************
    '* Function: Backup
    '*
    '* Purpose: Calls Reflect.exe passing an XML BDF as a parameter
    '* Optionaly logs output to file
    '*
    '* Input: strCmdLine Command Line Arguments
    '* Output: Exit Code
    '*
    '******************************************************************************
    Function Backup(Byref strCmdLine)
    Dim objShell
    Dim objExecObject
    Dim strLine
    Dim objFS
    Dim objNewFile
    Dim strLogFileName


    ' Run the backup or image
    Set objShell = WScript.CreateObject("WScript.Shell")
    Set objExecObject = objShell.Exec(strCmdLine)

    ' Log to file
    strLogFileName = "C:\Documents and Settings\KS\My Documents\Reflect\log-" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & " " & Hour(Time) & "." & Minute(Time) & "." & Second(Time) & ".txt"
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objNewFile = objFS.OpenTextFile(strLogFileName , 8, 1)
    Do Until objExecObject.StdOut.AtEndOfStream
    strLine = objExecObject.StdOut.ReadLine()
    If Instr(strLine , "%") = 0 Then
    objNewFile.WriteLine strLine
    end if
    Loop

    objNewFile.Close
    set objFS = nothing

    ' Wait for the process to finish
    Do While objExecObject.Status = 0
    WScript.Sleep 100
    Loop

    if objExecObject.exitcode = 2 then
    ' Handle XML validation error

    elseif objExecObject.exitcode = 1 then
    ' Handle backup error
    SendEmail "Server Reflect FAILURE Data Diff K06", "Server Reflect FAILURE Data Diff K06", strLogFileName
    elseif objExecObject.exitcode = 0 then
    ' Everything OK
    SendEmail "Server Reflect SUCCESS Data Diff K06", "Server Reflect SUCCESS Data Diff K06", strLogFileName
    end if
    Backup = objExecObject.exitcode
    Set objExecObject = nothing
    Set objShell = nothing
    End Function


    '******************************************************************************
    '* Sub: SendEmail
    '*
    '* Purpose: Uses CDO to send an email message
    '*
    '* Input: strSubject subject text
    '* strBody main body of the email
    '* strLogFileName file name of the log file to attach to the email
    '* Output: None
    '*
    '******************************************************************************
    Function SendEmail(ByRef strSubject, _
    ByRef strBody, _
    ByRef strLogFileName)
    Dim objMessage

    Set objMessage = CreateObject("CDO.Message")

    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.gmail.com"
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=465
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")=1
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername")="XXXXXXXXXX@gmail.com"
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")="ZZZZZZZZZZ"
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl")=1

    objMessage.Configuration.Fields.Update

    objMessage.Subject = strSubject
    objMessage.From = "AAAA@BBBBBBBBBB.com"
    objMessage.To = "AAAA@BBBBBBBBBBB.com"
    objMessage.TextBody = strBody
    objMessage.Send
    Set objMessage = nothing
    End Function

    '******************************************************************************
    '* Function: DeleteDifferentialFiles
    '*
    '* Purpose: Deletes all but most 'n' recent differential file(s).
    '*
    '* Uses Macrium environment variables to
    '* determine which files to delete.
    '*
    '* Input:ExitCode -The exit code of the last backup
    '* NumberOfDifferentialsToKeep - The number of differentials to retain
    '*
    '******************************************************************************
    Function DeleteDifferentialFiles(Byval ExitCode, Byval NumberOfDifferentialsToKeep)
    Dim objShell
    Dim objWshProcessEnv
    Dim strEnvName
    Dim nFiles
    Dim Count
    Dim strEnvPrefix
    Dim strCurrentDifferentialNumber
    Dim strFileToDelete
    Dim objFS

    ' Only delete files if backup was successful
    if ExitCode <> 0 Then
    Exit Function
    End If
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objShell = WScript.CreateObject("WScript.Shell")
    Set objWshProcessEnv = objShell.Environment("VOLATILE")


    ' Get the prefix for the last backup set
    strEnvPrefix = objWshProcessEnv("MACRIUM_PREFIX")

    ' Get the total number of files for the last backup set
    nFiles = CInt(objWshProcessEnv(strEnvPrefix + "_FILECOUNT"))
    ' Get the last differential number. Note: differential 0 is the full backup
    strCurrentDifferentialNumber = objWshProcessEnv(strEnvPrefix + "_CURRENT_INCREMENT")
    for Count = 1 To nFiles

    ' Construct the environment variable name for the bckup method

    ' 0 = Full, 1 = Incremental, 2 = Differential

    strEnvName = strEnvPrefix + "_METHOD" + CStr(Count)

    ' Only delete differential files

    if CInt(objWshProcessEnv(strEnvName)) = 2 Then
    ' Construct the environment variable name for the differential for eachfile
    strEnvName = strEnvPrefix + "_INCREMENT" + CStr(Count)
    ' Don't delete the current differential
    if CInt(objWshProcessEnv(strEnvName)) < ( CInt(strCurrentDifferentialNumber) -NumberOfDifferentialsToKeep + 1) Then
    ' Construct the environment variable for the full filepath
    strEnvName = strEnvPrefix + "_FILEPATH" + CStr(Count)
    strFileToDelete = objWshProcessEnv(strEnvName)
    ' Delete the file if itexists
    If objFS.FileExists(strFileToDelete) Then
    ON ERROR RESUME NEXT
    objFS.DeleteFile strFileToDelete
    End If
    End If
    End If
    Next

    ' Clean up
    Set objShell = nothing
    Set objWshProcessEnv = nothing
    Set objFS = nothing
    End Function
     
Loading...
Thread Status:
Not open for further replies.