folderRar.vbs (v1.1)

'Mass-RAR Script v1.1
'Written by Aaron Loessberg-Zahl
'Last Modified 03 Dec 2011
'
'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.
'
'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  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 correctrd path string
Function fixFolderStr (folder)
    If Not Mid(folder,Len(folder),1) = "\" Then
        fixFolderStr = folder & "\"
    Else
        fixFolderStr = folder
    End If
End Function

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 " "
        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