|
Thanks much for this script. It's very good. I have a question though. How can I make it only backup the previous day's files and folders? Any assistance is appreciated.
Thanks
|
|
|
|
|
|
I created a modified version and I think everyone can benefit from it
Major changes include a more scheduled task launch that does not use an IE object
Also I added a field to backup a database
MSSQL:servername:NorthWind
I hope it helps people.
#dbsettings.config
#####################################
# Dated Backup Classic(c) v.1.5 #
# #
# Author: Brian Velde #
# brian@antidesign.us #
# Modified by: Joseph P. Cohen #
############################################################################
# DIRECTIONS: #
# #
# Enter folders to backup, one per line. #
# Enclose complete path to each folder in quotes. #
# The destination folder name MUST be specified in the manner noted below. #
# (e.g "<path_to_folder>";<dest_folder_name>) - no spaces, UNC path OK. #
# Configure backup specific options below. #
############################################################################
#
@ TARGET_DIRECTORY_FOR_BACKUPS = \\servername\c$\$backup_files$
@ TARGET_LOG_FILE_DIR = c:\$backup_files$\logs
@ MAX_PERCENT_OF_FREE_SPACE = 20
@ DAYS_TO_KEEP_BACKUPS = 10
#####################################
# E-Mail settings. *OPTIONAL* #
#####################################
# yes or no
@ ENABLE_EMAIL_REPORTING = yes
@ EMAIL_TITLE = BUSDM-SALUDB BACKUP
@ EMAIL_ADDRESS_FOR_REPORTING = email@server.com
@ SENDING_EMAIL_ADDRESS = email@server.com
@ SMTP_SERVER_NAME = smtp.server.com
@ SMTP_SERVER_PORT = 25
@ SMTP_SERVER_USE_AUTHENTICATION = no
@ SMTP_SERVER_USERNAME = username
@ SMTP_SERVER_PASSWORD = password
@ SMTP_SERVER_USE_SSL = yes
#####################################
# Enter folders to backup below.. #
#####################################
#"c:\DELL";DELL
#"c:\remote";Remote
"c:\Dev-Cpp";Dev-Cpp
#MSSQL:servername:NorthWind
#MSSQL:ServerName2:NorkhWind2
'DatedBackup.vbs
selectionFile = "c:\$BACKUP$\dbsettings.config"
Dim strDate
Dim i
Dim arrSelect(30)
Dim objExplorer
Dim totSize
Dim parentPath
Dim strPercent
Dim logPath
Dim startTime
Dim endTime
Dim fldrDays
Dim strUseEmailReporting
Dim strReportEmail
Dim strSendingEmail
Dim strSmtpServer
Dim strSmtpPort
Dim strSmtpAuth
Dim strSmtpUser
Dim strSmtpPass
Dim strSmtpSsl, appName, version, installer
Dim logFile
Dim strEmailTitle
appName = "DatedBackup"
version = "2.0"
totSize = 0
' Added SQL backup support - Joseph P. Cohen
Function cleanOld()
Set fso = CreateObject("Scripting.FileSystemObject")
Set rf = fso.GetFolder(parentPath)
Set fsub = rf.SubFolders
For Each fldr In fsub
diff = Date() - fldr.DateLastModified
If diff > fldrDays And Not fldr.Name = "logs" Then ' # is Days should be >
fldr.Delete
End If
Next
End Function
Sub setstrDate()
strDay = Day(Date)
If Len(strDay) < 2 Then
strDay = 0 & strDay
End If
strMonth = Month(Date)
If Len(strMonth) < 2 Then
strMonth = 0 & strMonth
End If
strYear = Year(Date)
strTime = Time()
strTime = Replace(strTime,":","")
strTime = Replace(strTime," ","")
strDate = strYear & strMonth & strDay & "-" & strTime
End Sub
Function createFolder()
Set fso = CreateObject("scripting.filesystemobject")
If fso.FolderExists(parentPath & "\" & strDate) Then
intMsg = MsgBox("Backup appears to have already run. Run again?",vbYesNo,"Run backup again?")
If intMsg = vbNo Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Backup Failed! - Canceled by user... Destination Folder Exists..."
WScript.Quit(2)
End If
Else
fso.CreateFolder(parentPath & "\" & strDate)
End If
End Function
'checked-joe
Function readSelections()
Set fso = CreateObject("scripting.filesystemobject")
Set objlist = fso.OpenTextFile(selectionFile)
i=0
Do Until objList.AtEndOfStream
tmp = objList.ReadLine
If Left(tmp,1) = "#" Or left(tmp,1) = "" Then 'find comments
Else
If Left(tmp,1) = "@" Then
If Left(tmp,23) = "@ TARGET_LOG_FILE_DIR =" Then
ol = Len(tmp)
logPath = Right(tmp,(ol-24))
logPath = Trim(logPath)
ElseIf Left(tmp,24) = "@ DAYS_TO_KEEP_BACKUPS =" Then
ol = Len(tmp)
fldrDays = Right(tmp,(ol-25))
fldrDays = Trim(fldrDays)
fldrDays = Int(fldrDays)
ElseIf Left(tmp,29) = "@ MAX_PERCENT_OF_FREE_SPACE =" Then
ol = Len(tmp)
strPercent = Right(tmp,ol-30)
strPercent = Trim(strPercent)
strPercent = Int(strPercent)
ElseIf Left(tmp,32) = "@ TARGET_DIRECTORY_FOR_BACKUPS =" Then
ol = Len(tmp)
parentPath = Right(tmp,(ol-32))
parentPath = Trim(parentPath)
ol = Len(parentPath)
If Not fso.FolderExists(parentPath) = True Then
'intMsg = MsgBox("Destination folder (" & parentPath & ") does not exist!. Do you wish to create it?",vbYesNo,"Create destination folder?")
'If intMsg = vbYes Then
Set folder = fso.CreateFolder(parentPath)
If fso.FolderExists(parentPath) = True Then
Else
wscript.echo "Failed to create backup folder! Exiting..."
WScript.Quit(666)
End If
'Else
'writeToLog "Aborting..."
'WScript.Quit(333)
'End If
End If
ElseIf Left(tmp,31) = "@ EMAIL_ADDRESS_FOR_REPORTING =" Then
ol = Len(tmp)
strReportEmail = Right(tmp,(ol-31))
strReportEmail = Trim(strReportEmail)
ElseIf Left(tmp,25) = "@ SENDING_EMAIL_ADDRESS =" Then
ol = Len(tmp)
strSendingEmail = Right(tmp,(ol-25))
strSendingEmail = Trim(strSendingEmail)
ElseIf Left(tmp,15) = "@ EMAIL_TITLE =" Then
ol = Len(tmp)
strEmailTitle = Right(tmp,(ol-15))
strEmailTitle = Trim(strEmailTitle)
ElseIf Left(tmp,20) = "@ SMTP_SERVER_NAME =" Then
ol = Len(tmp)
strSmtpServer = Right(tmp,(ol-20))
strSmtpServer = Trim(strSmtpServer)
ElseIf Left(tmp,26) = "@ ENABLE_EMAIL_REPORTING =" Then
ol = Len(tmp)
strUseEmailReporting = Right(tmp,(ol-26))
strUseEmailReporting = Trim(strUseEmailReporting)
strUseEmailReporting = LCase(strUseEmailReporting)
ElseIf Left(tmp,20) = "@ SMTP_SERVER_PORT =" Then
ol = Len(tmp)
strSmtpPort = Right(tmp,(ol-20))
strSmtpPort = Trim(strSmtpPort)
ElseIf Left(tmp,34) = "@ SMTP_SERVER_USE_AUTHENTICATION =" Then
ol = Len(tmp)
strSmtpAuth = Right(tmp,(ol-34))
strSmtpAuth = Trim(strSmtpAuth)
strSmtpAuth = LCase(strSmtpAuth)
ElseIf Left(tmp,24) = "@ SMTP_SERVER_USERNAME =" Then
ol = Len(tmp)
strSmtpUser = Right(tmp,(ol-24))
strSmtpUser = Trim(strSmtpUser)
ElseIf Left(tmp,24) = "@ SMTP_SERVER_PASSWORD =" Then
ol = Len(tmp)
strSmtpPass = Right(tmp,(ol-24))
strSmtpPass = Trim(strSmtpPass)
ElseIf Left(tmp,23) = "@ SMTP_SERVER_USE_SSL =" Then
ol = Len(tmp)
strSmtpSsl = Right(tmp,(ol-23))
strSmtpSsl = Trim(strSmtpSsl)
strSmtpSsl = LCase(strSmtpSsl)
End If
Else
arrSelect(i) = tmp
i = i + 1
End If 'line starts with "@"
End If ' line starts with "#" or " "
Loop
End Function
Function backup()
set sh = CreateObject("wscript.Shell")
For x=0 To (i-1)
If Not arrSelect(x) = "" Then
If Left(arrSelect(x),6) = "MSSQL:" then
' remove the header part and read the rest
tempStr = Right(arrSelect(x),Len(arrSelect(x))-InStr(arrSelect(x),":"))
strDBServerName = left(tempStr,InStr(tempStr,":")-1)
strDB = Right(tempStr,Len(tempStr) - InStr(2,tempStr,":"))
strTargetFolder = parentPath & "\" & strDate & "\" & strDBServerName & "_" & strDB
backupMSSQLserver strDBServerName, strDB, strTargetFolder
Else If Left(arrSelect(x),6) = "MYSQL:" then
' remove the header part and read the rest
tempStr = Right(arrSelect(x),Len(arrSelect(x))-InStr(arrSelect(x),":"))
strDBServerName = left(tempStr,InStr(tempStr,":")-1)
strDB = Right(tempStr,Len(tempStr) - InStr(2,tempStr,":"))
strTargetFolder = parentPath & "\" & strDate & "\" & strDBServerName & "_" & strDB
backupMYSQLserver strDBServerName, strDB, strTargetFolder
else
'this is the default action
strTarget = arrSelect(x)
ol = Len(strTarget)
dlm = InStr(strTarget,";")
nm = ol - dlm
fldrName = Trim(Right(strTarget,nm))
strTarget = Trim(Left(strTarget,(dlm-1)))
strBkUp = "xcopy /s /c /d /e /h /i /r /k /y "
'writeToLog "Backing up to: " & strTarget & " " & parentPath & "\" & strDate & "\" & fldrName & "\"
strCommand = strBkUp & strTarget & " " & Chr(34) & parentPath & "\" & strDate & "\" & fldrName & "\" & Chr(34)
Set fso = CreateObject("scripting.filesystemobject")
tgtL = Len(strTarget)
tgt = Right(strTarget,tgtL-1)
tgtL = Len(tgt)
tgt = Left(tgt,tgtL-1)
Set f = fso.GetFolder(tgt)
sze = f.Size
sze = sze / 1024 / 1024 ' to MB
sze = FormatNumber(sze,2) ' cut at 2 decimal place
totSize = totSize + sze
writeToLog "Backing up folder: " & strTarget & " - " & sze & " MB"
runBkup = sh.run("%comspec% /c" & strCommand,0,True) ' 0-hide the window(s), True-Copy one folder at a time
End if
End If 'if sql
End If
Next
End Function
Function backupMSSQLserver(strDBServerName, strDB, strTargetFolder)
'Joseph P. Cohen
'extern strDate, writeToLog
On Error Resume next
writeToLog "Backing up MSSQL at: " & vbcrlf & _
" Server = " & strDBServerName & vbcrlf & _
" Database = " & strDB & vbcrlf & _
" Target File = " & strTargetFolder & "_backup_" & strDate & ".bak'"
strBAKcmd = "backup database " & strDB & " to disk = " & "'" & strTargetFolder & "_backup_" & strDate & ".bak'" & " with init"
Set oConn = CreateObject("ADODB.Connection")
StrConnect = "Driver={SQL Server};Server=" & strDBServerName & ";"
Err.Clear
oConn.Open StrConnect
If Not Err.Number = 0 Then
writeToLog "Connect = Error: Can not connect to server " & Err.Number & " " & Err.Description
Else
writeToLog "Connected to Server running backup command..."
Set oRS = CreateObject("ADODB.Recordset")
oConn.CommandTimeout = 0
oRS.Open strBAKcmd, oConn
If Not Err.Number = 0 Then
writeToLog "Error running backup command " & Err.Number & " " & Err.Source & " " & Err.Description
Else
writeToLog "Backup command sent..."
End if
End if
On Error Goto 0
End Function
Function backupMYSQLserver(strDBServerName, strDB, strTargetFolder)
WScript.Echo "this function does not work"
WScript.Quit(000)'
'Joseph P. Cohen... this function is GOOD ENOUGH .. more time should be spent here.
'extern strDate, writeToLog
On Error Resume next
writeToLog "Backing up MSSQL at: " & vbcrlf & _
" Server = " & strDBServerName & vbcrlf & _
" Database = " & strDB & vbcrlf & _
" Target File = " & strTargetFolder & "_backup_" & strDate & ".bak'"
strBAKcmd = "backup database " & strDB & " to disk = " & "'" & strTargetFolder & "_backup_" & strDate & ".bak'" & " with init"
Set oConn = CreateObject("ADODB.Connection")
StrConnect = "Driver={MySQL ODBC 3.51 Driver};Server=" & strDBServerName & ";User=root;"
Err.Clear
oConn.Open StrConnect
If Not Err.Number = 0 Then
writeToLog "Connect = Error: Can not connect to server " & Err.Number & " " & Err.Description
Else
writeToLog "Connected to Server running backup command..."
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open strBAKcmd, oConn
If Not Err.Number = 0 Then
writeToLog "Error running backup command " & Err.Number & " " & Err.Source & " " & Err.Description
Else
writeToLog "Backup command sent..."
End if
End if
On Error Goto 0
End Function
Function sendMail()
Dim fso, logf
Set fso = CreateObject("scripting.filesystemobject")
'WScript.Echo logPath & "\backup" & strDate & ".html"
Set objMessage = CreateObject("CDO.Message")
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'use '1' for local SMTP
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSmtpPort
If strSmtpAuth = "yes" Then
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'use '2' for NTLM authentication
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSmtpUser
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSmtpPass
End If
If strSmtpSsl = "yes" Then
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End If
objMessage.Configuration.Fields.Update
If InStr(fso.OpenTextFile(logPath & "\backup" & strDate & ".txt",1).ReadAll(),"Error") = 0 Then
objMessage.Subject = strEmailTitle & " completed successfully on " & strDate & "."
Else
objMessage.Subject = strEmailTitle & " HAD ERRORS!! " & strDate & "."
objMessage.Fields("urn:schemas:httpmail:importance").Value = 2
End If
objMessage.From = strSendingEmail
objMessage.To = strReportEmail
objMessage.HTMLBody = Replace(fso.OpenTextFile(logPath & "\backup" & strDate & ".txt",1).ReadAll(),vbCrLf,"<br>")
'objMessage.AddAttachment = logPath & "\backup" & strDate & ".html"
objMessage.Send
End Function
Function auditDays()
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(parentPath & "\" & strDate) Then
Set cur = fso.GetFolder(parentPath & "\" & strDate)
Set objParent = fso.GetFolder(parentPath)
Set objWMIService = GetObject("winmgmts:")
If Left(parentPath,2) = "\\" Then
' Network Drive, we need the root share name
Dim temp
temp = InStr(parentPath,"\")
temp = InStr(temp+1, parentPath,"\")
temp = InStr(temp+1, parentPath,"\")
temp = InStr(temp+1, parentPath,"\")
tgtDrive = Left(parentPath, temp-1)
Else
' local drive, we need root letter
tgtDrive = Left(parentPath,1) 'find target drive letter
End if
Dim fso
Set fso = CreateObject("scripting.filesystemobject")
'This change allows the lookup of SMB drives
Set objLogicalDisk = fso.GetDrive(tgtDrive)
absFree = objLogicalDisk.FreeSpace
parSize = objParent.Size
curSize = cur.Size
If curSize = 0 Then
writeToLog "Error: Did not back up anything!!!"
else
curSize = curSize / 1024 / 1024 'MB
curSize = FormatNumber(curSize,2)
curSize = Int(curSize)
'absolute free space
free = absFree + parSize
free = (free * (strPercent / 100))
free = free / 1024 / 1024 'MB
free = FormatNumber(free,0)
backups = free / curSize
backups = FormatNumber(backups,0)
backups = Int(backups)
fldrDays = Int(fldrDays)
writeToLog"You can perform " & backups & " backups before drive " & strPercent & "% full!"
If (backups < fldrDays) Then
writeToLog "ERROR in c:\$backup$\dbsettings.config!"
writeToLog "Value entered for DAYS_TO_KEEP_BACKUPS is invalid. Due to the space limitations" _
& "of your hard drive, DAYS_TO_KEEP_BACKUPS can be no more than '" & backups & "' ! Please fix this."
Else
writeToLog "You have enough disk space remaining for " & backups & " more backups."
End If
End If ' test for curSize if 0
Else
WScript.Echo "Error: Cannot Find Folder! Did the backup run?"
End If
End Function
Sub writeToLog(str)
' var is logFile
If IsEmpty(logFile) Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set rf = fso.GetFolder(parentPath)
If Not fso.FolderExists(logPath) Then
fso.CreateFolder(logPath)
End If
Set lf = fso.GetFolder(logPath)
'ol = Len(strDate)
'strDate = Right(strDate,ol-1)
Set logFile = lf.CreateTextFile("backup" & strDate & ".txt",True)
writeToLog "=============================================="
writeToLog "Dated Backup Classic(c) v.1.5"
writeToLog "Original code Brian Velde <brian@antidesign.us>"
writeToLog "Modified by Joseph P. Cohen"
writeToLog "Backup log for " & strDate & ""
End If
logFile.write str & vbcrlf
End Sub
startTime = Timer()
setstrDate()
If Not readSelections() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Error: Backup Failed! - Incorrect Selection File Syntax!"
msgbox "Error: Backup Failed! - Incorrect Selection File Syntax!"
WScript.Quit(1)
End If
writeToLog "Backup Started at: " & Date() & " " & Time()
writeToLog "Reading backup selections..."
writeToLog "Cleaning up old files..."
If not cleanOld() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Error: Backup Failed! - Unable to Remove Old Backup Folders!"
writeToLog "Error: Backup Failed! - Unable to Remove Old Backup Folders!"
WScript.Quit(1)
End If
writeToLog "Creating destination folder..."
If not createFolder() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Error: Backup Failed! - Unable To Create Destination Folder!"
writeToLog "Error: Backup Failed! - Unable To Create Destination Folder!"
WScript.Quit(1)
End If
writeToLog "Starting backup..."
If Not backup() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Backup Failed! - Errors Encountered During the Backup Process!"
writeToLog "Backup Failed! - Errors Encountered During the Backup Process!"
WScript.Quit(1)
End If
endTime = Timer()
totTime = endTime - startTime
If totTime < 60 Then
totTime = FormatNumber(totTime,2)
count = "seconds."
ElseIf totTime < 3600 Then
totTime = totTime / 60
totTime = FormatNumber(totTime,2)
count = "minutes."
ElseIf totTime > 3600 Then
totTime = totTime / 60 / 60
totTime = FormatNumber(totTime,2)
count = "hours."
End If
writeToLog "Backup Completed at: " & Date() & " " & Time() & " - " & FormatNumber(totSize,2) & " MB" & vbcrlf & "Elapsed Time: " & totTime & " " & count
Call auditDays()
logFile.Close()
If strUseEmailReporting = "yes" Then
Call sendMail()
End If
If curSize = 0 Then
WScript.Quit(1)
End if
WScript.Quit(0)
|
|
|
|
|
Great edit! I have taken your edit and added Zip support. You have to have the 7zip command line utility in the same directory as the script and you no longer have to specify the path to the config file.
The package with 7zip can be downloaded HERE.[^]
dbsettings.config
#####################################
# Dated Backup Classic(c) v.1.5 #
# #
# Author: Brian Velde #
# brian@antidesign.us #
# Modified by: Joseph P. Cohen #
# Modified by: Neal T. Bailey #
############################################################################
# DIRECTIONS: #
# #
# Enter folders to backup, one per line. #
# Enclose complete path to each folder in quotes. #
# The destination folder name MUST be specified in the manner noted below. #
# ( e.g "<path_to_folder>";<dest_folder_name> ) - no spaces #
# Configure backup specific options below. #
############################################################################
#
@ TARGET_DIRECTORY_FOR_BACKUPS = \\baileyfs01\Files\Uploads\backup
@ TARGET_LOG_FILE_DIR = c:\backup
@ MAX_PERCENT_OF_FREE_SPACE = 20
@ DAYS_TO_KEEP_BACKUPS = 10
@ CREATE_ZIP_ARCHIVE = yes
#####################################
# E-Mail settings. *OPTIONAL* #
#####################################
# yes or no
@ ENABLE_EMAIL_REPORTING = no
@ EMAIL_TITLE = BUSDM-SALUDB BACKUP
@ EMAIL_ADDRESS_FOR_REPORTING = email@server.com
@ SENDING_EMAIL_ADDRESS = email@server.com
@ SMTP_SERVER_NAME = smtp.server.com
@ SMTP_SERVER_PORT = 25
@ SMTP_SERVER_USE_AUTHENTICATION = no
@ SMTP_SERVER_USERNAME = username
@ SMTP_SERVER_PASSWORD = password
@ SMTP_SERVER_USE_SSL = yes
#####################################
# Enter folders to backup below.. #
#####################################
#"c:\DELL";DELL
#"c:\remote";Remote
"C:\Inetpub\wwwroot\music\App_Data";mp3cms-db
#MSSQL:servername:NorthWind
#MSSQL:ServerName2:NorkhWind2
datedBackup.vbs
Dim selectionFile
Dim strDate
Dim i
Dim arrSelect(30)
Dim objExplorer
Dim totSize
Dim parentPath
Dim strPercent
Dim logPath
Dim startTime
Dim endTime
Dim fldrDays
Dim strUseEmailReporting
Dim strReportEmail
Dim strSendingEmail
Dim strSmtpServer
Dim strSmtpPort
Dim strSmtpAuth
Dim strSmtpUser
Dim strSmtpPass
Dim strSmtpSsl, appName, version, installer
Dim logFile
Dim strEmailTitle
Dim strCreateZip
appName = "DatedBackup"
version = "2.0"
totSize = 0
' Added SQL backup support - Joseph P. Cohen
' Added Zip backup support - Neal T. Bailey
Function cleanOld()
Set fso = CreateObject("Scripting.FileSystemObject")
Set rf = fso.GetFolder(parentPath)
Set fsub = rf.SubFolders
For Each fldr In fsub
diff = Date() - fldr.DateLastModified
If diff > fldrDays And Not fldr.Name = "logs" Then ' # is Days should be >
fldr.Delete
End If
Next
End Function
Sub setstrDate()
strDay = Day(Date)
If Len(strDay) < 2 Then
strDay = 0 & strDay
End If
strMonth = Month(Date)
If Len(strMonth) < 2 Then
strMonth = 0 & strMonth
End If
strYear = Year(Date)
strTime = Time()
strTime = Replace(strTime,":","")
strTime = Replace(strTime," ","")
strDate = strYear & strMonth & strDay & "-" & strTime
End Sub
'Neal Bailey: 06/27/09
Function getWorkingDirectory()
aScriptFilename = Split(Wscript.ScriptFullName, "\")
sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
getWorkingDirectory = sWorkingDirectory
End Function
'Neal Bailey: 06/27/09
Function Zip(sFolder,sArchiveName)
Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set oShell = WScript.CreateObject("Wscript.Shell")
sWorkingDirectory = getWorkingDirectory
If oFSO.FileExists(sWorkingDirectory & "\" & "7za.exe") Then
s7zLocation = ""
ElseIf oFSO.FileExists("C:\Program Files\7-Zip\7za.exe") Then
s7zLocation = "C:\Program Files\7-Zip\"
Else
writeToLog("Error: Couldn't find 7za.exe")
Exit Function
End If
oShell.Run """" & s7zLocation & "7za.exe"" a -tzip -y """ & sArchiveName & """ " & sFolder, 0, True
If oFSO.FileExists(sArchiveName) Then
Zip = 0
Else
Zip = 1
End If
End Function
Function createFolder()
Set fso = CreateObject("scripting.filesystemobject")
If fso.FolderExists(parentPath & "\" & strDate) Then
intMsg = MsgBox("Backup appears to have already run. Run again?",vbYesNo,"Run backup again?")
If intMsg = vbNo Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Backup Failed! - Canceled by user... Destination Folder Exists..."
WScript.Quit(2)
End If
Else
fso.CreateFolder(parentPath & "\" & strDate)
End If
End Function
'checked-joe
Function readSelections()
Set fso = CreateObject("scripting.filesystemobject")
Set objlist = fso.OpenTextFile(selectionFile)
i=0
Do Until objList.AtEndOfStream
tmp = objList.ReadLine
If Left(tmp,1) = "#" Or left(tmp,1) = "" Then 'find comments
Else
If Left(tmp,1) = "@" Then
If Left(tmp,23) = "@ TARGET_LOG_FILE_DIR =" Then
ol = Len(tmp)
logPath = Right(tmp,(ol-24))
logPath = Trim(logPath)
ElseIf Left(tmp,24) = "@ DAYS_TO_KEEP_BACKUPS =" Then
ol = Len(tmp)
fldrDays = Right(tmp,(ol-25))
fldrDays = Trim(fldrDays)
fldrDays = Int(fldrDays)
ElseIf Left(tmp, 22) = "@ CREATE_ZIP_ARCHIVE =" Then
ol = Len(tmp)
strCreateZip = Right(tmp,(ol-22))
strCreateZip = Trim(strCreateZip)
strCreateZip = LCase(strCreateZip)
ElseIf Left(tmp,29) = "@ MAX_PERCENT_OF_FREE_SPACE =" Then
ol = Len(tmp)
strPercent = Right(tmp,ol-30)
strPercent = Trim(strPercent)
strPercent = Int(strPercent)
ElseIf Left(tmp,32) = "@ TARGET_DIRECTORY_FOR_BACKUPS =" Then
ol = Len(tmp)
parentPath = Right(tmp,(ol-32))
parentPath = Trim(parentPath)
ol = Len(parentPath)
If Not fso.FolderExists(parentPath) = True Then
'intMsg = MsgBox("Destination folder (" & parentPath & ") does not exist!. Do you wish to create it?",vbYesNo,"Create destination folder?")
'If intMsg = vbYes Then
Set folder = fso.CreateFolder(parentPath)
If fso.FolderExists(parentPath) = True Then
Else
wscript.echo "Failed to create backup folder! Exiting..."
WScript.Quit(666)
End If
'Else
'writeToLog "Aborting..."
'WScript.Quit(333)
'End If
End If
ElseIf Left(tmp,31) = "@ EMAIL_ADDRESS_FOR_REPORTING =" Then
ol = Len(tmp)
strReportEmail = Right(tmp,(ol-31))
strReportEmail = Trim(strReportEmail)
ElseIf Left(tmp,25) = "@ SENDING_EMAIL_ADDRESS =" Then
ol = Len(tmp)
strSendingEmail = Right(tmp,(ol-25))
strSendingEmail = Trim(strSendingEmail)
ElseIf Left(tmp,15) = "@ EMAIL_TITLE =" Then
ol = Len(tmp)
strEmailTitle = Right(tmp,(ol-15))
strEmailTitle = Trim(strEmailTitle)
ElseIf Left(tmp,20) = "@ SMTP_SERVER_NAME =" Then
ol = Len(tmp)
strSmtpServer = Right(tmp,(ol-20))
strSmtpServer = Trim(strSmtpServer)
ElseIf Left(tmp,26) = "@ ENABLE_EMAIL_REPORTING =" Then
ol = Len(tmp)
strUseEmailReporting = Right(tmp,(ol-26))
strUseEmailReporting = Trim(strUseEmailReporting)
strUseEmailReporting = LCase(strUseEmailReporting)
ElseIf Left(tmp,20) = "@ SMTP_SERVER_PORT =" Then
ol = Len(tmp)
strSmtpPort = Right(tmp,(ol-20))
strSmtpPort = Trim(strSmtpPort)
ElseIf Left(tmp,34) = "@ SMTP_SERVER_USE_AUTHENTICATION =" Then
ol = Len(tmp)
strSmtpAuth = Right(tmp,(ol-34))
strSmtpAuth = Trim(strSmtpAuth)
strSmtpAuth = LCase(strSmtpAuth)
ElseIf Left(tmp,24) = "@ SMTP_SERVER_USERNAME =" Then
ol = Len(tmp)
strSmtpUser = Right(tmp,(ol-24))
strSmtpUser = Trim(strSmtpUser)
ElseIf Left(tmp,24) = "@ SMTP_SERVER_PASSWORD =" Then
ol = Len(tmp)
strSmtpPass = Right(tmp,(ol-24))
strSmtpPass = Trim(strSmtpPass)
ElseIf Left(tmp,23) = "@ SMTP_SERVER_USE_SSL =" Then
ol = Len(tmp)
strSmtpSsl = Right(tmp,(ol-23))
strSmtpSsl = Trim(strSmtpSsl)
strSmtpSsl = LCase(strSmtpSsl)
End If
Else
arrSelect(i) = tmp
i = i + 1
End If 'line starts with "@"
End If ' line starts with "#" or " "
Loop
End Function
Function backup()
set sh = CreateObject("wscript.Shell")
For x=0 To (i-1)
If Not arrSelect(x) = "" Then
If Left(arrSelect(x),6) = "MSSQL:" then
' remove the header part and read the rest
tempStr = Right(arrSelect(x),Len(arrSelect(x))-InStr(arrSelect(x),":"))
strDBServerName = left(tempStr,InStr(tempStr,":")-1)
strDB = Right(tempStr,Len(tempStr) - InStr(2,tempStr,":"))
strTargetFolder = parentPath & "\" & strDate & "\" & strDBServerName & "_" & strDB
backupMSSQLserver strDBServerName, strDB, strTargetFolder
Else If Left(arrSelect(x),6) = "MYSQL:" then
' remove the header part and read the rest
tempStr = Right(arrSelect(x),Len(arrSelect(x))-InStr(arrSelect(x),":"))
strDBServerName = left(tempStr,InStr(tempStr,":")-1)
strDB = Right(tempStr,Len(tempStr) - InStr(2,tempStr,":"))
strTargetFolder = parentPath & "\" & strDate & "\" & strDBServerName & "_" & strDB
backupMYSQLserver strDBServerName, strDB, strTargetFolder
else
'this is the default action
strTarget = arrSelect(x)
ol = Len(strTarget)
dlm = InStr(strTarget,";")
nm = ol - dlm
fldrName = Trim(Right(strTarget,nm))
strTarget = Trim(Left(strTarget,(dlm-1)))
strBkUp = "xcopy /s /c /d /e /h /i /r /k /y "
'writeToLog "Backing up to: " & strTarget & " " & parentPath & "\" & strDate & "\" & fldrName & "\"
strCommand = strBkUp & strTarget & " " & Chr(34) & parentPath & "\" & strDate & "\" & fldrName & "\" & Chr(34)
Set fso = CreateObject("scripting.filesystemobject")
tgtL = Len(strTarget)
tgt = Right(strTarget,tgtL-1)
tgtL = Len(tgt)
tgt = Left(tgt,tgtL-1)
Set f = fso.GetFolder(tgt)
sze = f.Size
sze = sze / 1024 / 1024 ' to MB
sze = FormatNumber(sze,2) ' cut at 2 decimal place
totSize = totSize + sze
'Neal Bailey
If strCreateZip = "yes" THEN
writeToLog "Creating archive: " & parentPath & "\" & strDate & "\" & fldrName & "\" & strDate & ".zip"
runBkup = Zip(strTarget, parentPath & "\" & strDate & "\" & fldrName & "\" & strDate & ".zip")
Else
writeToLog "Backing up folder: " & strTarget & " - " & sze & " MB"
runBkup = sh.run("%comspec% /c" & strCommand,0,True) ' 0-hide the window(s), True-Copy one folder at a time
End If
End if
End If 'if sql
End If
Next
End Function
Function backupMSSQLserver(strDBServerName, strDB, strTargetFolder)
'Joseph P. Cohen
'extern strDate, writeToLog
On Error Resume next
writeToLog "Backing up MSSQL at: " & vbcrlf & _
" Server = " & strDBServerName & vbcrlf & _
" Database = " & strDB & vbcrlf & _
" Target File = " & strTargetFolder & "_backup_" & strDate & ".bak'"
strBAKcmd = "backup database " & strDB & " to disk = " & "'" & strTargetFolder & "_backup_" & strDate & ".bak'" & " with init"
Set oConn = CreateObject("ADODB.Connection")
StrConnect = "Driver={SQL Server};Server=" & strDBServerName & ";"
Err.Clear
oConn.Open StrConnect
If Not Err.Number = 0 Then
writeToLog "Connect = Error: Can not connect to server " & Err.Number & " " & Err.Description
Else
writeToLog "Connected to Server running backup command..."
Set oRS = CreateObject("ADODB.Recordset")
oConn.CommandTimeout = 0
oRS.Open strBAKcmd, oConn
If Not Err.Number = 0 Then
writeToLog "Error running backup command " & Err.Number & " " & Err.Source & " " & Err.Description
Else
writeToLog "Backup command sent..."
End if
End if
On Error Goto 0
End Function
Function backupMYSQLserver(strDBServerName, strDB, strTargetFolder)
WScript.Echo "this function does not work"
WScript.Quit(000)'
'Joseph P. Cohen... this function is GOOD ENOUGH .. more time should be spent here.
'extern strDate, writeToLog
On Error Resume next
writeToLog "Backing up MSSQL at: " & vbcrlf & _
" Server = " & strDBServerName & vbcrlf & _
" Database = " & strDB & vbcrlf & _
" Target File = " & strTargetFolder & "_backup_" & strDate & ".bak'"
strBAKcmd = "backup database " & strDB & " to disk = " & "'" & strTargetFolder & "_backup_" & strDate & ".bak'" & " with init"
Set oConn = CreateObject("ADODB.Connection")
StrConnect = "Driver={MySQL ODBC 3.51 Driver};Server=" & strDBServerName & ";User=root;"
Err.Clear
oConn.Open StrConnect
If Not Err.Number = 0 Then
writeToLog "Connect = Error: Can not connect to server " & Err.Number & " " & Err.Description
Else
writeToLog "Connected to Server running backup command..."
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open strBAKcmd, oConn
If Not Err.Number = 0 Then
writeToLog "Error running backup command " & Err.Number & " " & Err.Source & " " & Err.Description
Else
writeToLog "Backup command sent..."
End if
End if
On Error Goto 0
End Function
Function sendMail()
Dim fso, logf
Set fso = CreateObject("scripting.filesystemobject")
'WScript.Echo logPath & "\backup" & strDate & ".html"
Set objMessage = CreateObject("CDO.Message")
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'use '1' for local SMTP
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSmtpPort
If strSmtpAuth = "yes" Then
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'use '2' for NTLM authentication
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSmtpUser
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSmtpPass
End If
If strSmtpSsl = "yes" Then
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End If
objMessage.Configuration.Fields.Update
If InStr(fso.OpenTextFile(logPath & "\backup" & strDate & ".txt",1).ReadAll(),"Error") = 0 Then
objMessage.Subject = strEmailTitle & " completed successfully on " & strDate & "."
Else
objMessage.Subject = strEmailTitle & " HAD ERRORS!! " & strDate & "."
objMessage.Fields("urn:schemas:httpmail:importance").Value = 2
End If
objMessage.From = strSendingEmail
objMessage.To = strReportEmail
objMessage.HTMLBody = Replace(fso.OpenTextFile(logPath & "\backup" & strDate & ".txt",1).ReadAll(),vbCrLf,"<br>")
'objMessage.AddAttachment = logPath & "\backup" & strDate & ".html"
objMessage.Send
End Function
Function auditDays()
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(parentPath & "\" & strDate) Then
Set cur = fso.GetFolder(parentPath & "\" & strDate)
Set objParent = fso.GetFolder(parentPath)
Set objWMIService = GetObject("winmgmts:")
If Left(parentPath,2) = "\\" Then
' Network Drive, we need the root share name
Dim temp
temp = InStr(parentPath,"\")
temp = InStr(temp+1, parentPath,"\")
temp = InStr(temp+1, parentPath,"\")
temp = InStr(temp+1, parentPath,"\")
tgtDrive = Left(parentPath, temp-1)
Else
' local drive, we need root letter
tgtDrive = Left(parentPath,1) 'find target drive letter
End if
Dim fso
Set fso = CreateObject("scripting.filesystemobject")
'This change allows the lookup of SMB drives
Set objLogicalDisk = fso.GetDrive(tgtDrive)
absFree = objLogicalDisk.FreeSpace
parSize = objParent.Size
curSize = cur.Size
If curSize = 0 Then
writeToLog "Error: Did not back up anything!!!"
else
curSize = curSize / 1024 / 1024 'MB
curSize = FormatNumber(curSize,2)
curSize = Int(curSize)
'absolute free space
free = absFree + parSize
free = (free * (strPercent / 100))
free = free / 1024 / 1024 'MB
free = FormatNumber(free,0)
backups = free / curSize
backups = FormatNumber(backups,0)
backups = Int(backups)
fldrDays = Int(fldrDays)
writeToLog"You can perform " & backups & " backups before drive " & strPercent & "% full!"
If (backups < fldrDays) Then
writeToLog "ERROR in c:\$backup$\dbsettings.config!"
writeToLog "Value entered for DAYS_TO_KEEP_BACKUPS is invalid. Due to the space limitations" _
& "of your hard drive, DAYS_TO_KEEP_BACKUPS can be no more than '" & backups & "' ! Please fix this."
Else
writeToLog "You have enough disk space remaining for " & backups & " more backups."
End If
End If ' test for curSize if 0
Else
WScript.Echo "Error: Cannot Find Folder! Did the backup run?"
End If
End Function
Sub writeToLog(str)
' var is logFile
If IsEmpty(logFile) Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set rf = fso.GetFolder(parentPath)
If Not fso.FolderExists(logPath) Then
fso.CreateFolder(logPath)
End If
Set lf = fso.GetFolder(logPath)
'ol = Len(strDate)
'strDate = Right(strDate,ol-1)
Set logFile = lf.CreateTextFile("backup" & strDate & ".txt",True)
writeToLog "=============================================="
writeToLog "Dated Backup Classic(c) v.1.5"
writeToLog "Original code Brian Velde <brian@antidesign.us>"
writeToLog ""
writeToLog "Modified by Joseph P. Cohen"
writeToLog "Modified by Neal T. Bailey <nealbailey@hotmail.com>"
writeToLog "=============================================="
writeToLog ""
writeToLog "Backup log for " & strDate & ""
End If
logFile.write str & vbcrlf
End Sub
'** Main() **
selectionFile = getWorkingDirectory & "\" & "dbsettings.config"
startTime = Timer()
setstrDate()
If Not readSelections() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Error: Backup Failed! - Incorrect Selection File Syntax!"
msgbox "Error: Backup Failed! - Incorrect Selection File Syntax!"
WScript.Quit(1)
End If
writeToLog "Backup Started at: " & Date() & " " & Time()
writeToLog "Reading backup selections..."
writeToLog "Cleaning up old files..."
If not cleanOld() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Error: Backup Failed! - Unable to Remove Old Backup Folders!"
writeToLog "Error: Backup Failed! - Unable to Remove Old Backup Folders!"
WScript.Quit(1)
End If
writeToLog "Creating destination folder..."
If not createFolder() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Error: Backup Failed! - Unable To Create Destination Folder!"
writeToLog "Error: Backup Failed! - Unable To Create Destination Folder!"
WScript.Quit(1)
End If
writeToLog "Starting backup..."
If Not backup() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Backup Failed! - Errors Encountered During the Backup Process!"
writeToLog "Backup Failed! - Errors Encountered During the Backup Process!"
WScript.Quit(1)
End If
endTime = Timer()
totTime = endTime - startTime
If totTime < 60 Then
totTime = FormatNumber(totTime,2)
count = "seconds."
ElseIf totTime < 3600 Then
totTime = totTime / 60
totTime = FormatNumber(totTime,2)
count = "minutes."
ElseIf totTime > 3600 Then
totTime = totTime / 60 / 60
totTime = FormatNumber(totTime,2)
count = "hours."
End If
writeToLog "Backup Completed at: " & Date() & " " & Time() & " - " & FormatNumber(totSize,2) & " MB" & vbcrlf & "Elapsed Time: " & totTime & " " & count
If NOT strCreateZip = "yes" Then
Call auditDays() 'this isn't working in Zip mode
End If
logFile.Close()
If strUseEmailReporting = "yes" Then
Call sendMail()
End If
If curSize = 0 Then
WScript.Quit(1)
End if
WScript.Quit(0)
|
|
|
|
|
This is a very useful script! Does a lot of things that I have not been able to figure out in the past with vbscript. Generally I end up writing a program to do most of this work. Thanks for the contribution.
|
|
|
|
|
sides_dale wrote: This is a very useful script! Does a lot of things that I have not been able to figure out in the past with vbscript. Generally I end up writing a program to do most of this work. Thanks for the contribution.
Thanks!
I wrote it initially to serve as a ghetto backup program for clients that won't pay for Veritas.
In the version that I use, I packaged it with XYNTService, (another utility found on code project) so that the script can be run as a service. I package the whole thing using PrimalScript so that everything can be distributed via an EXE. If you like leveraging the power of VBScript in Windows, I also have an installer framework that can be found here.
Brian
|
|
|
|
|