Распаковка архивов
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Распаковка выбранных архивов и/или архивов в структуре выбранных каталогов
' в одноимённые папки рядом с архивами (при наличии в них более одного элемента)
' c автоматическим переходом в случае распаковки одного архива
' Условие: необходима текущая версия утилиты 7z.exe
' Параметры:
' 1. %WL (обязательный)
' 2. <расширения архивов (в т.ч. двойные) через "|"> ("" - все поддерживаемые)
' 3. <флаг распаковки одиночных элементов без подкаталогов: 1>
' 4. <пропустить/перезаписать существующие/переименовать извлекаемые файлы: s/a/u>
' 5. <флаг удаления удачно распакованных архивов: 1>
' 6. <флаг распаковки зашифрованных архивов: 1>
' Примеры: %WL | %WL "" 1 | %WL 7z|7zip|arj|bzip2|rar|tar.bz2|zip | %WL "" 1 s 0 1
Option Explicit : Dim Z7, PWTrue
'••••••••• Путь к утилите 7z.exe •••••••••
Z7 = "%COMMANDER_PATH%\Utils\7-Zip\7z.exe"
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••
Dim A, C, Filt, One, Mode, Del, Passw, List, WSS, FSO, Pass
Set A = WSH.Arguments : C = A.Count: If C = 0 Then WSH.Quit
If C > 1 Then Filt = LCase(A(1)) : If C > 2 Then One = A(2)
If C > 3 Then Mode = "-ao" & A(3): If C > 4 Then Del = A(4): If C > 5 Then Passw = A(5)
List = A(0): Set WSS = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
If InStrRev(LCase(WSH.FullName), "wscript.exe") Then
Dim Par, Pars
For Par = 1 To C - 1
If A(Par) <> "" Then
Pars = Pars & " " & A(Par)
ElseIf C - 1 > Par Then Pars = Pars & " """""
End If
Next : WSS.Run "cscript.exe //NoLogo """ & WSH.ScriptFullName & """ " & List & Pars,0
If FSO.GetDrive(FSO.GetDriveName(WSH.FullName)).IsReady Then WSH.Sleep 500 : WSH.Quit
End If : Dim Reg, Prn, ShA, Fi, Ch, Cn, It : Set Reg = New Regexp
If FSO.FileExists(FSO.GetSpecialFolder(1) & "\oleprn.dll") Then _
Set Prn = CreateObject("OlePrn.OleCvt.1")
Set ShA = CreateObject("Shell.Application")
Reg.IgnoreCase = True : Reg.Pattern = "^(001|7z(|ip)|a|apm|arj?|bz(|ip)2|cab|cpio|ch[iqmw]" &_
"|cramfs|deb|dmg|docx?|e(sd|pub|xe|xt[234]?)|fat|gz(|ip)|hfsx?|hx[sirqw]|ihex|img|iso|jar|" &_
"li[bt]|l(zh|ma)|lha|mbr|ms(i|lz|sp)|mub|n(si|tf)s|od[st]|qcow(|2c?)|r00|rar|rpm|pkg|ppmd|" &_
"ppt|squashfs|scap|swm|t[agx]z|tar|tbz2?|u(d|efi)f|vdi|vhd|vmdk|wim|x(ar|lsx?|pi|z)|z|zipx?)$"
With FSO.OpenTextFile(List,,,-1)
Do : Fi = Trim(.ReadLine)
If Fi <> "" Then If FSO.FileExists("\\?\" & Fi) Then _
ForFile Fi, Ch, It, Cn Else ForFolder Fi, Ch, It, Cn
Loop Until .AtEndOfStream : .Close
End With
If Ch > 1 Then WSS.Popup "Распаковка завершена!", 1.4 , " Результат", 64
If Ch = 1 Then If FSO.FileExists(It) Or FSO.FolderExists(It) Then _
If Cn > 1 And FSO.FolderExists(It) Then It = FSO.GetParentFolderName(It) End If :_
WSS.Exec """%COMMANDER_EXE%"" /A /S /O /L=""" & Replace(It, "\\?\", "") & """"
If FSO.FileExists(List) Then FSO.DeleteFile List
Sub ForFile(Arch, T, F1, Sum)
Dim Ext, BN, Ex, Exe, Item : Ext = LCase(FSO.GetExtensionName(Arch))
BN = FSO.GetBaseName(Arch) : Ex = LCase(FSO.GetExtensionName(BN))
Ex = Len(Ex) * InStr("|" & Filt & "|", "|" & Ex & "." & Ext & "|")
If (Filt = "" Or Ex Or InStr("|" & Filt & "|", "|" & Ext & "|")) And Reg.Test(Ext) Then
PWTrue = 1 : If Passw = 1 Then GetPass Arch, "" : If PWTrue = 0 Then Exit Sub
Set Exe = WSS.Exec("%comspec% /c chcp 1251|""" & Z7 & """ l -slt" &_
" """ & Arch & """ -sccUTF-8 -p" & Pass & "|find /v ""\""")
Dim i, Itm : For i = 1 To 8 : Exe.StdOut.SkipLine : Next : Sum = 0
If InStr(Exe.StdOut.ReadLine, "Errors:") = 1 Then Exit Sub
Do: Itm = Exe.StdOut.ReadLine
If i <> 1 Then
If Itm = "----------" Then i = 1
ElseIf InStr(Itm, "Path = ") = 1 Then
If Sum = 1 Then Sum = 2 : Exit Do
Item = Replace(Itm, "Path = ", "") : Sum = 1
ElseIf Itm = "Encrypted = +" And Passw <> 1 Then Exit Sub
End If
Loop Until Exe.StdOut.AtEndOfStream
If Sum = 0 And Ext = "zip" And Len(Arch) < 260 Then
Dim Items : Set Items = ShA.NameSpace(Arch).Items
Sum = Items.Count : If Sum Then Item = Items.Item(0)
End If
If Sum > 0 Or FSO.GetFile(LPath(Arch)).Size Then
Dim P, Fd, NF : P = FSO.GetParentFolderName(Arch) : Fd = P & "\" & BN
If IsObject(Prn) Then Item = Prn.ToUnicode(Item,65001) Else UTF8 Item
If Sum = 1 And (One = "1" Or BN = Item) Then NF = P Else NF = Fd
WSS.Run """" & Z7 & """ x """ & Arch & """ -o""" & NF &_
""" " & Mode & " -y -p" & Pass, 0, True : T = T + 1
F1 = NF & "\" & Item : LPath(F1) : LPath(Fd) : LPath(Arch)
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
ElseIf Sum = 1 Then 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
End If
End If
End Sub
Sub GetPass(Arc, Text)
If Len(WSS.Exec("""" & Z7 & """ t """ & Arc & """ -y -p" & Pass).StdErr.Read(1)) Then
PWTrue = 0 : Pass = InputBox(vbCr & "Архив: """ & Arc & """" & vbCr & vbCr &_
Text & vbCr & vbCr & "Введите пароль:", Space(30) & "Распаковка архивов", Pass)
If Len(Pass) Then Text = Space(40) & "Пароль неверен!" : GetPass Arc, Text
Else PWTrue = 1 End If
End Sub
Sub UTF8(Nm): Dim F
While Len(Nm) > 0
If Asc(Left(Nm,1)) >= 128 Then
If Asc(Left(Nm,1)) < 224 Then F = F & ChrW(S(Nm,2,64) + S(Nm,1,32)*64):_
Nm = Right(Nm, Len(Nm)-2) Else F = F & ChrW(S(Nm,3,64) + (S(Nm,2,32)+_
S(Nm, 1, 16)*64)*64) : Nm = Right(Nm, Len(Nm) - 3)
Else F = F & Left(Nm, 1) : Nm = Right(Nm, Len(Nm) - 1) End If
Wend : Nm = F
End Sub : Function S(Name, b, m) S = Asc(Mid(Name, b, 1)) Mod m End Function
Sub ForFolder(Fold, T, F1, Cnt)
Dim N : Set Fold = FSO.GetFolder(LPath(Fold))
For Each N In Fold.SubFolders : ForFolder N.Path, Ch, It, Cnt : Next
For Each N In Fold.Files : ForFile N.Path, Ch, It, Cnt : Next
End Sub
Function LPath(Obj)
LPath = Obj : If Len(Obj) > 259 And Left(Obj, 1) <> "\" Then LPath = "\\?\" & Obj
End Function
Что важно отметить?
Скрипт очень удобен, т. к. позволяет после распаковки автоматически переходить к нужному файлу или файлу в папке, если был распакован один архив.
Во время распаковки можно заниматься своими делами (в т.ч. в других окнах), и как будет всё готово, результат отобразится в панели ТС.
Для этого обязательно третьим параметром нужно указать 1 в качестве флага.
Если указать в качестве параметров %WL "" 1 s и поставить курсор на проверяемый архив, то в случае существования уже распакованного некогда элемента тут же произойдёт переход к нему без предварительной распаковки.
Это также удобно, когда используется последний параметр удаления архива и вы не знаете, что именно распаковано и как это искать самостоятельно.
Скрипт работает с длинными (260+) путями к архивам и каталогам их размещения.
Flasher
12.11.2014