VBS runs... then gets tired?

[lotharkrepke]

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