Introduction
This is a simple backup utility that creates dated backup folders. Dated Backup will remove backups older than N days.
Using the Code
This is the datedBackup.vbs file. The editor mangled some of the responses that are to be written to the HTML log files. If you choose to use any of this code, please download the zip so that you can see it in its original format. As you can see from line 1, you must specify the path to the dbsettings.config file. Once you have done that, you must edit the dbsettings.config file to backup the folders that you choose. Dbsettings is also where you enable/disable features of the script such as email notification. Currently this script will check our website for newer versions of itself and download if you choose. Have fun!
Should you decide to use this script or if you like the concept, let me know.
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
appName = "DatedBackup"
version = "1.5"
installer = "http://218netdownloads.apscc.org/veldeApps/datedBackup_install(v1.5).exe"
totSize = 0
strSendingEmail = "dated.backup@default_address.com"
Function isOld(appName, version, installer)
Dim fso, list, objWinHttp, strHTML, objList, tmp, ol, getVersion, upgrade, ie2
Set fso = CreateObject("Scripting.FileSystemObject")
Set list = fso.CreateTextFile("./§",True)
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.Open "GET", "http://218netdownloads.apscc.org/versions.txt"
objWinHttp.Send
objWinHttp.WaitforResponse(5000)
strHTML = objWinHttp.ResponseText
If strHTML = "" Then
WScript.Echo "Unable to poll for updates..."
End If
list.Write strHTML
Set objlist = fso.OpenTextFile("./§")
Do Until objList.AtEndOfStream
tmp = objList.ReadLine
If Left(tmp,len(appName)) = appName Then
ol = Len(tmp)
getVersion = Right(tmp,(ol-Len(appName)-1))
WScript.Echo getVersion
If getVersion > version Then
upgrade = MsgBox("The version of " & appName & _
" you are using is out-dated." & VbCrLf & _
"Do you wish to upgrade?",vbYesNo,"Upgrade Available")
If upgrade = vbYes Then
Set ie2 = CreateObject("InternetExplorer.Application")
ie2.Navigate installer
WScript.Quit(0)
End If
ElseIf getVersion < version Then
WScript.Echo "The version of pushVNC that you have downloaded _
is corrupt or otherwise f***ed with... Exiting!"
WScript.Quit(1)
End If
End If
Loop
objList.Close
Set objList = Nothing
End Function
Function getParent()
End Function
Function createWindow()
Set objExplorer = CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 1
objExplorer.Width = 800
objExplorer.Height = 600
objExplorer.Visible = 1
objExplorer.Document.Title = "Backing Up data... "
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "
<ul>"
End Function
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 Then fldr.Delete
End If
Next
End Function
Function createFolder()
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)
strDate = "\" & strYear & strMonth & strDay
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
objExplorer.Quit()
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
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 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
intMsg = MsgBox("Backup folder created successfully!",_
vbOKOnly,"Folder created!")
Else
intMsg = MsgBox("Failed to create backup folder! _
Exiting...",vbOKOnly,"Folder not created!")
WScript.Quit(666)
End If
Else
intMsg = MsgBox("Aborting...",vbOKOnly,"Abort!")
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,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 End If Loop
End Function
Function backup()
set sh = CreateObject("wscript.Shell")
For x=0 To (i-1)
If Not arrSelect(x) = "" Then
strTarget = arrSelect(x)
ol = Len(strTarget)
dlm = InStr(strTarget,";")
nm = ol - dlm
fldrName = Right(strTarget,nm)
strTarget = Left(strTarget,(dlm-1))
strBkUp = "xcopy /s /c /d /e /h /i /r /k /y "
strCommand = strBkUp & strTarget & " " & parentPath & _
strDate & "\" & fldrName & "\"
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 sze = FormatNumber(sze,2) totSize = totSize + sze
objExplorer.Document.Body.InnerHTML = _
objExplorer.Document.Body.InnerHTML & "<li>Backing up folder: " _
& strTarget & " - " & sze & " MB</li><title>Backup log for " _
& strDate & "</title>"
runBkup = sh.run("%comspec% /c" & _
strCommand,0,True) End If
Next
End Function
Function sendMail()
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") = 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 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
objMessage.Subject = "Dated Backup Report for " & strDate & "."
objMessage.From = strSendingEmail
objMessage.To = strReportEmail
objMessage.HTMLBody = objExplorer.Document.Body.InnerHTML
objMessage.Send
End Function
Function createLog()
Set fso = CreateObject("Scripting.FileSystemObject")
Set rf = fso.GetFolder(parentPath)
If fso.FolderExists(logPath) Then
Else
Set clf = fso.CreateFolder(logPath)
End If
Set lf = fso.GetFolder(logPath)
ol = Len(strDate)
strDate = Right(strDate,ol-1)
Set logFile = lf.CreateTextFile("backup" & strDate & ".html",True)
logFile.write ""
logFile.write objExplorer.Document.Body.InnerHTML & ""
If strUseEmailReporting = "yes" Then
Call sendMail()
End If
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:")
tgtDrive = Left(parentPath,1) Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='" _
& tgtDrive & ":'")
absFree = objLogicalDisk.FreeSpace
parSize = objParent.Size
curSize = cur.Size
curSize = curSize / 1024 / 1024 curSize = FormatNumber(curSize,2)
curSize = Int(curSize)
free = absFree + parSize
free = (free * (strPercent / 100))
free = free / 1024 / 1024 free = FormatNumber(free,0)
backups = free / curSize
backups = FormatNumber(backups,0)
backups = Int(backups)
fldrDays = Int(fldrDays)
If (backups < fldrDays) Then
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<h1>ERROR in c:\$backup$\dbsettings.config!</h1>"
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<h4>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
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"</h4><h4>You have enough disk space remaining for " & backups & _
" more backups.</h4>"
End If
Else
WScript.Echo "Cannot Find Folder! Did the backup run?"
End If
End Function
Call isOld(appName, version, installer)
Call createWindow()
startTime = Timer()
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"</ul>Backup Started at: " & Date() & " " & Time() & "
"
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<li>Reading backup selections...</li>"
If Not readSelections() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Backup Failed! - Incorrect Selection File Syntax!"
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<h2>Backup Failed! - Incorrect Selection File Syntax!</h2>"
sh.Popup("Backup Failed! - Incorrect Selection File Syntax!")
WScript.Quit(1)
End If
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<li>Cleaning up old files...</li>"
If not cleanOld() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Backup Failed! - Unable to Remove Old Backup Folders!"
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<h2>Backup Failed! - Unable to Remove Old Backup Folders!</h2>"
sh.Popup("Backup Failed! - Unable to Remove Old Backup Folders!")
WScript.Quit(1)
End If
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<li>Creating destination folder...</li>"
If not createFolder() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Backup Failed! - Unable To Create Destination Folder!"
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<h2>Backup Failed! - Unable To Create Destination Folder!</h2>"
sh.Popup("Backup Failed! - Unable To Create Destination Folder!")
WScript.Quit(1)
End If
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<li>Starting backup...</li><ol>"
If Not backup() = 0 Then
set sh = CreateObject("wscript.Shell")
sh.LogEvent 1,"Backup Failed! - Errors Encountered During the Backup Process!"
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"<h2>Backup Failed! - Errors Encountered During the Backup Process!</h2>"
sh.Popup("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
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & _
"</ol>Backup Completed at: " & Date() & " " & Time() & " - " _
& FormatNumber(totSize,2) & " MB
<h3>Elapsed Time: " & totTime & " " & count & "</h3>"
objExplorer.Document.Title = "Backup Completed at: " & Date() & " " & Time() _
& " - " & FormatNumber(totSize,2) & " MB "
Call auditDays()
Call createLog()
Set sh = CreateObject("wscript.Shell")
sh.LogEvent 4,objExplorer.Document.Body.InnerHTML
WScript.Quit(0)
Points of Interest
Chop this baby into whatever you wish it to be. Just make sure that you either give credit or email me a thank you.
History
- 5-17-07 - Version 1.5 uploaded