Skript för att packa upp rarfiler från flera undermappar|Programmering / Grafisk formgivning|Forum|Nordichardware

(detta har gjorts 1000 gånger innan men jag ville göra ett eget ;))

Jag behövde ett skript som packar upp alla .rar-filer i alla undermappar (ej rekursivt) från en mapp, så att man slipper gå in i varje mapp enskilt och extrahera. Detta är rätt användbart om man t.ex. tankar ner en valfri licensfri anime som är packad såhär:

E:.

	├───AnimeXYZ.COMPLETE.S02.DVDRip.XviD-OMGBBQ

	│   ├───AnimeXYZ.S02E01.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E02.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E03.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E04.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E05.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E06.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E07.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E08.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E09.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E10.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   ├───AnimeXYZ.S02E11.DVDRip.XviD-OMGBBQ

	│   │   └───Sample

	│   └───AnimeXYZ.S02E12.DVDRip.XviD-OMGBBQ

	│       └───Sample

Så jag skrev ett för skojs skull, tänkte dela med mig av det.

unpack.vbs

' Script to unpack all .rar files in each subdirectory from current directory

	'On Error Resume Next

	

	Set objFS = CreateObject("Scripting.FileSystemObject")

	Set objShell = CreateObject("WScript.Shell")

	

	strUnrar = Chr(34) + "C:Program Files (x86)WinRARunrar.exe" + Chr(34)

	strUnrarArgs = " x -inul -y"

	strRarFolder = BrowseFolder("",False)

	

	If strRarFolder = "" Then

		WScript.Quit(0)

	End If

	

	Set objFolder = objFS.GetFolder(strRarFolder)

	Set colSubfolders = objFolder.SubFolders

	For Each folders in colSubfolders

		intNrFolders = intNrFolders + 1

	Next

	

	intNrFolders = CStr(intNrFolders)

	

	strTxt = "Will extract archives from " + intNrFolders + " folders. This may take a while! Wait for the completetion dialog to appear before accessing the extracted files."

	answer = MsgBox(strTxt,1,"unrar script")

	If answer = 2 Then

		WScript.Quit(0)

	End If

	

	For Each objSubfolder in colSubfolders

		Set colFiles = objSubfolder.Files

		Set objRE = New RegExp

		objRE.Global     = True

		objRE.IgnoreCase = False

		objRE.Pattern    = ".rar"

		For Each objFile In colFiles

			bMatch = objRE.Test(objFile.Name)

	   		If bMatch Then

				files = files + 1

	      		strUnrarFileCmd = strUnrar + strUnrarArgs + " " + objSubfolder + "" + objFile.Name + " " + strRarFolder

	      		objShell.Run strUnrarFileCmd,0,True

	   		End If

		Next

		If files = 0 Then WScript.Echo "No RARs at given location!"

	Next

	

	files = CStr(files)

	

	MsgBox ("Done! Extracted " + files + " archives.")

	

	Function BrowseFolder( myStartLocation, blnSimpleDialog )

	' This function generates a Browse Folder dialog

	' and returns the selected folder as a string.

	'

	' Arguments:

	' myStartLocation   [string]  start folder for dialog, or "My Computer", or

	'                             empty string to open in "DesktopMy Documents"

	' blnSimpleDialog   [boolean] if False, an additional text field will be

	'                             displayed where the folder can be selected

	'                             by typing the fully qualified path

	'

	' Returns:          [string]  the fully qualified path to the selected folder

	'

	' Based on the Hey Scripting Guys article

	' "How Can I Show Users a Dialog Box That Only Lets Them Select Folders?"

	' http://www.microsoft.com/technet/scriptcenter/resources/qanda/jun05/hey0617.mspx

	'

	' Function written by Rob van der Woude

	' http://www.robvanderwoude.com

	    Const MY_COMPUTER   = &H11&

	    Const WINDOW_HANDLE = 0 ' Must ALWAYS be 0

	

	    Dim numOptions, objFolder, objFolderItem

	    Dim objPath, objShell, strPath, strPrompt

	

	    ' Set the options for the dialog window

	    strPrompt = "Select a folder with RARs:"

	    If blnSimpleDialog = True Then

	        numOptions = 0      ' Simple dialog

	    Else

	        numOptions = &H10&  ' Additional text field to type folder path

	    End If

	    

	    ' Create a Windows Shell object

	    Set objShell = CreateObject( "Shell.Application" )

	

	    ' If specified, convert "My Computer" to a valid

	    ' path for the Windows Shell's BrowseFolder method

	    If UCase( myStartLocation ) = "MY COMPUTER" Then

	        Set objFolder = objShell.Namespace( MY_COMPUTER )

	        Set objFolderItem = objFolder.Self

	        strPath = objFolderItem.Path

	    Else

	        strPath = myStartLocation

	    End If

	

	    Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _

	                                              numOptions, strPath )

	

	    ' Quit if no folder was selected

	    If objFolder Is Nothing Then

	        BrowseFolder = ""

	        Exit Function

	    End If

	

	    ' Retrieve the path of the selected folder

	    Set objFolderItem = objFolder.Self

	    objPath = objFolderItem.Path

	

	    ' Return the path of the selected folder

	    BrowseFolder = objPath

	End Function

[Image Can Not Be Found]

[Image Can Not Be Found]

[Image Can Not Be Found]

Sen får man AnimeXYZ.COMPLETE.S02.DVDRip.XviDAnimeXYZ.S02E0*.DVDRip.XviD-OMGBBQ.avi osv.

Som med alla andra vbskript så är det mycket som är stulet från lite överallt, men det fungerar. 😛