Option Explicit '-------------------------------------------------------------- ' FreeFileSync.vbs '-------------------------------------------------------------- ' Runs FreeFileSync.exe with specified batch file. ' Sends email with status, errors, and warnings on completion. '-------------------------------------------------------------- ' Author: Lane Beneke - Southern Piping Company ' Date: 2013.01.17 ' Usage: cscript.exe FreeFileSync.vbs ' ' ' ' ' ' ' ' ' Notes: 1) Parameter/Value pairs can be specified at the ' command line, or changed in code below. Command ' line values override coded values. ' 2) If the word "BatchName" (case sensitive) is in the ' subject line, it will be replaced by the name of ' the batch file less path and extension. '-------------------------------------------------------------- ' Copyright 2012 Lane Beneke - Southern Piping Company ' ' This program is free software: you can redistribute it and/or ' modify it under the terms of the GNU General Public License as ' published by the Free Software Foundation, either version 3 of ' the License, or (at your option) any later version. ' ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' ' You should have received a copy of the GNU General Public License ' along with this program. If not, see . '-------------------------------------------------------------- ' Author: Lane Beneke - Southern Piping Company ' Version: 2012.11.30 - Version 1.0 'Changelog: Initial release '-------------------------------------------------------------- ' Author: Lane Beneke - Southern Piping Company ' Version: 2012.12.05 - Version 1.1 'Changelog: Added functionality to scan log files for errors ' and warnings, adding them to the notification ' email message. This included... ' - changing email msg format to HTML ' - finding, opening, and reading log file '-------------------------------------------------------------- ' Author: Lane Beneke - Southern Piping Company ' Version: 2013.01.17 - Version 1.2 'Changelog: Added HideConsole variable and associated code. ' Added command line parser. '-------------------------------------------------------------- '-------------------------------------------------------------- ' CHANGE THE FOLLOWING VALUES AS APPROPRIATE Const HideConsole = True Const ExeFile = "C:\Program Files\FreeFileSync\FreeFileSync.exe" Const BatchFile = "C:\Program Files\FreeFileSync\SyncJob.ffs_batch" ' "BatchName" IN MSGSUBJECT REPLACED WITH BATCH FILE NAME LESS PATH AND EXTENSION Const MsgSubject = "FreeFileSync results for batch BatchName" Const MsgFrom = "FreeFileSync@Do.Not.Reply" Const MsgTo = "someone@yourdomain.tld" Const SMTPServer = "mail.yourdomain.tld" Const SMTPPort = 25 Const DoDebug = False '-------------------------------------------------------------- '-------------------------------------------------------------- ' CHANGE NOTHING FROM THIS POINT FORWARD Dim bHideConsole, sExeFile, sBatchFile, oMsg, dtExecutionTime Dim sLogFile, Args, i, j, ArgTemp, ArgLen, ArgFound, ArgErrors Set oMsg = CreateObject("CDO.Message") bHideConsole = HideConsole sExeFile = ExeFile sBatchFile = BatchFile oMsg.Subject = MsgSubject oMsg.From = MsgFrom oMsg.To = MsgTo oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPort oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'SendUsingPort Const sDashedLine = "--------------------------------------------------------------" Const sErrLogNotFound = "Unable to locate Log file for processing." Const sErrLogNotCfgrd = "No log file is configured for this batch." ' THESE VALUES MATCH THE EXIT CODES FOR THE FreeFileSync.exe PROGRAM Dim ExitCodeArray(3) ExitCodeArray(0) = "Synchronization completed successfully" ExitCodeArray(1) = "Synchronization completed with warnings" ExitCodeArray(2) = "Synchronization completed with errors" ExitCodeArray(3) = "Synchronization was aborted" ' PARSE THE COMMAND LINE Dim ArgArray(7,1) ArgArray(0,0) = "HideConsole" ArgArray(0,1) = "bHideConsole" ArgArray(1,0) = "ExeFile" ArgArray(1,1) = "sExeFile" ArgArray(2,0) = "BatchFile" ArgArray(2,1) = "sBatchFile" ArgArray(3,0) = "MsgSubject" ArgArray(3,1) = "oMsg.Subject" ArgArray(4,0) = "MsgFrom" ArgArray(4,1) = "oMsg.From" ArgArray(5,0) = "MsgTo" ArgArray(5,1) = "oMsg.To" ArgArray(6,0) = "SMTPServer" ArgArray(6,1) = "oMsg.Configuration.Fields.Item(""http://schemas.microsoft.com/cdo/configuration/smtpserver"")" ArgArray(7,0) = "SMTPPort" ArgArray(7,1) = "oMsg.Configuration.Fields.Item(""http://schemas.microsoft.com/cdo/configuration/smtpserverport"")" Set Args = WScript.Arguments ArgErrors = "" For i = 0 To Args.Count - 1 ArgFound = False For j = 0 To 7 ArgTemp = ArgArray(j,0) ArgLen = Len(ArgTemp) If UCase(ArgTemp) = Left(UCase(Args.Item(i)),ArgLen) Then 'Found our argument ArgFound = True If DoDebug Then WScript.Echo "Argument " & Args.Item(i) & " matches " & ArgArray(j,0) If Len(Args.Item(i)) > ArgLen And Mid(Args.Item(i),ArgLen+1,1) = "=" Then Execute( ArgArray(j,1) & " = " & "Mid(Args.Item(i),ArgLen+2)" ) If DoDebug Then WScript.Echo "Argument processed: " & ArgArray(j,1) & " = " & Mid(Args.Item(i),ArgLen+2) ElseIf Len(Args.Item(i)) = ArgLen Then i = i + 1 If Args.Item(i) = "=" Then i = i + 1 Execute( ArgArray(j,1) & " = " & "Args.Item(i)" ) If DoDebug Then WScript.Echo "Argument processed: " & ArgArray(j,1) & " = " & Args.Item(i) End If End If Next If Not ArgFound Then ArgErrors = ArgErrors & vbCrLf & "Error: Invalid Argument: " & Args.Item(i) Next If ArgErrors <> "" Then WScript.Echo "Unable to continue due to command line errors..." WScript.Echo ArgErrors WScript.Quit End If '-------------------------------------------------------------- ' BEGIN MAIN PROGRAM '-------------------------------------------------------------- If DoDebug Then WScript.Echo "Executing program: """ & sExeFile & """ """ & sBatchFile & """" Dim WshShell, sBatchName, iExitCode Set WshShell = WScript.CreateObject("WScript.Shell") dtExecutionTime = Now() 'MUST OCCUR IMMEDIATELY BEFORE PROGRAM EXECUTION iExitCode = WshShell.Run( """" & ExeFile & """ """ & sBatchFile & """", iif(bHideConsole,0,1), True ) If DoDebug Then WScript.Echo "Program execution completed with exitcode: " & iExitCode & " " & ExitCodeArray(iExitCode) ' ADD EXIT CODE DESCRIPTION TO EMAIL MESSAGE oMsg.HTMLBody = ExitCodeArray(iExitCode) ' IF WE DIDN'T COMPLETE SUCCESSFULLY, THEN SCAN FOR ERRORS AND WARNINGS sLogFile = GetLogFile If iExitCode <> 0 Then ' RETRIEVE LOG FILE FOLDER FROM ffs_batch FILE Dim objFS, objFil, sLine, DoRead If sLogFile = "" Then If DoDebug Then WScript.Echo sErrLogNotFound oMsg.HTMLBody = oMsg.HTMLBody & "

" & sErrLogNotFound ElseIf sLogFile = "None" Then If DoDebug Then WScript.Echo sErrLogNotCfgrd oMsg.HTMLBody = oMsg.HTMLBody & "

" & sErrLogNotCfgrd Else If DoDebug Then WScript.Echo "Scanning Log File" Set objFS = CreateObject("Scripting.FileSystemObject") Set objFil = objFS.OpenTextFile(sLogFile, 1) ' OPEN LOG FILE FOR READING DoRead = True Do Until objFil.AtEndOfStream if DoRead Then sLine = objFil.ReadLine DoRead = True If DoDebug Then WScript.Echo "Readline1 = " & sLine If InStr(sLine, "] Error:") > 0 _ Or InStr(sLine, "] Warning:") > 0 Then oMsg.HTMLBody = oMsg.HTMLBody & "

" & sLine If Not objFil.AtEndOfStream Then sLine = objFil.ReadLine If DoDebug Then WScript.Echo "Readline2 = " & sLine Do Until objFil.AtEndOfStream Or Left(sLine,1) = "[" oMsg.HTMLBody = oMsg.HTMLBody & "
" & sLine sLine = objFil.ReadLine If DoDebug Then WScript.Echo "Readline3 = " & sLine Loop DoRead = False End If End If Loop objFil.Close End If End If ' SEND THE EMAIL oMsg.Subject = Replace(oMsg.Subject, "BatchName", sBatchName) oMsg.Configuration.Fields.Update oMsg.Send If DoDebug Then WScript.Echo vbCrLf & sDashedLine WScript.Echo "Subject: " & oMsg.Subject WScript.Echo " From: " & oMsg.From WScript.Echo " To: " & oMsg.To WScript.Echo sDashedLine WScript.Echo oMsg.HTMLBody WScript.Echo sDashedLine WScript.Sleep 5000 'SLEEP 5 SECONDS FOR VIEWING BEFORE WINDOW CLOSES. End If '-------------------------------------------------------------- ' END MAIN PROGRAM - BEGIN FUNCTIONS AND SUBS '-------------------------------------------------------------- Function GetLogFileName Dim sLogFName sLogFName = Mid(sBatchFile,InStrRev(sBatchFile,"\")+1) sLogFName = Left(sLogFName,InStrRev(sLogFName,".")-1) sBatchName = sLogFName If DoDebug Then WScript.Echo "sBatchName = " & sBatchName sLogFName = sLogFName & " " & Year(dtExecutionTime) & "-" & ZeroPad(Month(dtExecutionTime),2) _ & "-" & ZeroPad(Day(dtExecutionTime),2) & " " & ZeroPad(Hour(dtExecutionTime),2) _ & ZeroPad(Minute(dtExecutionTime),2) & ZeroPad(Second(dtExecutionTime),2) & ".log" GetLogFileName = sLogFName End Function Function GetLogFile Dim objFSO, objFile, sLine, x, sLogFolder, colFiles Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile(sBatchFile, 1) ' OPEN BATCH FILE FOR READING sLine = "" Do Until objFile.AtEndOfStream Or sLine <> "" sLine = objFile.ReadLine If InStr( sLine, "LogfileFolder" ) Then 'FIND LINE CONTAINING LOG FILE FOLDER 'GET DATA BETWEEN FIRST GREATER THAN SIGN AND LAST LESS THAN SIGN x = InStr( sLine, ">" )+1 sLogFolder = Mid(sLine, x, InStr(x, sLine, "<" ) - x ) Else sLine = "" End If Loop objFile.Close Set objFile = Nothing If DoDebug Then WScript.Echo "Log File Folder = " & sLogFolder If sLine <> "" Then For x = 1 To 60 sLine = sLogFolder & "\" & GetLogFileName If objFSO.FileExists(sLine) Then Exit For 'INCREMENT THE EXECUTION TIME BY ONE SECOND dtExecutionTime = dtExecutionTime + 1.0/86400.0 sLine = "" Next Else sLine = "None" End If If DoDebug Then WScript.Echo "GetLogFile return value = " & sLine GetLogFile = sLine End Function Function ZeroPad( number, chars ) Dim sReturn sReturn = number sReturn = String(chars - Len(sReturn), "0") & sReturn ZeroPad = sReturn End Function Function iif( test, trueresult, falseresult ) If test Then iif = trueresult Else iif = falseresult End If End Function