Single Post - Распаковка и развертывание избыточной вложенности папок

вариант оптимальнее:

Code:

'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' 1) Перемещение в активную панель одиночных элементов из выбранных каталогов
' с последующим удалением этих каталогов и автопереименованием элементов
' при существование одноимённых элементов другого размера
' 2) Распаковка выбранных архивов в одноимённые папки активного каталога,
' при наличии в них одного элемента (каталога или файла) - в активную панель
' 3) Автоматический переход к перемещённому каталогу или файлу
' в случае обработки одной папки или архива

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

' Примеры: %WL | %WL s 1

' Автор - Flasher ©

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

Set A = WScript.Arguments : C = A.Count : If C = 0 Then WScript.Quit
If C > 1 Then Mode = "-ao" & A(1) : If C > 2 Then Del = A(2)
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
WScript.Quit
End If

Set ShA = CreateObject("Shell.Application")
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
With FSO.OpenTextFile(List,,,-1)
Do Until .AtEndOfStream
F = Trim(.ReadLine)
If F <> "" Then
If FSO.FolderExists(F) Then
Set Folder = ShA.NameSpace(F) : Set Items = Folder.Items
Cn = Items.Count
If Cn = 1 Then
Set Name = Items.Item(0)
F1 = FSO.GetParentFolderName(F) & "\" & Name
If Not FSO.FileExists(F1) Or _
(FSO.FileExists(F1) And Name.Size <> FSO.GetFile(F1).Size) Then
ShA.NameSpace(Folder.ParentFolder).CopyHere Items, 28 : T = T + 1
End If
End If : If Cn < 2 Then FSO.GetFolder(F).Delete
ElseIf Dict.Exists(LCase(FSO.GetExtensionName(F))) Then
Set Exe = WSH.Exec("%comspec% /c chcp 1251 | """ & Z7 & """ l" &_
" -slt """ & F & """ -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
P = FSO.GetParentFolderName(F) : Fd = P & "\" & FSO.GetBaseName(F)
If Sum = 1 Then NF = P Else NF = Fd
WSH.Run """" & Z7 & """ x """ & Arch & """ -o""" &_
NF & """ " & Mode & " -y -p", 0, True : T = T + 1
With CreateObject("ADODB.Stream")
.Type = 2 : .Open : .Charset = "windows-1251" : .WriteText Item
.Position = 0 : .Charset = "UTF-8" : Item = .ReadText : .Close
End With : F1 = NF & "\" & Item : If Del = 1 Then FSO.DeleteFile F, 1
If Not FSO.FileExists(F1) And Not FSO.FolderExists(F1) And _
FSO.FolderExists(Fd) Then F1 = Fd
End If
End If
End if
Loop
End With
If T > 1 Then WSH.Popup "Распаковка завершена!", 1.4 , " Результат", 64
If T = 1 Then WSH.Exec """%COMMANDER_EXE%"" /S /O /L=""" & F1 & "\:"""