Option Explicit '-------------------------------------------------------------- ' FreeFileSync.vbs '-------------------------------------------------------------- ' Runs FreeFileSync.exe with specified batch file. ' Sends email with status, errors, and warnings on completion. '-------------------------------------------------------------- ' Author: Lane Beneke - SPC Mechanical Corporation ' Date: 2016.04.07 ' 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-2016 Lane Beneke - SPC Mechanical Corporation ' ' 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. '-------------------------------------------------------------- ' Author: Lane Beneke - Southern Piping Company ' Version: 2014.01.27 - Version 1.3 'Changelog: Upgraded FreeFileSync program to ver 6.1. The new ' version changes the log file name, adding ' " (Error)" ahead of the extension. Changed the ' GetLogFile function to search old and new names. ' Also added constants IncludeErrorsInReport and ' IncludeWarningsInReport to allow user to specify ' what to include in email. '-------------------------------------------------------------- ' Author: Lane Beneke - Southern Piping Company ' Version: 2015.01.08 - Version 1.4 'Changelog: Found that my log-file-finding changes in 1.3 were ' incomplete. FFS may add any one of several things ' to the name of the log file including " (Error)" ' and " (Stopped)". So, I am now searching for log ' files regardless of what is appended to the log ' file name after the date. '-------------------------------------------------------------- ' Author: Lane Beneke - Southern Piping Company ' Version: 2015.02.02 - Version 1.5 'Changelog: The log may also contain "Serious Error" messages. ' Adjusted detection to include these. '-------------------------------------------------------------- ' Author: Lane Beneke - SPC Mechanical Corporation ' Version: 2015.04.03 - Version 1.6 'Changelog: Turns out the log file name may not include the ' date at all. Don't know what circumstances cause ' this, but it bit me when I upgraded to version 6.14. ' Rewrote the GetLogFile function to look for a file ' in the log file folder with a filesystem Date ' Created timestamp equal to FreeFileSync.exe's ' execution time +/- one second. '-------------------------------------------------------------- ' Author: Lane Beneke - SPC Mechanical Corporation ' Version: 2016.02.03 - Version 1.7 'Changelog: Added an option to include the name of the host ' server in the emailed report. In my case, I have ' several jobs running on multiple servers. ' Knowledge of which server reported is necessary. ' See the 'IncludeServerNameInReport' option. ' Also fixed bug for failure to detect no log file ' configured if exists but Limit=0. ' Also fixed a bug concerning the creation time of ' the log file. FreeFileSync previously created the ' log file at execution time. But now it isn't ' created until completion time. So, I now match ' either-or. '-------------------------------------------------------------- ' Author: Lane Beneke - SPC Mechanical Corporation ' Version: 2016.03.17 - Version 1.8 'Changelog: I'm still having occasions where the log file is ' not located. Turns out there can be a significant ' delay between when the log file is written and ' when the program terminates. So, now I'm looking ' for a creation time anywhere between program ' execution and program termination. '-------------------------------------------------------------- ' Author: Lane Beneke - SPC Mechanical Corporation ' Version: 2016.04.06 - Version 1.9 'Changelog: Trouble with emails not delivering lately. Added ' code to detect email send failure, and retry ' MaxEmailSendAttempts times. '-------------------------------------------------------------- ' Author: Lane Beneke - SPC Mechanical Corporation ' Version: 2016.04.07 - Version 1.10 'Changelog: Bug fix: A math error (using CInt() where I should ' have used Fix()) was causing the script to end ' prematurely in some cases. This may have also ' caused inaccurate reporting of elapsed times. ' While at it, I added user requested variables for ' smtp authentication. '-------------------------------------------------------------- '-------------------------------------------------------------- ' YOU MUST CHANGE THE FOLLOWING VALUES AS APPROPRIATE Const HideConsole = True ' LEAVE ExeFile BLANK TO USE CURRENT WORKING DIRECTORY ' OTHERWISE SET TO FULL PATH OF FreeFileSync.exe Const ExeFile = "" ' SET TO PATH OF [somebatchfile].ffs_batch ' IF BLANK AND NO COMMAND LINE ARGUMENT, THEN SCRIPT EXITS Const BatchFile = "" ' "BatchName" IN MSGSUBJECT IS REPLACED WITH BATCH FILE ' NAME LESS PATH AND EXTENSION Const MsgSubject = "FreeFileSync results for batch BatchName" Const MsgFrom = "FreeFileSync@Do.Not.Reply" Const MsgTo = "recipient@yourdomain.com" Const SMTPServer = "yourserver.yourdomain.tld" ' SMTPAuth 0=off, 1=clear text, 2=NTLM. IF YOU SET THIS ' TO 1, THEN YOU MUST ALSO SET THE SMTPUSERNAME AND ' SMTPPASSWORD FIELDS. Const SMTPAuth = 0 Const SMTPPort = 25 Const SMTPUsername = "your.smtp.username" Const SMTPPassword = "your.smtp.password" ' THE SCRIPT WILL ATTEMPT TO SEND THE MESSAGE MaxEmailSendAttempts ' TIMES BEFORE GIVING UP. IF THE MESSAGE FAILS TO SEND, THE ' SCRIPT WILL SET THE DOS ERRORLEVEL TO 1 UPON EXIT. Const MaxEmailSendAttempts = 10 Const SleepSecondsBeforeRetryingEmailSend = 301 ' DoDebug CAUSES DIAGNOSTIC OUTPUT TO BE WRITTEN TO THE ' CONSOLE. NOTE THAT WSCRIPT.EXE USES DIALOG BOXES FOR ' OUTPUT. SO USE CSCRIPT.EXE WHEN DODEBUG IS TRUE. Const DoDebug = False ' IF DODEBUG IS TRUE, AND THE SHELL IS EXECUTED FROM A SCHEDULE ' OR SOME OTHER PROCESS, THEN THE VALUE BELOW WILL DELAY CLOSING ' OF THE WINDOW SO YOU CAN EXAMINE THE DEBUG OUTPUT. Const SleepSecondsBeforeClosingShell = 15 Const IncludeErrorsInReport = True Const IncludeWarningsInReport = True Const IncludeRuntimeStringInReport = True Const IncludeRuntimeNumbersInReport = False Const IncludeServerNameInReport = True '-------------------------------------------------------------- '-------------------------------------------------------------- ' CHANGE NOTHING FROM THIS POINT FORWARD Dim bHideConsole, sExeFile, sBatchFile, dtExecutionTime, dtCompletionTime Dim oMsg, fso, sLogFile, Args, i, j, ArgTemp, ArgLen, ArgFound, ArgErrors Set oMsg = CreateObject("CDO.Message") Set fso = CreateObject("Scripting.FileSystemObject") 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/smtpauthenticate") = SMTPAuth 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 oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = SMTPUsername oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = SMTPPassword 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(10,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) = "SMTPAuth" ArgArray(7,1) = "oMsg.Configuration.Fields.Item(""http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"")" ArgArray(8,0) = "SMTPPort" ArgArray(8,1) = "oMsg.Configuration.Fields.Item(""http://schemas.microsoft.com/cdo/configuration/smtpserverport"")" ArgArray(9,0) = "SMTPUsername" ArgArray(9,1) = "oMsg.Configuration.Fields.Item(""http://schemas.microsoft.com/cdo/configuration/sendusername"")" ArgArray(10,0) = "SMTPPassword" ArgArray(10,1) = "oMsg.Configuration.Fields.Item(""http://schemas.microsoft.com/cdo/configuration/sendpassword"")" Set Args = WScript.Arguments ArgErrors = "" For i = 0 To Args.Count - 1 ArgFound = False For j = 0 To UBound(ArgArray,1) 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 sExeFile = "" Then sExeFile = ".\FreeFileSync.exe" If Not fso.FileExists(sExeFile) Then WScript.Echo "Error: Cannot find executable file " & sExeFile WScript.Quit End If 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( """" & sExeFile & """ """ & sBatchFile & """", iif(bHideConsole,0,1), True ) dtCompletionTime = Now() 'MUST OCCUR IMMEDIATELY AFTER PROGRAM COMPLETION If DoDebug Then WScript.Echo "Program execution start time was " & dtExecutionTime WScript.Echo "Program execution completed with exitcode: " & iExitCode & " " & ExitCodeArray(iExitCode) WScript.Echo "Program execution finish time was " & dtCompletionTime End If ' ADD SERVER NAME AND BATCH NAME TO BODY OF EMAIL MESSAGE If IncludeServerNameInReport Then oMsg.HTMLBody = "FreeFileSync batch " & GetBatchName & " running on " _ & WshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" ) & "
" End If ' ADD EXIT CODE DESCRIPTION TO EMAIL MESSAGE oMsg.HTMLBody = oMsg.HTMLBody & ExitCodeArray(iExitCode) & "

" ' ADD RUNTIME TO EMAIL MESSAGE If IncludeRuntimeStringInReport Or IncludeRuntimeNumbersInReport Then Dim strElapsed, strElapsedNum, Elapsed, TimeArray strElapsed = "" strElapsedNum = "" Elapsed = DateDiff("s", dtExecutionTime, dtCompletionTime) If DoDebug Then WScript.Echo "Program elapsed seconds = " & Elapsed TimeArray = Array("Week",604800,"Day",86400,"Hour",3600,"Minute",60,"Second",1) For i = 0 To 9 Step 2 j = Fix(Elapsed / TimeArray(i+1)) strElapsedNum = strElapsedNum & Lpad(j,"0",2) & ":" If j >= 1 Then strElapsed = strElapsed & j & " " & TimeArray(i) & iif(j>1,"s "," ") Elapsed = Elapsed - (j * TimeArray(i+1)) Next i = Len(strElapsedNum) strElapsedNum = Mid(strElapsedNum,1,i-10) & " " & Mid(strElapsedNum,i-8,8) If strElapsed = "" Then strElapsed = "0 seconds " If DoDebug Then WScript.Echo "Elapsed Time String = " & strElapsed WScript.Echo "Elapsed Numb String = " & strElapsedNum End If If IncludeRuntimeStringInReport Then oMsg.HTMLBody = oMsg.HTMLBody & "Duration: " & strElapsed & "

" If IncludeRuntimeNumbersInReport Then oMsg.HTMLBody = oMsg.HTMLBody & "Duration: " & strElapsedNum & "

" End If ' RETRIEVE LOG FILE FOLDER FROM ffs_batch FILE sLogFile = GetLogFile If sLogFile = "None" Then If DoDebug Then WScript.Echo sErrLogNotCfgrd oMsg.HTMLBody = oMsg.HTMLBody & "

" & sErrLogNotCfgrd End If ' IF WE DIDN'T COMPLETE SUCCESSFULLY, THEN SCAN FOR ERRORS AND WARNINGS If iExitCode <> 0 Then Dim objFS, objFil, sLine, DoRead If sLogFile = "" Then If DoDebug Then WScript.Echo sErrLogNotFound oMsg.HTMLBody = oMsg.HTMLBody & "

" & sErrLogNotFound 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 _ Or InStr(sLine, "] Serious Error:") > 0 Then If ( InStr(sLine, "] Error:" ) > 0 And IncludeErrorsInReport ) Or _ ( InStr(sLine, "] Warning:" ) > 0 And IncludeWarningsInReport ) Or _ ( InStr(sLine, "] Serious Error:") > 0 And IncludeErrorsInReport ) Then oMsg.HTMLBody = oMsg.HTMLBody & "

" & sLine End If 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, RETRY ON FAILURE oMsg.Subject = Replace(oMsg.Subject, "BatchName", GetBatchName) oMsg.Configuration.Fields.Update Dim LastSendError, SendAttemptCount SendAttemptCount = 0 Do SendAttemptCount = SendAttemptCount + 1 If DoDebug Then WScript.Echo "Attempting Message Send" On Error Resume Next oMsg.Send LastSendError = Err.Number Err.Clear On Error Goto 0 If LastSendError = 0 And 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 Replace(oMsg.HTMLBody, "
", vbCrLf) WScript.Echo sDashedLine Else 'MESSSAGE FAILED TO SEND If DoDebug Then WScript.Echo "Email send failed, sleeping " _ & SleepSecondsBeforeRetryingEmailSend & " seconds before retry." 'SLEEP BEFORE ATTEMPTING AGAIN WScript.Sleep SleepSecondsBeforeRetryingEmailSend * 1000 End If Loop While LastSendError <> 0 And SendAttemptCount < MaxEmailSendAttempts 'IF DEBUGGING SLEEP FOR VIEWING BEFORE WINDOW CLOSES. If DoDebug Then WScript.Echo "Sleeping " & SleepSecondsBeforeClosingShell & " seconds before exiting." WScript.Sleep SleepSecondsBeforeClosingShell * 1000 End If If LastSendError <> 0 Then WScript.Quit(1) '-------------------------------------------------------------- ' END MAIN PROGRAM - BEGIN FUNCTIONS AND SUBS '-------------------------------------------------------------- Function GetBatchName Dim sName sName = Mid(sBatchFile,InStrRev(sBatchFile,"\")+1) sName = Left(sName,InStrRev(sName,".")-1) GetBatchName = sName If DoDebug Then WScript.Echo "GetBatchName return value = " & sName End Function Function GetLogFile Dim objFile, sLine, x, sLogFolder, colFiles, sLogFileName, dtSavedExecutionTime Set objFile = fso.OpenTextFile(sBatchFile, 1) ' OPEN BATCH FILE FOR READING 'RETRIEVE THE LOG FILE FOLDER FROM THE BATCH FILE sLine = "" Do Until objFile.AtEndOfStream Or sLine <> "" sLine = objFile.ReadLine If InStr( sLine, "LogfileFolder" ) Then 'FIND LINE CONTAINING LOG FILE FOLDER 'IF NUMBER OF LOG FILES LIMIT IS SET TO 0, THEN NO LOG FILE WILL BE GENERATED If InStr( sLine, "Limit=""0""" ) Then GetLogFile="None" Exit Function End If '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 'LOOP THROUGH LOG FILES LOOKING FOR CREATED AT OUR START TIME If sLine <> "" Then Dim f, f1, fc Set f = fso.GetFolder(sLogFolder) Set fc = f.Files For Each f1 in fc 'FOR EACH FILE IN THE LOGS FOLDER If DoDebug Then WScript.Echo f1.Name & " was created " & f1.DateCreated If ( f1.DateCreated > dtExecutionTime - (1.0/86400)) And _ ( f1.DateCreated < dtCompletionTime + (1.0/86400)) Then sLine = f1.Path Else sLine = "" End If If sLine <> "" Then Exit For Next Else sLine = "None" End If If DoDebug Then WScript.Echo "GetLogFile return value = " & sLine GetLogFile = sLine End Function Function ZeroPad( number, chars ) ZeroPad = String(chars - Len(number), "0") & number End Function Function iif( test, trueresult, falseresult ) If test Then iif = trueresult Else iif = falseresult End Function Function Lpad (inputStr, padChar, lengthStr) Lpad = string(lengthStr - Len(inputStr),padChar) & inputStr End Function