folderRar.vbs (v1.1.2)

'Mass-RAR Script v1.1.2
'Written by Aaron Loessberg-Zahl
'Last Modified 03 April 2012
'
'RARs each folder in the specified directory into a separate archive.
'Tests archives and deletes original files.
'
'This script must be run from the command line, and your WinRAR installation
'folder must be in your PATH variable.
'
'For comments/questions/bugs, please contact
'<[email protected]> or <[email protected]>.
'
' ----------------------------------------------------------------------------
' "THE BEER-WARE LICENSE" (Revision 2659):
' <[email protected]> wrote this file. As long as you retain this
' notice, you can do whatever you want with this stuff. If we meet some day,
' and you think this stuff is worth it, you can buy me a beer in return.
' ----------------------------------------------------------------------------
'
'Changelog:
'v1.1.2  04-03-2012  amloessb  Corrected typos, added comments
'v1.1.1  12-04-2011  amloessb  Fixed syntax error
'v1.1    12-03-2011  amloessb  Added silly spinner thing
'v1.0    12-01-2011  amloessb  First working version

Option Explicit

On Error Goto 0

Dim objFSO, objDir, args, objSubdirs, subfolder, WshShell, objArchive
Dim strDir, strCmd, intCounter, strSize, exitCode, intSpinner, strPath, strName

'fixFolderStr (folder)
'Purpose: Put a trailing \ on the folder path if it's missing
'Returns: The corrected path string
Function fixFolderStr (folder)
    If Not Mid(folder,Len(folder),1) = "\" Then
        fixFolderStr = folder & "\"
    Else
        fixFolderStr = folder
    End If
End Function

'isProcessRunning (strComputer, strProcessName)
'Purpose: Determine if the specified process is running on the specified computer.
'         strComputer should be "." for the local machine
'Returns: True if the process is running, false otherwise.
Function isProcessRunning(strComputer, strProcessName)
    Dim objWMIService, strWMIQuery

    strWMIQuery = "Select * from Win32_Process where name like '" & strProcessName & "'"

    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" _
            & strComputer & "\root\cimv2")

    If objWMIService.ExecQuery(strWMIQuery).Count > 0 Then
        isProcessRunning = True
    Else
        isProcessRunning = False
    End If
End Function

Set args = WScript.Arguments

If Not args.Count = 1 Then
    WScript.Echo ""
    WScript.Echo "Usage: cscript folderRar.vbs <directory>"
    WScript.Echo ""
    WScript.Echo "Adds each folder in the given directory into its own archive."
    WScript.Quit 1
End If

intSpinner = 0
intCounter = 0
strDir = args(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")

If objFSO.FolderExists(strDir) Then
    Set objDir = objFSO.GetFolder(strDir)
    Set objSubdirs = objDir.SubFolders
    WScript.Echo objSubdirs.Count & " folders found.  Now archiving..."
    WScript.Echo ""
    For Each subfolder In objSubdirs
        strPath = subfolder.Path
        strName = subfolder.Name
        strCmd = "rar a -t -df " & Chr(34) & subfolder.Path & ".rar" & Chr(34)_
                 & " " & Chr(34) & subfolder.Path & Chr(34)
        WshShell.Run strCmd, 7, False
        WScript.StdOut.Write " "
        'Print a silly spinner on the screen to show that progress is being made
        'Interesting consequence of how Sleep works is that the spinner moves
        'slower the harder WinRAR is working.
        While isProcessRunning(".", "rar.exe")
            Select Case intSpinner
                Case 3
                    WScript.StdOut.Write Chr(8) & "/"
                    intSpinner = 0
                Case 2
                    WScript.StdOut.Write Chr(8) & "|"
                    intSpinner = 3
                Case 1
                    WScript.StdOut.Write Chr(8) & "\"
                    intSpinner = 2
                Case 0
                    WScript.StdOut.Write Chr(8) & "-"
                    intSpinner = 1
            End Select
            WScript.Sleep(10)
        WEnd
        WScript.StdOut.Write Chr(8)
        On Error Resume Next
        Set objArchive = objFSO.GetFile(strPath & ".rar")
        If Err.Number <> 0 Then
            WScript.Echo "ERROR: Archive " & strPath & ".rar" & _
                         " could not be created."
        Else
            strSize = FormatNumber((objArchive.Size / 1048576.0), 2)
            WScript.Echo strName & ".rar -- " & strSize & "M"
            intCounter = intCounter + 1
        End If
        On Error Goto 0
    Next
    WScript.Echo ""
    WScript.Echo intCounter & " folders archived successfully."
Else
    WScript.Echo strDir & " does not exist!"
End If