Backup Script for Laptop Users

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Backup Script for Laptop Users

Logged in as: Guest

arrSession:exec spGetSession 2,16,35182

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Backup Script for Laptop Users
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Backup Script for Laptop Users - 6/7/2006 12:22:20 AM

torstenj

Posts: 9
Score: 2
Joined: 6/6/2006
Status: offline

Here is a little Backup Script. This script backup different files and folders.
Documentation of that script is very well - if you have some changes, ideas or hints post it here.

Updated! The last script was not the final! ...sorry for that...

'****************************************************************************
'O.K. dude, let's start the game. From here we will run the Backup...
'****************************************************************************
On Error Resume Next 'there are no coding errors!!! ...just in case ;-)
'****************************************************************************
'I start with stupid questions. Are you sure that you are sure to be sure????
'****************************************************************************
Dim BackupMessage1
 BackupMessage1 = MsgBox ("Backup to External Disk will be started after click OK...", 1, "SSI Backup Tool")
 If BackupMessage1 = 2 Then
WSCript.Quit
End If
'****************************************************************************
'Start the progress bar that something happens on the screen - needs a class
'****************************************************************************
Dim bar, i
  Set bar = new IEProgBar
    With bar 
         .BackColor = "FFFFDD"
         .TextColor = "FF0000"
         .ProgressColor = "0000FF"
         .Caption = "Backup in progress. Please wait..."
         .Title = "SSI Mobile Backup Tool"
         .Move 10, 10, 0, 0
         .Show
           For i = 0 to 19
              WScript.Sleep 250
              .Advance
           Next
End With       
'****************************************************************************
'Where to backup? ...might be sometimes very usefull!
'****************************************************************************
'Output Drive letter. Backups are written to this drive
    OutputDrive = "P"
'****************************************************************************
'Let's delete the old backup logs - we need only the least only one
'****************************************************************************
Dim strWildcardsToDelete, strDirectory
 strDirectory = "C:\Backup"
 strWildcardsToDelete = "*.txt"
 'If you want to have more different extensions, than use "," to separate
DeleteFileExtensions strWildcardsToDelete, strDirectory
'****************************************************************************
'Read within the REGISTRY - nice, funny and very usefull for backup paths
'****************************************************************************
Dim userpathinfo
Set userpathinfo = createobject("WScript.Shell")
   usr_favorites = userpathinfo.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Favorites")
    usr_personal = userpathinfo.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Personal")
    usr_localusrset = userpathinfo.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Local Settings")
    usr_outlook = userpathinfo.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\OUTLOOK.EXE\Path")

'****************************************************************************
'Sorry, I'm to lazy to code a long string... That's for Outlook & reopen - currently disabled
'****************************************************************************
Dim outlookpath
    Set outlookpath = CreateObject("WScript.Shell")
       usr_pstfolder = usr_localusrset & "\Application Data\Microsoft\Outlook"
'****************************************************************************
'Local Path. Very easy and handy to use... Extend this option is very easy!
'****************************************************************************
Dim fso, pstlocal
    Set fso = CreateObject("Scripting.FileSystemObject") 
       usr_pstlocal = "D:\Outlook" 
'****************************************************************************
'Tell the script what you want to backup - from the Registry & variables...
'****************************************************************************
'How to define the folders...
'dim sourcefolders(1) is used to back up 2 folders
'dim sourcefolders(2) is used to back up 3 folders
'dim sourcefolders(3) is used to back up 4 folders
'dim sourcefolders(4) is used to back up - how much??? ;-)
Dim sourcefolders(3)
 
    sourcefolders(0) = usr_favorites
    sourcefolders(1) = usr_personal
    sourcefolders(2) = usr_pstfolder
    sourcefolders(3) = usr_pstlocal
'Run in automated operation mode? (not case sensitive)
    AutoOpMode = "yes"                                                 'Valid values are "yes" and "no"
    MinBkupsToKeep = 2                                                 'Minimum number of backup generations to keep (Only applies when AutoOpMode is "yes")
    MinDaysToKeep = 1                                                 'how old must an backup be to delete
    OutputFilePrefix = "SSI-Backup"                            'some name. You can also use "Grglpfrmft" or whatever you want...
    LogComment = "Here is the result of the Backup"    'Say something important within the log file
    SystemLogging = "Yes"                                           'Valid values are "yes" and "no" (not case sensitive)
    
'****************************************************************************
'Termination of Process with MAPI Connection. We want to copy PST Files...
'****************************************************************************      
Dim objWMIService, objProcess, colProcess
Dim strComputer
Dim strProcessKill1
Dim strProcessKill2
Dim strProcessKill3
Dim strProcessKill4
Dim strProcessKill5
strComputer = "."
strProcessKill1 = "'outlook.exe'"
strProcessKill2 = "'BbDevMgr.exe'"
strProcessKill3 = "'DesktopMgr.exe'"
strProcessKill4 = "'RIMDeviceManager.exe'"
strProcessKill5 = "'msnmsgr.exe'"

Set objWMIService = GetObject("winmgmts:" _
 & "{impersonationLevel=impersonate}!\\" _ 
 & strComputer & "\root\cimv2") 
    Set colProcess = objWMIService.ExecQuery _
       ("Select * from Win32_Process Where Name = " & strProcessKill1 )
       For Each objProcess in colProcess
       objProcess.Terminate()
    Next
    Set colProcess = objWMIService.ExecQuery _
       ("Select * from Win32_Process Where Name = " & strProcessKill2 )
       For Each objProcess in colProcess
       objProcess.Terminate()
    Next
    Set colProcess = objWMIService.ExecQuery _
       ("Select * from Win32_Process Where Name = " & strProcessKill3 )
       For Each objProcess in colProcess
       objProcess.Terminate()
    Next
    Set colProcess = objWMIService.ExecQuery _
       ("Select * from Win32_Process Where Name = " & strProcessKill4 )
       For Each objProcess in colProcess
       objProcess.Terminate()
    Next
    Set colProcess = objWMIService.ExecQuery _
       ("Select * from Win32_Process Where Name = " & strProcessKill5 )
       For Each objProcess in colProcess
       objProcess.Terminate()
    Next
WScript.Sleep 5000 'we will wait for process termination! Patiently...
'****************************************************************************
'End of controlling parameters - now the script knows what we want to do...
'****************************************************************************
'----------------------------------------------------------------------------
'****************************************************************************
'Delete the old backup logs will initialized here. Need have a Sub... Damn!
'****************************************************************************
Sub DeleteFileExtensions(strWildcards, strDirectory)
'Create an instance of the FileSystemObject
Dim objFSO
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
'Loop through each wildcard extension to delete
Dim aExtensions
aExtensions = split(strWildcards, ",")
Dim i
For i = LBound(aExtensions) to UBound(aExtensions)
  'Delete the file
  objFSO.DeleteFile(strDirectory & aExtensions(i))
Next
End Sub
'****************************************************************************
'Common objects - will be used for initializations backup mode and counters
'****************************************************************************
set fso = CreateObject("Scripting.FileSystemObject")
  Dim myNetworkObj
     Set myNetworkObj = Wscript.CreateObject("Wscript.Network")
     Dim TotalInputBytes   ' total size of all input folders
  TotalInputBytes = 0
Set shellobj = CreateObject("Wscript.Shell")
     AutoOpMode = LCase(AutoOpMode)       'Force lower case
     SystemLogging = LCase(SystemLogging) 'Force lower case
'****************************************************************************
'Log the fact when the script started to the system log - nice option!
'****************************************************************************
Dim temp   're-used alot but only with a short duration of validity
temp = "Script: " & Wscript.Scriptname &" started"&vbCRLF& "Run by user: " &_
 myNetworkObj.UserName &vbCRLF& "From: " & Wscript.ScriptFullName &vbCRLF&_
 "Controlling Parameters: "               &vbCRLF&_
 "  AutoOpMode: "&       AutoOpMode       &vbCRLF&_
 "  OutputDrive: "&      OutputDrive      &vbCRLF&_
 "  OutputFilePrefix: "& OutputFilePrefix &vbCRLF&_
 "  MinBkupsToKeep: "&   MinBkupsToKeep   &vbCRLF&_
 "  MinDaysToKeep: "&    MinDaysToKeep    &vbCRLF&_
 "  SystemLogging: "&    SystemLogging    &vbCRLF&_
 "  Comment: "& LogComment
If SystemLogging <> "no" Then
  ShellObj.LogEvent 4, temp  'Type four is an Informational message
End If
'****************************************************************************
'Create the activity log file - since L3 I love to have log files...
'****************************************************************************
tempdate = now()
Dim filenamedate  'format is _mmmdd.yyyy_hh.mm
filenamedate = MonthName(DatePart("m",tempdate), True) 'abbreviated month name
  filenamedate = "_" & filenamedate & DatePart ("d",tempdate) &_
    "." & DatePart ("yyyy",tempdate) & "_"
        temp = DatePart ("h",tempdate)
           If temp < 10 Then temp = "0" & temp
              filenamedate = filenamedate & temp & "."  'hour as hh
              temp =  DatePart ("n",tempdate)
                    If temp < 10 Then temp = "0" & temp
                          filenamedate = filenamedate & temp        'minutes as mm
                          logfilename = OutputFilePrefix & "_Log" & filenamedate & ".txt"
                          set logfileobj = fso.createtextfile(logfilename,true)
'****************************************************************************
'Write some environment informations - and I love to write into logs! ;-) 
'****************************************************************************
logfileobj.WriteLine "*** Backup script started at: " &now()& " ***"&vbCrLf
logfileobj.WriteLine "Script: " & Wscript.Scriptname &"  Version 1.0 SSI "
logfileobj.WriteLine "******************************************************"
logfileobj.WriteLine "Environment:"
           Set WshSysEnv = Shellobj.Environment("SYSTEM")
logfileobj.WriteLine "  OS: " &   WshSysEnv("OS")
logfileobj.WriteLine "  Computer: " & myNetworkObj.ComputerName
logfileobj.WriteLine "  User: " &  myNetworkObj.UserName
logfileobj.WriteLine "******************************************************"
          Set myNetworkObj = Nothing       ' let my object go
          Set WshSysEnv    = Nothing
logfileobj.WriteLine " "
logfileobj.WriteLine "Running from: " & Wscript.ScriptFullName &" by "& Wscript.Application
logfileobj.WriteLine "Comment: "  &  LogComment
logfileobj.WriteLine "---------------------------------------------------------------"
logfileobj.WriteLine "Controlling parameters:"
logfileobj.WriteLine "  AutoOpMode="& AutoOpMode
logfileobj.WriteLine "  MinBkupsToKeep="& MinBkupsToKeep
logfileobj.WriteLine "  MinDaysToKeep=" & MinDaysToKeep
logfileobj.WriteLine "  OutputFilePrefix=" & OutputFilePrefix
logfileobj.WriteLine "  OutputDrive=" & OutputDrive
logfileobj.WriteLine "  SystemLogging=" & SystemLogging
logfileobj.WriteLine "---------------------------------------------------------------"

'****************************************************************************
' Write information about input folders
' Write each name and size to the log file
' Also log the total space needed to backup about all folders
' That's damn cool, hmm??
'****************************************************************************
logfileobj.WriteLine "Input Folders to be copied:"
Dim ifobj,indx2  ' Input Folder object, an index to the array

For indx2 = 0 to UBound(sourcefolders, 1)
  Set ifobj =  fso.GetFolder(sourcefolders(indx2))
  logfileobj.WriteLine "  "& sourcefolders(indx2) &" "&FormatNumber(ifobj.Size/1048576, 1)&" Megabytes"
  TotalInputBytes = TotalInputBytes + ifobj.Size
  Set ifobj = Nothing
      Next     'ifobj.Drive&"\"&ifobj.Name did not work well when copying from local dir

Dim neededspace
   neededspace = FormatNumber(TotalInputBytes/1048576, 1) & " Megabytes"
   logfileobj.WriteLine "  Total size of input folders " & neededspace
    logfileobj.WriteLine "---------------------------------------------------------------"

'****************************************************************************
'Chose an output disk drive - select between AUTO and MANUAL Mode.
'****************************************************************************
Dim Drv,DrvType,DrvFspc,DrvTotSpc,DrvName,strDriveMsg,ToCopyOrNotToCopy
Dim OutDrvObj     ' output drive object
Dim OutDrvFspc    ' output drive freespace
'----------------------------------------------------------------------------
' Chose output disk drive for manual mode
'----------------------------------------------------------------------------
If AutoOpMode <> "yes" Then   'manual mode
  logfileobj.WriteLine "Available disk drives:"
  For each Drv in fso.Drives
    If Drv.IsReady Then  'ignore drives that are not ready
      Select Case Drv.DriveType
          Case 0: DrvType = "Unknown"
          Case 1: DrvType = "Removable"
          Case 2: DrvType = "Fixed"
          Case 3: DrvType = "Network"
          Case 4: DrvType = "CD-ROM"
          Case 5: DrvType = "RAM Disk"
      End Select
      If Drv.DriveType=4 Then  'cdrom
    DrvFspc="N/A"
      ElseIf Drv.FreeSpace<1024^2 Then
   DrvFspc=FormatNumber(Drv.FreeSpace/1024,0)&" KB"
      ElseIf Drv.FreeSpace<10240^2 Then
    DrvFspc=FormatNumber(Drv.FreeSpace/(1024^2),2)&" MB"
      Else
    DrvFspc=FormatNumber(Drv.FreeSpace/(1024^2),0)&" MB"
      End If
      If Drv.TotalSize<1024^2 Then
     DrvTotSpc=FormatNumber(Drv.TotalSize/1024,0)&" KB"
      ElseIf Drv.TotalSize<10240^2 Then
     DrvTotSpc=FormatNumber(Drv.TotalSize/(1024^2),2)&" MB"
      Else
     DrvTotSpc=FormatNumber(Drv.TotalSize/(1024^2),0)&" MB"
      End If
      If Drv.VolumeName="" Then
         DrvName="(None)"
      Else
         DrvName=Drv.VolumeName
      End If
      strDriveMsg=strDriveMsg&"Drive "& Drv.DriveLetter &_
     ": "&DrvName &vbTab &_
     "Free Space: " & DrvFspc &vbCRLF  'Build input box message
  logfileobj.WriteLine "  "& Drv.DriveLetter &" - "& DrvName &" "&_
     " Free Space: " & DrvFspc  &" Total Space: "& DrvTotSpc &" " &_
     Drv.FileSystem &" "&DrvType
    End If
  Next 'next Drv in fso.Drives collection
  strDriveMsg="Space needed for backups: "& neededspace &vbCrLf&vbCrLf& strDriveMsg
  Dim InputDrive
  InputDrive = InputBox (strDriveMsg  &vbCRLF& "Enter desired output drive letter " &vbCRLF&_
     "  (enter a single character, no colon or slash) "  &vbCRLF&_
     "To skip backup entirely, click Cancel button", _
     "Select Output Disk Drive Letter", OutputDrive)
  If InputDrive = "" Then         'User clicked the Cancel button
       ToCopyOrNotToCopy = vbNo
  Else
       ToCopyOrNotToCopy = vbYes  'take the backups
       OutputDrive = InputDrive   'and use drive letter user input
       logfileobj.WriteLine "Backing up to -" & OutputDrive & "- drive per user input"
  End If
  Set OutDrvObj = fso.GetDrive(OutputDrive)   'output drive object
  OutDrvFspc = OutDrvObj.FreeSpace
End If                            'End manual mode disk drive selection
'----------------------------------------------------------------------------
' Chose output disk drive for AutoOps mode
'----------------------------------------------------------------------------
 If AutoOpMode = "yes" Then
   ToCopyOrNotToCopy = vbYes   'In auto-op mode, always make a backup
   Set OutDrvObj = fso.GetDrive(OutputDrive)
   OutDrvFspc = OutDrvObj.FreeSpace
   logfileobj.WriteLine "Output drive: (from controlling parameter OutputDrive)"
   Select Case OutDrvObj.DriveType
      Case 0: DrvType = "Unknown"
      Case 1: DrvType = "Removable"
      Case 2: DrvType = "Fixed"
      Case 3: DrvType = "Network"
      Case 4: DrvType = "CD-ROM"
      Case 5: DrvType = "RAM Disk"
   End Select
   logfileobj.WriteLine "  " & OutputDrive & " " & OutDrvObj.VolumeName &_
      "(" & DrvType & ") " & OutDrvObj.FileSystem &" "& OutDrvObj.ShareName &_
      " Total Size: " & FormatNumber(OutDrvObj.TotalSize/1048576, 0) & " Megabytes" &_
      " Free Space: " & FormatNumber(OutDrvObj.FreeSpace/1048576, 1) & " Megabytes"
 End If    'End auto-ops mode disk drive selection
 logfileobj.WriteLine "---------------------------------------------------------------"
'****************************************************************************
'To Copy or Not To Copy - that's the question which we need to answer... :-)
'****************************************************************************
If ToCopyOrNotToCopy = vbNo Then       ' this was set by the code just above
  logfileobj.WriteLine vbCRLF & "BACKUP OPERATION BYPASSED BY USER"
Else                ' same variable used for the log file name/timestamp
  dim outfoldername                    ' date format is mmmdd.yyyy_hh.mm
  outfoldername = OutputDrive & ":\" & OutputFilePrefix & "_Full" & filenamedate
  set tempfolder = fso.CreateFolder(outfoldername)
  logfileobj.WriteLine "Created output folder " & tempfolder.Path
  set tempfolder = Nothing
  logfileobj.WriteLine "Copy starting..."
  Dim outfileobj
  CopyAllFolders()     'Do the copy!
End If
'****************************************************************************
'Deal with backup generations - select if older one exists...
'****************************************************************************
Dim outmsg3, BkupGenCount
   logfileobj.WriteLine vbCrLf&"Searching for existing backup folders . . . "
   logfileobj.WriteLine "  looking in root of " & OutputDrive &_
                     " disk for directories starting with " & OutputFilePrefix
      If ToCopyOrNotToCopy = vbNo Then
          outmsg3 = "Backup operation BYPASSED" &vbCRLF& "Listing existing backup folders"
         Else
          outmsg3 = "Backup complete" &vbCRLF& "Searching for existing backup folders"
      End If
      
      If AutoOpMode <> "yes" Then
            shellobj.Popup outmsg3, 2, "Reviewing old backups . . ."
      End If
   BkupGenCount= 0                 'The number of backup generations found
   rootfold = OutDrvObj.RootFolder 'Root folder from output drive object
   CountBackups(rootfold)          'Count the number of backup generations and log them
'****************************************************************************
'...Counting the Backups - damn good trick, because WBS is to stupid to do...
'****************************************************************************
If AutoOpMode<>"yes" Then
   logfileobj.WriteLine "Did not attempt to delete old backups because auto-op mode is off."
   ElseIf  BkupGenCount=0 Then
   logfileobj.WriteLine "Did not attempt to delete old backups because none were found."
End If
If (AutoOpMode<>"yes") or (BkupGenCount=0) Then
      BkupGenCount = BkupGenCount   'A fudged no-op
   Else
Dim BkupGenerations()
ReDim BkupGenerations(BkupGenCount-1)
   AccumBkupGens(rootfold)   ' Build array of all the existing backup generations
                                          ' The array BkupGenerations is now fully populated, but unsorted
                                          ' Next up: sort it by the age of each backup generation
                                          ' Note: VBScript has no sort function, Jscript does
 If BkupGenCount > 1 Then   ' only sort if the array has at least 2 elements
    Dim outer, inner
    For outer = 0 to BkupGenCount-2      'from first element to next-to-last element
    For inner= outer+1 to BkupGenCount-1 'end at last array element
      If BkupGenerations(inner) < BkupGenerations(outer) Then 'switch them
          temp = BkupGenerations(inner)
          BkupGenerations(inner) = BkupGenerations(outer)
          BkupGenerations(outer) = temp
      End If
    Next
    Next
 End If
'***********************************************************************
'...and case select to old - goto delete!
'***********************************************************************
 If BkupGenCount > MinBkupsToKeep Then
    Dim indx, age4, forceit, DelCounter
    DelCounter = 0  'Count of deleted backup generations
    logfileobj.WriteLine "Examining old backups for possible deletion..."
    For indx = MinBkupsToKeep To BkupGenCount-1
      age4 = Left(BkupGenerations(indx),4) 'strip off the 4 digit age of bkup
      age4 = CLng(age4)                    'convert string to number (long)
      If age4 > MinDaysToKeep Then
         logfileobj.WriteLine "  Deleting " & Mid(BkupGenerations(indx),5) &_
               " It is "& FormatNumber(age4,0) & " days old. Limit is " &_
               MinDaysToKeep &" days"
         forceit = CBool(-1)  ' a TRUE boolean variable
         fso.DeleteFolder Mid(BkupGenerations(indx),5), forceit 'Delete backup folder
         DelCounter = DelCounter + 1   'Count of deleted backup generations
      End If
    Next
    logfileobj.WriteLine "Examination complete, "& DelCounter &" backup generations deleted."
 Else
    logfileobj.WriteLine "Did not attempt to delete old backups because minimum " &_
                         "generations not yet exceeded"
 End If
End If
'****************************************************************************
'Now let's write some information's... ;-) Very important things...
'****************************************************************************
logfileobj.WriteLine vbCrLf&"*** SSI-Backup script ended at: " & now() & " ***"
logfileobj.WriteLine        "   (Programmed by Torsten Jahnke 2006)"
logfileobj.close   'close the log file
Set logfileobj = Nothing
'If a backup was made, then copy the log file to the main output directory
If (fso.FolderExists(outfoldername)) Then 'only copy if the folder exists
  If ToCopyOrNotToCopy = vbYes Then      'only copy if we made a backup
    Set logfileobj = fso.GetFile(logfilename)      'create a File object
    logfileobj.Copy(outfoldername&"\"&logfilename) 'copy log file to output directory
    Set logfileobj = Nothing
  End If
End If
'****************************************************************************
'Ta-Daaa!! That's all folks!
'Log the facts that the script ended into the system log
'****************************************************************************
If AutoOpMode <> "yes" Then
   shellobj.Run "%windir%\notepad " & logfilename
End If
temp = "Script: " & Wscript.Scriptname &" ended"&vbCRLF&vbCRLF &_
  "Run from: " & Wscript.ScriptFullName
If SystemLogging <> "no" Then
  ShellObj.LogEvent 4, temp  'Type four is an Informational message
End If
'Wscript.Quit
'****************************************************************************
'SUBROUTINES - WBS bla, bla again. We need that here...
'****************************************************************************
sub CopyAllFolders()
Dim indx3
For indx3 = 0 to UBound(sourcefolders, 1)
   copy1folder(sourcefolders(indx3))   ' GUTS of issue
Next
logfileobj.WriteLine "Copy completed."   'Finished copying all folders
Dim OutDrvFspcAfter
OutDrvFspcAfter = OutDrvObj.FreeSpace
logfileobj.WriteLine "Output Drive Freespace: Before " & FormatNumber(OutDrvFspc/1048576, 1) &_
   " After: " & FormatNumber(OutDrvFspcAfter/1048576, 1)
logfileobj.WriteLine "Backups that should have used " & FormatNumber(TotalInputBytes/1048576, 1) &_
   " Megabytes, actually used " & FormatNumber((OutDrvFspc-OutDrvFspcAfter)/1048576, 1)  &_
   " Megabytes"
If ((OutDrvFspc-OutDrvFspcAfter)-TotalInputBytes) > 5242880 Then '5 Megabytes=5242880
  logfileobj.WriteLine "   Note: look into cluster waste on " & OutDrvObj.FileSystem &_
  " " & OutputDrive & " drive"
End If
logfileobj.WriteLine "---------------------------------------------------------------"
End sub
'****************************************************************************
'Copy a single source folder to back it up... Users are Users!
'****************************************************************************
Sub copy1folder(parm2)       'parameter looks like "C:\WINNT\repair"
dim starttime, endtime, elapsecs, copytofolder, lenless3, tempfolder
   set thisFolder = fso.GetFolder(parm2)  'folder object for a source folder
   lenless3 = Len(parm2) - 3              'there is no substrng in vbscript
      copytofolder = Right(parm2,lenless3)   'strip off leading driveletter,colon,slash
      copytofolder = Replace(copytofolder, "\", "__" , 1, -1)  'replace slashes to force 1 level
      copytofolder = outfoldername & "\" & copytofolder
   Set tempfolder = fso.CreateFolder(copytofolder)    'create the output bkup folder
      starttime = now()                        'Note when the copy started
   logfileobj.WriteLine " Start "&parm2&" "&starttime&" "&FormatNumber(thisFolder.size,0) & " bytes"
thisFolder.Copy(copytofolder)            ' COPY!!
endtime = now()                                  'Note when copy ended
elapsecs = DateDiff("s", starttime, endtime)     'secs twixt start time and end time
logfileobj.WriteLine "   End " & parm2 & " " & endtime & " " & elapsecs & " seconds to copy"
   If elapsecs > 3 Then         ' dont bother doing this for very small folders
     logfileobj.WriteLine "       Speed of copy: " & FormatNumber((thisFolder.size/elapsecs),0) &_
              " bytes/second "  &_
    FormatNumber((((thisFolder.size/elapsecs)*8)/1048576),1) & " MegaBits/second"
   End If
Set thisFolder = Nothing
Set tempfolder = Nothing
If AutoOpMode <> "yes" Then     'Show user status if not in auto-ops mode
   shellobj.Popup "Copied "&parm2&" in "&elapsecs&" seconds", 3, "One Dir Down"
End If
end Sub
'****************************************************************************
'Browse the backups on the output disk drive a second time - for writing...
'****************************************************************************
Sub AccumBkupGens(parm2)
set thisFolder = fso.GetFolder(parm2)  'folder object
set subfoldcol = thisFolder.SubFolders 'subfolder collection
dim ArrayIndex, age, PrefixLen
ArrayIndex = 0
PrefixLen = Len(OutputFilePrefix)
For each onefolder in subfoldcol
  If Len(onefolder.name)>PrefixLen and Left(onefolder.name,PrefixLen)=OutputFilePrefix Then
     age = DateDiff("d",onefolder.DateCreated,Now)
     If Len(age) = 1 Then age = "000" & age
     If Len(age) = 2 Then age = "00"  & age
     If Len(age) = 3 Then age = "0"   & age
     BkupGenerations(ArrayIndex) = age&onefolder.path
     ArrayIndex = ArrayIndex + 1
  End If
Next
set thisFolder = Nothing
set subfoldcol = Nothing
end sub
Sub CountBackups(parm1)
   set thisFolder = fso.GetFolder(parm1)
   set subfoldcol = thisFolder.SubFolders
   Dim PrefixLen
   PrefixLen = Len(OutputFilePrefix)
   For each onefolder in subfoldcol
     If Len(onefolder.name)>PrefixLen and Left(onefolder.name,PrefixLen)=OutputFilePrefix Then
        BkupGenCount= BkupGenCount+ 1
        logfileobj.WriteLine "  "& onefolder.path & " (" &_
              FormatNumber(onefolder.Size/1048576, 1)&" Meg) "&onefolder.DateCreated
     End If
   Next
   set thisFolder = Nothing
   set subfoldcol = Nothing
   logfileobj.WriteLine "Search completed"
end Sub
'****************************************************************************
'Inform the user that everything is done...
'****************************************************************************
Dim MyVar
 MyVar = MsgBox ("The Backup is now finished!", 0, "SSI Backup Tool")
'****************************************************************************
'...and reopen Outlook. User can now work again!!! Enable that - Outlook will restart automaticaly
'****************************************************************************
'Dim objCalc, strShell, objProgram, strExe 
'strComputer = "."
'strExe = usr_outlook & "Outlook.exe"
'Set objWMIService = getobject("winmgmts://" & strComputer & "/root/cimv2") 
'# Obtain the Win32_Process class of object.
'Set objProcess = objWMIService.Get("Win32_Process")
'Set objProgram = objProcess.Methods_( _
'"Create").InParameters.SpawnInstance_
'objProgram.CommandLine = strExe 
'Execute the program now at the command line.
'Set strShell = objWMIService.ExecMethod( _
'"Win32_Process", "Create", objProgram)
'****************************************************************************
'Delete the old Backup Logs - everything older than 1 Day. What a shit to code...
'****************************************************************************
Dim WSHShell, fs, Header, LogFile, LogName
Dim PCName, FilePath, File
Dim FDate, Count, DelCount, AllFilters, OlderThan
Dim DoDelete, ObjDirectory, TheFiles
Dim TimeIt, EndTime, StartTime
Dim FilterList(10)
Const ForReading = 1, ForWriting = 2
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
 Header = "Your Computer" 
 PCName = WSHShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
    Count = 0
    DelCount = 0
    AllFilters = 10
    StartTime = Timer
    LogName = " DelbyDate.LOG"   'changeable Settings
    DoDelete = TRUE                   'Debug Option - very usefull
    FilePath = "C:\Backup"         'path to start from:
    OlderThan = (Now() - (1))    ' older than 3.2 years - date "olderthan" to delete
'****************************************************************************
'Exception handle. Keep that files below...
'****************************************************************************
FilterList(1) = UCase(".vbs") ' system file
FilterList(2) = UCase(".dll") ' system file
FilterList(3) = UCase(".exe") ' dont delete any program files
FilterList(4) = UCase("historic") ' dont delete any historic dept files 
FilterList(5) = UCase("legal") ' dont delete any legal dept files 
FilterList(6) = UCase("trackit") ' dont delete any files in the trackit directory
FilterList(7) = UCase("keep") ' "keep" directories?
FilterList(8) = UCase(".dbf") ' .dbf files
FilterList(9) = UCase("") ' not used
FilterList(10) = UCase("save") ' marked to save
'****************************************************************************
'Ready to do the job...
'****************************************************************************
StartLogging()
StartTime = Now()
 LogEvent(" Searching for Files Older than = " & OlderThan)
 LogEvent("From " & FilePath & " on " & PCName & " !!@ " & Now())
Set ObjDirectory = fs.GetFolder(FilePath)
 If NOT DoDelete Then
    LogEvent("Files will not be Deleted.")
 End If
Process ObjDirectory
LogEvent("Total Files Counted = " & CStr(Count))
 If DoDelete Then
    LogEvent("Total Files Deleted = " & CStr(DelCount))
 End If
EndTime = Timer
TimeIt = EndTime - StartTime
LogEvent("Total Time = " & TimeIt & " Seconds")
StopLogging()
Set fs = Nothing
wscript.Quit
Sub RemoveFile(TheFile)
Dim oFile
     DelCount = DelCount + 1
    Set oFile = fs.GetFile(theFile)
on error resume next
    oFile.Delete
    LogEvent(TheFile & " -Deleted")
End Sub 'RemoveFile()
Function InFilter(AFile)
 Dim Z, TmpStr
    InFilter = FALSE
       For Z = 1 to AllFilters 
    TmpStr = CStr(FilterList(Z))
 If (Instr(UCase(AFile), TmpStr)> 1) Then
    InFilter = TRUE
 End If
Next 
End Function 'InFilter
Sub Process(objDirectory)
 Dim MoreFolders, TempFolder
    Set TheFiles = objDirectory.Files
    For Each file in theFiles
 Count = Count +1 
If FExist(File.Path) Then 
    If NOT InFilter(File.Path) Then
          FDate = GetFileDate(File.Path)
                If (FDate < OlderThan) Then
                      If DoDelete Then
                            RemoveFile(File.Path)
                      Else
                            LogEvent(File.Path & " - " & FDate & " To Delete.")
                      End If
                End If 
    End If 
End If
Next
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
Process TempFolder
Next
End Sub 'Process()
Function GetFileDate(theFile)
 Dim oFile
    Set oFile = fs.GetFile(theFile)
    GetFileDate = oFile.DateLastModified
End Function 'GetFileDate()
Sub LogFileInfo()
 ' LogEvent(File.Path & " : " & FDate & ": Is Older Than " & OlderThan)
 LogEvent(File.Path & " - " & FDate)
End Sub 'LogFileInfo()
Sub StartLogging()
On Error Resume Next
 Set LogFile = fs.CreateTextFile(LogName,vbTrue)
    If (Err.Number <> 0) Then
       WSHShell.Popup " Please contact Munich Helpdesk. Thanks! Delete log is not possible." & LogFile, 2, Header, 0
       Wscript.Quit(1)
    End If
 LogFile.WriteLine " Logging Enabled : " & Now()
 ScriptLoc = wscript.scriptfullname
 LogFile.WriteLine " Script running from : " & ScriptLoc
End Sub 'StartLogging()
Sub StopLogging()
On Error Resume Next
 LogFile.WriteLine " Logging Disabled : " & Now()
 LogFile.Close
End Sub
Sub LogEvent(StringtoWrite)
 on error resume next
 LogFile.WriteLine StringtoWrite
End Sub
Sub LogEventNoCR(StringtoWrite)
 on error resume next
 LogFile.Write StringtoWrite
End Sub
Function FExist(filespec) ' File Exists
 FExist = FALSE
    If (fs.FileExists(filespec)) Then
       FExist = TRUE
    End If
End Function
'****************************************************************************
'This CLASS is for the progress bar - will be used for something on screen...
'****************************************************************************
Class IEProgBar
'---------------------------------------------------------------
Private FSO, IE, BackCol, ProgressCol, ProgressUnits, Q2, sTemp, iProgress
Private Sub Class_Initialize()
    On Error Resume Next
       Set FSO = CreateObject("Scripting.FileSystemObject")
          sTemp = FSO.GetSpecialFolder(2)
          Q2 = chr(34)
      Set IE = CreateObject("InternetExplorer.Application") 
        With IE
            .AddressBar = False
            .menubar = False
            .ToolBar = False
            .StatusBar = False
            .width = 400
            .height = 120
            .resizable = False
            .visible = False
        End With    
     BackCol = "E0E0E4"  
     ProgressCol = "0000A0"    
     ProgressUnits = 20          'number of progress units. Change this value to change unit number.    
     iProgress = 0      
     PrepPage  
       Do Until IE.ReadyState = 4
     Loop
End Sub
'---------------------------------------------------------------       
Private Sub Class_Terminate()
 On Error Resume Next
    WScript.DisconnectObject IE  
       IE.Quit
          Set IE = Nothing   
          Set FSO = Nothing  
End Sub
'---------------------------------------------------------------
Public Sub Show()        
 IE.Visible = True
End Sub
'---------------------------------------------------------------
Public Sub Hide()
 IE.Visible = False
End Sub
'---------------------------------------------------------------
Public Sub Advance()
 On Error Resume Next
    If (iProgress < ProgressUnits) and (IE.Visible = True) Then
       IE.Document.parentWindow.Prog1(iProgress).bgcolor = ProgressCol
       iProgress = iProgress + 1
    End If   
End Sub
'---------------------------------------------------------------
Public Sub Reset()
Dim i2
 On Error Resume Next
    For i2 = 0 to (ProgressUnits - 1)
       IE.Document.parentWindow.Prog1(i2).bgcolor = BackCol   
    Next
       iProgress = 0
End Sub
'---------------------------------------------------------------
Public Sub Move(PixLeft, PixTop, PixWidth, PixHeight)
 On Error Resume Next
    If (PixLeft > -1) Then IE.Left = PixLeft
       If (PixTop > -1) Then IE.Top = PixTop
          If (PixWidth > 0) Then IE.Width = PixWidth
             If (PixHeight > 0) Then IE.Height = PixHeight
End Sub
'---------------------------------------------------------------
Public Property Let BackGround(sPic)
Dim Boo1, sFil, sFilPath
 On Error Resume Next
    If (Len(sPic) = 0) or (FSO.FileExists(sPic) = False) Then
       Boo1 = IE.Document.Body.removeAttribute("Background", 0)
    Else  
       sFil = FSO.GetFileName(sPic)
       sFilPath = sTemp & "\" & sFil
          If FSO.FileExists(sFilPath) Then FSO.DeleteFile sFilPath, True
             FSO.CopyFile sPic, sFilPath, True
             IE.Document.Body.background = sFil
          End If
End Property
'---------------------------------------------------------------
Public Property Let BackColor(sCol)
 If (TestColor(sCol) = True) Then
    BackCol = scol
    IE.Document.bgColor = sCol
 End If   
End Property
'---------------------------------------------------------------
Public Property Let TextColor(sCol)
 If (TestColor(sCol) = True) Then IE.Document.Body.Text = sCol
End Property
'---------------------------------------------------------------
Public Property Let ProgressColor(sCol)
 If (TestColor(sCol) = True) Then ProgressCol = sCol
End Property
'---------------------------------------------------------------
Public Property Let Icon(sPic)
Dim sTag, sFil, sFilPath
 On Error Resume Next
    If (Len(sPic) = 0) or (FSO.FileExists(sPic) = False) Then Exit Property
       sFil = FSO.GetFileName(sPic)
       sFilPath = sTemp & "\" & sFil
          If FSO.FileExists(sFilPath) Then FSO.DeleteFile sFilPath, True
             FSO.CopyFile sPic, sFilPath, True 
             sTag = "<IMG SRC=" & Q2 & sFil & Q2 & " ALIGN=" & Q2 & "Left" & Q2 & ">"
             IE.Document.Body.insertAdjacentHTML "AfterBegin", sTag
End Property
'---------------------------------------------------------------
Public Property Let Title(sCap)
 IE.Document.Title = sCap
End Property
'---------------------------------------------------------------
Public Property Let Caption(sCap)
 IE.Document.parentWindow.Cap1.innerText = sCap
End Property
'---------------------------------------------------------------
Public Sub CleanIETitle()
Dim sR1, sR2, SH
 On Error Resume Next
    sR1 = "HKLM\Software\Microsoft\Internet Explorer\Main\Window Title"
    sR2 = "HKCU\Software\Microsoft\Internet Explorer\Main\Window Title"
    Set SH = CreateObject("WScript.Shell") 
    SH.RegWrite sR1, "", "REG_SZ"
    SH.RegWrite sR2, "", "REG_SZ"
    Set SH = Nothing  
End Sub
'---------------------------------------------------------------
Private Function TestColor(Col6)
Dim iB, sB, iB2, Boo1
 On Error Resume Next
    TestColor = False
    If (Len(Col6) <> 6) Then Exit Function
       For iB = 1 to 6
          sB = Mid(Col6, iB, 1)
          iB2 = Asc(UCase(sB))
             If ((iB2 > 47) and (iB2 < 58)) or ((iB2 > 64) and (iB2 < 71)) Then
                Boo1 = True
             Else
                Boo1 = False
             Exit For
    End If
    Next
    If (Boo1 = True) Then TestColor = True    
End Function
'---------------------------------------------------------------
Private Sub PrepPage()  
Dim s, i, TS
 On Error Resume Next
       s = "<HTML><HEAD><TITLE>Progress</TITLE></HEAD>"
       s = s & "<BODY SCROLL=" & Q2 & "NO" & Q2 & " BGCOLOR=" & Q2 & "#E0E0E4" & Q2 & " TEXT=" & Q2 & "#000000" & Q2 & ">"
       s = s & "<FONT FACE=" & Q2 & "tahoma" & Q2 & " SIZE=2><LABEL ID=" & Q2 & "Cap1" & Q2 & ">Progress...</LABEL></FONT><BR><BR>"    
       s = s & "<TABLE BORDER=1><TR><TD><TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0><TR>"
    For i = 1 to ProgressUnits
       s = s & "<TD WIDTH=16 HEIGHT=16 ID=" & Q2 & "Prog1" & Q2 & ">"
    Next
       s = s & "</TR></TABLE></TD></TR></TABLE><BR><BR></BODY></HTML>"         
       Set TS = FSO.CreateTextFile(sTemp & "\iebar3.html", True)
          TS.Write s
          TS.Close
          Set TS = Nothing
          IE.Navigate "file:///" & sTemp & "\iebar3.html"
End Sub
'---------------------------------------------------------------        
End Class

Line 160 is now @ 960 - but I modified it! :-) Thanks!

Regards,

Torsten

< Message edited by torstenj -- 6/7/2006 3:44:01 AM >

Revisions: 2 | Post #: 1

RE: Backup Script for Laptop Users - 6/7/2006 3:13:29 AM

edavis6678

Posts: 121
Score: 0
Joined: 1/12/2006
Status: offline

nice script. If you can, update your code and have the link removed on line 166 to be the following:

IE.Navigate "file:///" & sTemp & "\iebar3.html"

(in reply to torstenj)

Post #: 2

RE: Backup Script for Laptop Users - 3/19/2007 2:37:09 PM

FBSmith

Posts: 4
Score: 0
Joined: 3/19/2007
Status: offline

I like this backup script, but have a few questions.
I tried it out with a USB drive, it told me is was done when it ran out of space on the usb Key, but not all files were copied.
Is it possible to check for how much room is needed and write an error box if there isn't enough room?

I loved the idea of checking the path in the registry, is there a way to do this for these folders?

"C:\Documents and Settings\"% USERNAME% "\Application Data\Microsoft\Proof
"C:\Documents and Settings\"% USERNAME% "\Application Data\Microsoft\Templates"
"C:\Documents and Settings\"% USERNAME% "\Application Data\Microsoft\Signatures"

Frank

(in reply to edavis6678)

Post #: 3

RE: Backup Script for Laptop Users - 2/1/2008 7:09:58 AM

lizaoreo

Posts: 1
Score: 0
Joined: 1/31/2008
Status: offline

I'm interested in trying to convert this script somewhat to move files from one computer to another placing them in their appropriate folder. (IE. User documents, favorites, desktops, etc...). We lease computers from Dell and I was hoping to make the process of swapping out each lease a little less painful. In the past a batch file was used, but that required manually mapping and unmapping drives and other such things. I'm hoping to set this script up so that it'll prompt for the new comptuers name, then, being run from the old computer, it will map a drive, move the stuff, then unmap the drive. Basically to start off, I was just going to run the program itself on one of our XP computers, but it comes back with an Syntax error on Line 17, character 13. Could someone explain that to me please?

Thanks

(in reply to FBSmith)

Post #: 4

RE: Backup Script for Laptop Users - 2/2/2008 10:20:17 AM

mbouchard

Posts: 1804
Score: 12
Joined: 5/15/2003
From: USA
Status: online

quote:

ORIGINAL: lizaoreo

I'm interested in trying to convert this script somewhat to move files from one computer to another placing them in their appropriate folder. (IE. User documents, favorites, desktops, etc...). We lease computers from Dell and I was hoping to make the process of swapping out each lease a little less painful. In the past a batch file was used, but that required manually mapping and unmapping drives and other such things. I'm hoping to set this script up so that it'll prompt for the new comptuers name, then, being run from the old computer, it will map a drive, move the stuff, then unmap the drive. Basically to start off, I was just going to run the program itself on one of our XP computers, but it comes back with an Syntax error on Line 17, character 13. Could someone explain that to me please?

Thanks

Take a look at Robocopy. It is a command line tool from MS that is pretty damn useful. If you do a google search for Robocopy GUI you will find some that will do the mapping for you. Or, you can just create a script that will map the drive, run Robocopy then unmap the drive.

The DOS command would look something like this:

Robocopy c:\documents and settings \\destinationPC\Documents and settings /E /COPYALL /XD %TEMP% c:\documents and settings\Administrator /XF *.tmp /TEE /ETA /LOG:c:\RoboCopyDS.txt

But you would need to test it.

/XD excludes the listed folders (Not sure about needing quotes or if the %temp% would work. But you can get by the %temp% when doing it in vbscript
/XF excludes the listed files
/COPYALL
/E copies all sub directories including empty ones
/TEE displays output in Cmd window (Needed if you want to see a progress when using a log file

_____________________________

Mike

For useful Scripting links see the Read Me First stickey!

Always remember Search is your friend.

(in reply to lizaoreo)

Post #: 5

If you found our site useful please link to us <a href="http://www.visualbasicscript.com">VisualBasicScript.com</a>.

All Forums >> [Scripting] >> Post a VBScript >> Backup Script for Laptop Users

Page: [1]

Jump to:

New Messages	No New Messages
Hot Topic w/ New Messages	Hot Topic w/o New Messages
Locked w/ New Messages	Locked w/o New Messages

Post New Thread

Reply to Message

Post New Poll

Submit Vote

Delete My Own Post

Delete My Own Thread

Rate Posts