I changed it a bit so now when it finds an already existing archive
with that file name, it will add to it instead of creating a new one.
(All parts with same name will be in 1 .zip file now)
Enjoy!
Code:
'////////////////////////////////////////////////////////////////////////////////
'//
'// Author: Matt Finley
'// Original script by Mick George.
'// Date: 11/09/2003 07:31 AM
'// File Name: Archiver.vbs
'//
'////////////////////////////////////////////////////////////////////////////////
'// Description: Makes a backup of the current MC file to the folder specified.
'// Use Winzip with command line interface to compress then delete backup file.
'// You can get the command line interface at: http://www.winzip.com/wzcline.cgi
'//
'// Comments: Ensure the correct path and arguments for the compression
'// you wish to use are entered below. You need to use the truncated name for
'// long path names that contain spaces when calling wzzip.exe.
'// This script uses -m and -ex to delete the original backup file and
'// to use maximum compression. This version will group all files with
'// the same name into the same .zip file. (Bigger zip files, less
'// wasted space and less clutter.
' -----------------
' | Constants |
' ------------------------------------------------------------------------
Public Const DEF_CENTERED = " "
Public Const DEF_ERRLOG = "C:\Your Folder\Backups\McScriptErr.log" ' Path and file for error log
Public Const strZipPath = "C:\Progra~1\WinZip\wzzip.exe -m -ex" 'Path and options for compression
Public Const DEF_BACKUP_DIR = "C:\Your Folder\Backups" ' Backup folder
Dim strBackupPath
Dim strOriginalPath
Dim strFilePath
Dim FSO
Dim strYear
Dim strMonth
Dim strDay
Dim strHour
Dim strMin
Dim C
Dim strName
C = Chr(34) ' holder for " (double quote)
Call Main()
Sub Main()
Call RepaintScreen (True)
On Error Resume Next
' -- Check to make sure backup folder is valid
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(DEF_BACKUP_DIR) Then
' -- Make sure we have a drawing to save
If Not IsDrawing Then
ShowString "No current drawing" & DEF_CENTERED
' -- Bail
Exit Sub
End If
' -- Store current drawing's name
strOriginalPath = GetCurrentFileName
' -- Format a time and date stamp and strip illegal chars
strYear = Replace(FormatDateTime(Date, vbShortDate), "/", "")
strHour = Replace(FormatDateTime(Time, vbShortTime), ":", "")
' -- Build path for the MC9 file name with date/time stamp added
strBackupPath = AddBackSlash(DEF_BACKUP_DIR) & FSO.GetBaseName(strOriginalPath) & "_" & strYear & "_" & strHour & "." & FSO.GetExtensionName(strOriginalPath)
' -- Build path for .ZIP file, (MC9 file name without date/time stamp, reduces clutter)
strFilePath = AddBackSlash(DEF_BACKUP_DIR) & FSO.GetBaseName(strOriginalPath) & ".zip"
Call ClearMenuAndPrompts
' -- Display current file in prompt area
Call WriteString("Backing up file, please wait..." & strBackupPath)
' -- Save current file with new name and continue
If SaveMCAs(strBackupPath, True) Then
' -- Build the command string for zipping (I'm having to truncate the exe's path, and
' -- quote the zip name and file name, go figure..)
strName = strZipPath & " " & C & strFilePath & C & " " & C & strBackupPath & C
' -- Fire the zipping event
Call WriteString("Creating .zip file. Please wait..." & strFilePath)
Call ShellAndWait(strName, True)
' -- Error?
Else
ShowString "Could not backup file to " & DEF_BACKUP_DIR & DEF_CENTERED
End If
' -- Switch back to original file
Call SaveMCAs(strOriginalPath, True)
' -- Clean up
Call ClearMenuAndPrompts
Call RepaintScreen (True)
Else
' -- Folder error. DOH!
ShowString "Folder " & DEF_BACKUP_DIR & " does not exist!" & DEF_CENTERED
Exit Sub
End If
' -- Generate error message and clean up
If Err Then Call TrapError("Sub::Main", Err, True)
Set FSO = Nothing
End Sub
' -----------------
' | Catch Errors |
' ------------------------------------------------------------------------
Sub TrapError(sSource, objErr, bLogIt)
Dim sMSG
Dim sLogError
Dim FSO
sMSG = "Following error occurred in this script:" & DEF_CENTERED & vbCrLf & vbCrLf
sMSG = sMSG & objErr.Description & DEF_CENTERED & vbCrLf
sMSG = sMSG & "Number: " & objErr.Number & DEF_CENTERED & vbCrLf
sMSG = sMSG & "Source: " & DEF_CENTERED & sSource
ShowString sMSG
If bLogIt Then
sLogError = "Error " & objErr.Number & " in " & sSource & ":" & vbCrLf & objErr.Description
Call WriteLog(sLogError)
End If
objErr.Clear
Set objErr = Nothing
End Sub
' ----------------
' | Script Engine |
' ------------------------------------------------------------------------
Function GetScriptEngineInfo()
On Error Resume Next
Dim s
s = "" ' Build string with necessary info.
s = ScriptEngine & " Version "
s = s & ScriptEngineMajorVersion & "."
s = s & ScriptEngineMinorVersion & "."
s = s & ScriptEngineBuildVersion
GetScriptEngineInfo = s ' Return the results.
If Err Then Call TrapError("GetScriptEngineInfo", Err, True)
End Function
' ----------------
' | Add Backslash |
' ------------------------------------------------------------------------
Function AddBackSlash(sPath)
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
AddBackSlash = sPath
End Function
' -----------------
' | Drawing exists? |
' ------------------------------------------------------------------------
Function IsDrawing()
Dim Ret
Ret = StartDBSearch(mc_alive, -1)
IsDrawing = Ret
End Function
'Rekd