Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 'Mass-RAR Script v1.1.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, 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.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 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
Advertisement
Add Comment
Please, Sign In to add comment