Option Explicit
'=========================================================================
' DirMirror.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 9/26/2013
' REQUIREMENTS:
' - robocopy.exe (Built in to Server2008+, Windows 7+)
' - blat.exe, blat.dll. blat.lib in the same directory as the script (http://www.blat.net)
' - Blat profile installed to email results
' - Recommended to use Stunnel to Encrypt Email Sessions, Especially If the Email Server
' is not on your subnet ex: Gmail
' COMMENTS: Requires robocopy for the backup and blat to email results. Define
' the Directory Source(what you need to backup), the Directory Destination
' (where you need to backup to), path to blat, blat profile, email subject,
' and email body
'=========================================================================

' ------ SCRIPT CONFIGURATION ------
Const WindowStyle = 0  '0=Hide Robocopy Console, 1=Show Robocopy Console
Dim DirSource: DirSource = "\\server\share\directory"
Dim DirDestination: DirDestination = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\")) & "backup"
Dim intReturn 'Generic Return
Dim logErrors: logErrors = Replace(WScript.ScriptFullName,".vbs","_log.txt")
Dim emailBlatExe: emailBlatExe = "C:\blat\blat.exe" 'Custom Path to Blat.exe Default is Same Folder as Script
Dim emailProfile: emailProfile = "gmail" 'Blat Profile Name See (http://www.blat.net) For Info
Dim emailRecipient: emailRecipient = "email@domain.com" 'Email to Receive Backup Result
Dim eSubject: eSubject = "Server1 Backup"
Dim eBody: eBody = "Server1 Backup"
' ------ END CONFIGURATION ------

'MAIN CALLS
Call Logger(logErrors, "[" & Now() & "] " & vbCrLf & Wscript.ScriptName & vbCrLf & "Server: Spiceworks", True)
Call AllowSingleInstance(".",logErrors, emailBlatExe, emailProfile, emailRecipient, eSubject, eBody)
Call ConfirmDirectories(logErrors, DirSource, DirDestination, emailBlatExe, emailProfile, emailRecipient, eSubject, eBody)
Call RoboDirMirror(logErrors, DirSource, DirDestination, emailBlatExe, emailProfile, emailRecipient, eSubject, eBody)



' ***************************************************************************************************
' Function RoboDirMirror - Mirrors a Source Directory to a Mirror Directory Using Robocopy
' ***************************************************************************************************
Private Sub RoboDirMirror(logName, strSource, strDestination, emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody)

	'On Error Resume Next
	
	Call Logger(logName, vbCrLf & "[" & Now() & "] " & vbCrLf & "Run Robocopy to Mirror Directory", False)
	'Ensure Directories Don't End with Slash or Robocopy Will Error
	If Mid(strSource,Len(strSource),1) = "\" Then
		strSource = Mid(strSource,1,Len(strSource) - 1)
	End If
	If Mid(strDestination,Len(strDestination),1) = "\" Then
		strDestination = Mid(strDestination,1,Len(strDestination) - 1)
	End If
	
	Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
	Dim strCommand: strCommand = "robocopy"
	Dim cmdOptions: cmdOptions = "/MIR /FFT /Z /XA:H /W:5 /log+:" & chr(34) & logName & chr(34)
	'Robocopy \\SourceServer\Share \\DestinationServer\Share /MIR /FFT /Z /XA:H /W:5
	Dim intReturn: intReturn = objShell.Run(strCommand & " " & chr(34) & strSource & chr(34) & " " & chr(34) & strDestination & chr(34) & " " & cmdOptions, WindowStyle, True)
	Select Case intReturn
	Case 0
		'No Files Copied
		Call Logger(logName, "RESULT: Success - No Files Copied", False)
		emailSubject = emailSubject & " Success"
		emailBody = emailBody & " Success - No Files Copied"
	Case 1
		'Files Copied
		Call Logger(logName, "RESULT: Success - Files Copied", False)
		emailSubject = emailSubject & " Success"
		emailBody = emailBody & " Success - Files Copied"
	Case 2
		'File on Source Does Not Exist on Destination
		Call Logger(logName, "RESULT: Success - New Files Found in Source that are Not in Destination", False)
		emailSubject = emailSubject & " Success"
		emailBody = emailBody & " Success - New Files Found in Source that are Not in Destination"
	Case 3
		'Combination of Case1 and Case2
		Call Logger(logName, "RESULT: Success - Files Copied (New Files Found in Source that are Not in Destination)", False)
		emailSubject = emailSubject & " Success"
		emailBody = emailBody & " Success - Files Copied (New Files Found in Source that are Not in Destination)"
	Case Else
		'Error
		Call Logger(logName, "RESULT: !~ERROR~! - Error Occurred on Robocopy", False)
		emailSubject = emailSubject & " FAILED"
		emailBody = emailBody & " FAILED - Error Occurred on Robocopy"
	End Select
	
	If Err.Number <> 0 Then
		Err.Clear
		Call Logger(logName, "!~ERROR~! - Unknown Error Occurred in RoboDirMirror Sub", False)
		emailSubject = emailSubject & " FAILED"
		emailBody = emailBody & " FAILED - Unknown Error Occurred in RoboDirMirror Sub"
	End If
	
	Call SendBlatEmail(emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody, logName)
	
End Sub



' ***************************************************************************************************
' Function ConfirmDirectories - Confirm Source and Destination Directories Exist
' ***************************************************************************************************
Private Sub ConfirmDirectories(logName, strSource, strDestination, emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody)

	'On Error Resume Next
	
	Call Logger(logName, vbCrLf & "[" & Now() & "] " & vbCrLf & "Confirm Source/Destination Directories Exist", False)
	' Create Objects
	Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
	Call Logger(logName, "SOURCE: " & strSource, False)
	Call Logger(logName, "DESTINATION: " & strDestination, False)
	If Not objFSO.FolderExists(strSource) Then
		'Source Not Exist
		Call Logger(logName, "!~ERROR~! - Source Directory Does Not Exist, Quitting Script!", False)
		emailSubject = emailSubject & " FAILED"
		emailBody = emailBody & " Failed - Source Directory Does Not Exist"
		Call SendBlatEmail(emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody, logName)
		Wscript.Quit
	Else
		Call Logger(logName, "Success - Source Directory Exists", False)
	End If
	
	If Not objFSO.FolderExists(strDestination) Then
		'Destination Not Exist
		Call Logger(logName, "Warning - Destination Directory Does Not Exist, Attempting to Create It", False)
		'Attempt to Create
		Call CreateFileOrDir(strDestination)
		If Not objFSO.FolderExists(strDestination) Then
			Call Logger(logName, "!~ERROR~! - Failed to Create Destination Directory, Quitting Script!", False)
			emailSubject = emailSubject & " FAILED"
			emailBody = emailBody & " Failed - Destination Directory Does Not Exist and Failed to Create It"
			Call SendBlatEmail(emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody, logName)
			Wscript.Quit
		Else
			Call Logger(logName, "Success - Created Destination Directory", False)
		End If
	Else
		Call Logger(logName, "Success - Destination Directory Exists", False)
	End If
	
	If Err.Number <> 0 Then
		Err.Clear
		Call Logger(logName, "!~ERROR~! - Unknown Error in ConfirmDirectories Sub, Quitting Script", False)
		emailSubject = emailSubject & " FAILED"
		emailBody = emailBody & " Failed - Unknown Error in ConfirmDirectories Sub"
		Call SendBlatEmail(emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody, logName)
		Wscript.Quit
	End If
	
End Sub



' ***************************************************************************************************
' Function AllowSingleInstance - Checks if only a single instance of the script is running - useful 
'                                for repetitive scheduled tasks
' ***************************************************************************************************
Private Sub AllowSingleInstance(strComputer, logName, emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody)
	
	On Error Resume Next
	
	Call Logger(logName, vbCrLf & "[" & Now() & "] " & vbCrLf & "Confirm Single Instance of " & Wscript.ScriptName, False)
	Dim intReturn: intReturn = 0  '0=Success, 1=Error, 2=Warning
	Dim objWMIService: Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'cscript.exe'" & " OR Name = 'wscript.exe'")
	Dim intCount: intCount = 0
	Dim objItem, strTemp

	For Each objItem in colItems
		If Not IsNull(objItem.CommandLine) Then
			strTemp = Right(objItem.CommandLine, Len(objItem.CommandLine) - InStrRev(objItem.CommandLine, chr(34) & " " & chr(34)))
			strTemp = Trim(Replace(strTemp, chr(34), ""))
			If StrComp(Wscript.ScriptFullName, strTemp, 1) = 0 Then
				intCount = intCount + 1
			End If
		End If
	Next	
	
	Call Logger(logName, "Detected Instances: " & intCount, False)
	If intCount > 1 Then
		'Kill It
		Call Logger(logName, "!~ERROR~! - Only 1 instance is allowed, Quitting Script!", False)
		emailSubject = emailSubject & " FAILED"
		emailBody = emailBody & " Backup FAILED - Detected " & intCount & " running instances"
		Call SendBlatEmail(emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody, logName)
		Wscript.Quit
	End If
	
	If Err.Number <> 0 Then
		Err.Clear
		Call Logger(logName, "!~ERROR~! - Unknown Error in AllowSingleInstance Sub, Quitting Script!", False)
		emailSubject = emailSubject & " FAILED"
		emailBody = emailBody & " Backup FAILED - Unknown Error in AllowSingleInstance Sub"
		Call SendBlatEmail(emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody, logName)
		Wscript.Quit
	End If
	
	On Error Goto 0
	
End Sub



' ***************************************************************************************************
' Function CreateFileOrDir
' ***************************************************************************************************
Private Sub CreateFileOrDir(strPath)

    On Error Resume Next

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.DriveExists(objFSO.GetDriveName(strPath)) Then
        If StrComp(objFSO.GetExtensionName(strPath), "", 1) = 0 Then
            If Not objFSO.FolderExists(strPath) Then
                If objFSO.FolderExists(objFSO.GetParentFolderName(strPath)) Then
                    objFSO.CreateFolder strPath 'Create Folder In Current Path
                Else
                    CreateFileOrDir(objFSO.GetParentFolderName(strPath)) 'Recurse Creating Parent Folder
                    CreateFileOrDir(strPath) 'Recurse Creating Current Folder
                End If
            End If
        Else
            If Not objFSO.FileExists(strPath) Then
                If objFSO.FolderExists(objFSO.GetParentFolderName(strPath)) Then
                    objFSO.CreateTextFile strPath, True  'Create File In Current Path
                Else
                    CreateFileOrDir(objFSO.GetParentFolderName(strPath))  'Recurse Creating Parent Folder
                    CreateFileOrDir(strPath)  'Recurse Creating Current Folder
                End If
            End If
        End If
    End If
   
    On Error Goto 0
   
End Sub



' ***************************************************************************************************
' Function SendBlatEmail - Sends Email Using Blat
' ***************************************************************************************************
Private Sub SendBlatEmail(blatPath, blatProfile, strRecipients, strSubject, strBody, strAttachment)

    'Need blat.exe, blat.dll, blat.lib
    On Error Resume Next
   
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))

    'Ensure Blat Exists
    If Not objFSO.FileExists(blatPath) Then
        If Not objFSO.FileExists(scriptPath & "blat.exe") Then
            Exit Sub
        Else
            blatPath = scriptPath & "blat.exe"
        End If
    End If
   
    'Set Blat Email Command
    Dim commandText: commandText = chr(34) & blatPath & chr(34)
    commandText = commandText & " -p " & chr(34) & blatProfile & chr(34)
    commandText = commandText & " -to " & strRecipients
    commandText = commandText & " -subject " & chr(34) & strSubject & " " & chr(34) 'Keep Space to Prevent Escaping the Quote
    commandText = commandText & " -body " & chr(34) & strBody & " " & chr(34) 'Keep Space to Prevent Escaping the Quote

    'Append Attachment(s)
    If objFSO.FileExists(strAttachment) Then
        commandText = commandText & " -attach " & chr(34) & strAttachment & chr(34)
    Else
        If objFSO.FileExists(scriptPath & strAttachment) Then
            commandText = commandText & " -attach " & chr(34) & scriptPath & strAttachment & chr(34)
        End If
    End If
   
    'Send Blat Email
    objShell.run commandText, True
   
    Set objFSO = Nothing
    Set objShell = Nothing
   
    If Err.Number <> 0 Then
        Err.Clear
    End If

    On Error Goto 0
   
End Sub



' ***************************************************************************************************
' Function Logger 
' ***************************************************************************************************
Private Sub Logger(fileName, logMessage, blnNewLog)

    On Error Resume Next
   
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                        Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                        Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                    End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing
   
    On Error Goto 0

End Sub