Single Post - Рекурсивная распаковка

RecursiveUnpack.vbs

Code:

'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Распаковка выбранных архивов и/или архивов в структуре выбранных каталогов
' в одноимённые папки рядом с архивами (при наличии в них более одного элемента)
' c автоматическим переходом в случае распаковки одного архива

' Параметры:
' 1. %WL (обязательный)
' 2. <расширения архивов через запятую> ("" - все поддерживаемые)
' 3. <флаг распаковки одиночных элементов без подкаталогов: 1>
' 4. <пропустить/перезаписать существующие/переименовать извлекаемые файлы: s/a/u>
' 5. <флаг удаления распакованных архивов: 1>

' Примеры: %WL | %WL "" 1 | %WL 7z,7zip,arc,bzip2,rar,zip | %WL "" 1 s 1

' Автор - Flasher ©

'••••••••• Путь к утилите 7z.exe •••••••••
Z7 = "%COMMANDER_PATH%\Utils\7-Zip\7z.exe"
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••

Set A = WScript.Arguments : C = A.Count
Select Case C : Case 0 Quit : Case 2 Filt = A(1) : End Select
If C > 2 Then One = A(2) : If C > 3 Then Mode = "-ao" & A(3) : If C > 4 Then Del = A(4)
List = A(0) : Dim WSH : Set WSH = CreateObject("WScript.Shell")

If InStrRev(WScript.FullName, "WScript.exe") Then
For Par = 1 To C - 1
If A(Par) <> "" Then
Pars = Pars & " " & A(Par)
ElseIf C - 1 > Par Then Pars = Pars & " """""
End If
Next : WSH.Run "CScript.exe """ & WScript.ScriptFullName & """ " & List & Pars, 0 : Quit
End If

Set Dict = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
Exts = "zip,7z,7zip,arj,bz2,bzip2,cab,chm,chw,cpio,cramfs,deb,dmg,"&_
"doc,exe,fat,gz,gzip,hfs,hxs,iso,lha,lzma,mbr,msi,ntfs,ppt,rar,"&_
"rpm,scap,squashfs,swm,tar,taz,tbz,tbz2,tgz,vhd,wim,xar,xls,xz"
For Each E in Split(Exts, ",") : Dict.Add E, "" : Next
If Not Len(Filt) Then Filt = Exts

With FSO.OpenTextFile(List,,,-1)
Do Until .AtEndOfStream
F = Trim(.ReadLine)
If F <> "" Then
If FSO.FolderExists(F) Then ForFolder FSO.GetFolder(F), Ch, It Else ForFile F, Ch, It
End If
Loop : .Close
End With : Set Dict = Nothing
If Ch = 1 Then WSH.Exec "%COMMANDER_EXE% /S /O /L=""" & It & "\:"""
If Ch > 1 Then WSH.Popup "Распаковка завершена!", 1.4 , " Результат", 64

Sub ForFolder(Folder, T, F1)
For Each N In Folder.SubFolders : ForFolder N, Ch, It : Next
For Each N In Folder.Files : ForFile N, Ch, It : Next
End Sub

Sub ForFile(Arch, T, F1)
For Each Fi in Split(Filt,",")
If StrComp(Fi, FSO.GetExtensionName(Arch), 1) = 0 And Dict.Exists(LCase(Fi)) Then
Set Exe = WSH.Exec("%comspec% /c chcp 1251 | """ & Z7 & """ l " &_
"-slt """ & Arch & """ -sccUTF-8| find ""Path = ""| find /v ""\""")
Item = Replace(Exe.StdOut.ReadLine, "Path = ", "")
Sum = 0 : If Item <> "" Then Sum = 1
If Exe.StdOut.ReadLine <> "" Then Sum = 2
If Sum > 0 Then
BN = FSO.GetBaseName(Arch) : P = FSO.GetParentFolderName(Arch)
With CreateObject("ADODB.Stream")
.Type = 2 : .Open : .Charset = "windows-1251" : .WriteText Item
.Position = 0 : .Charset = "UTF-8" : Item = .ReadText : .Close
End With : Fd = P & "\" & BN
If Sum = 1 And (One = "1" Or BN = Item) Then NF = P Else NF = Fd
F1 = NF & "\" & Item
WSH.Run """" & Z7 & """ x """ & Arch & """ -o""" &_
NF & """ " & Mode & " -y -p", 0, True : T = T + 1
If FSO.FileExists(F1) Then
If Del = 1 And Sum = 1 Then FSO.DeleteFile Arch, 1
ElseIf FSO.FolderExists(F1) Then
If FSO.GetFolder(F1).Size Then
If Del = 1 And Sum = 1 Then FSO.DeleteFile Arch, 1
Else FSO.DeleteFolder F1, 1
End If
ElseIf FSO.FolderExists(Fd) Then
If FSO.GetFolder(Fd).Size Then
If Del = 1 Then FSO.DeleteFile Arch, 1
Else FSO.DeleteFolder Fd, 1
End If : F1 = Fd
End If : Exit For
End If
End If
Next
End Sub : Sub Quit : Set WSH = Nothing : Set FSO = Nothing : WScript.Quit : End Sub