Модераторы: Avada, CaptainFlint, Nik, d-view, Моторокер
Учтём'c.Iori писал(а):По ходу дела ARJ не создаёт А00, a сразу переходит на А01.
А вот такие надо автору скидывать в любом случае. Так что кидай, если есть.Iori писал(а):но мне не попался не один архив с данными расширениями который я смог открыть.
Не. Ты их потёр, судя по всему. Я все твои пересылки в одной папке складирую. Так что если есть что-то ещё из списка, заливай. И лучше после всех поисков. Нет смысла в малых порциях.Iori писал(а):Помню много из списка я уже пересылал.
Код: Выделить всё
HFS, LZX, IPG, GZI, BOZ, ECS, EDZ, GZI, MCGAME, RELOC, REV, S7Z, SDN, VOCA, VSI, XIP, ZPI, 
Дело встало на том, что, протестировав ряд файлов, я понял, что псевдо-распаковка действует в отношении несметного их количества. На том руки сперва и опустились, т. к. тормозить с поисками на полпути желания не изьявилось. Вот и пришло время засесть за рутинные тесты. Дельце, мягко говоря, не для слабонервных. Протестировав ряд офисных типов, порой натыкаясь то и дело на открываемые прогой файлы и пройдясь по потенциальным онлайн-спискам, пришёл к выводу, что осилить всё это изобилие возможности не представляется ровным счётом никакой.Код: Выделить всё
'•••••••••••••••••••••••••••••••••••••• VBS ••••••••••••••••••••••••••••••••••••••
' Распаковка выбранных архивов и/или архивов в структуре выбранных каталогов
' в одноимённые папки рядом с архивами (при наличии в них более одного элемента)
' c автоматическим переходом в случае распаковки одного архива
' Условие: необходима текущая версия утилиты 7z.exe
' Параметры:
' 1. %WL (обязательный)
' 2. <расширения архивов (в т.ч. двойные) через "|"> ("" - все поддерживаемые)
' 3. <пропустить/перезаписать существующие/переименовать извлекаемые файлы: s/a/u>
' 4. Суммируемые значения опций:
' 1 = Распаковка зашифрованных архивов.
' 2 = Удаление удачно распакованных архивов.
' 4 = Не распаковывать архивы нулевой структуры.
' 8 = Обработка всей структуры выбранных каталогов.
' 16 = Распаковка одиночных элементов без подкаталогов.
' Примеры: %WL | %WL "" a | %WL 7z|7zip|arj|bzip2|rar|tar.bz2|zip u | %WL "" s 25
Option Explicit : Dim Z7
'••••••••• Путь к утилите 7z.exe •••••••••
Z7 = "%COMMANDER_PATH%\Utils\7-Zip\7z.exe"
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••
Dim A, C, Filt, O, Mode, List, WSS, FSO, Pass, PWTrue
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 Mode = " -ao" & A(2) : If C > 3 Then O = A(3)
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, Cvt, ShA, Fi, Ch, Cn, It : Set Reg = New Regexp
If FSO.FileExists(FSO.GetSpecialFolder(1) & "\oleprn.dll") Then _
Set Cvt = CreateObject("OlePrn.OleCvt.1")
Set ShA = CreateObject("Shell.Application")
Reg.IgnoreCase = True : Reg.Pattern = "^([A-z\d]+_|00[01]|7z(|ip)|a(01|rj?|rduboy|p[km]|sd" &_
"|zw2|zz)|b(64|doc|in|oz|ps|up|z(|ip)2?)|c(ab|apx|b[7crtz]|bds|h[iqmw]|ompPkg_Hauptwerk_ra" &_
"r|pgz|pio|ramfs|rx)|d((a|ock)zip|eb|esktop|ylib|mg|mm[ptx]|o[ct][mx]?|p[st]|z)|e(cs|dz|f[" &_
"iw]|rx|sd|pub|tt?|xe|xt[234]?)|fat|g(adgeprj|bp|g|(|nu)tar|nm|numeric|z(|ip?)2?)|(graph|h" &_
"t|p)mlz|h(cl|fsx?|mxz|tb|x[iqrsw])|i(5[sz]|as|hex|m[agz]|p[agk]?|psw|s[ox]|ta)|jar|jgz|l(" &_
"i[bt]|ibzip|z([oh]?|ma)|ha|qm|xf)|m(br|ct|cgame|world|ht(ml)?|pz(ip)?|s[ioptu]|slz|st14|u" &_
"[bi])|n(ex|fl|otebook|(si|tf)s|th)|o(bb|d[bfgpst]|ebzip|ex|nepkg|rb|sz|t[pst]|va|z)|p(ax|b"&_
"i[tx]|cv|et|i[mz]|k[34g]|mv|[op]t[xm]?|p[as][mx]?|p?md|r[dvx]|ro[45]x|sz|ub)|qcow(|2c?)|qu"&_
"iz|quox|[rs]00|r(0|ar5?|pm|p9|z)|s(7z|cap|[dtx]c|[dtx]w|d[adz]|f[sx]|l[ex]|m[fz]|nb|ob|qua"&_
"shfs|t[di]|uite|wm|x[dim])|t(ar(dist)?|[abglx]z|bs|bz2|g|hmx|lb|lzma|wz(ip)?|xtz)|u(3p|box"&_
"|deb|df|efif|os|seq|ue)|v(di|hd|i[mp]|mdk|oca|or|s(content|d|ix?|s[mx])|ym)|w(b?a|bk|db|eb"&_
"z|im|p[st]|sb|w[dps])|x(apk|ar|l(am?|s[bmx]?|t[mx]?|r|w)|p[is]|zm?|xe)|z(ad|i?|ipx?|m9|pi))$"
Dim RgE : Set RgE = New RegExp : RgE.MultiLine = True : RgE.Global = True
Dim Rgx : Set Rgx = New RegExp : Rgx.MultiLine = True : Rgx.Global = True
Dim REx : Set REx = New RegExp : REx.MultiLine = True : REx.Global = True
RgE.Pattern = "^Path = (\.?\\)?([^\\\r\n]+\.exe)$"
Rgx.Pattern = "^Path = (\.?\\)?([^\\\r\n]+)$"
REx.Pattern = "^Size = ([1-9]\d*)?$"
With FSO.OpenTextFile(List,,,-1)
Do : Fi = Trim(.ReadLine)
If Fi <> "" Then If FSO.FileExists("\\?\" & Fi) Then _
ForFile Fi, Ch, It, Cn Else If (O And 8) = 8 Then ForFolder Fi, Ch, It, Cn
Loop Until .AtEndOfStream : .Close
End With
'msgBox Timer - TT & VbCr & "Архивов: " & Ch & VbCr & "Сумма эл-в: " & Ch ': WSH.Quit
If Ch > 1 Then WSS.Popup "Распаковка завершена!", 1.4 , " Результат", 64 : WSH.Quit
If Ch = 1 Then If FSO.FileExists(It) Or FSO.FolderExists(It) Then If Cn > 1 And _
FSO.FolderExists(It) And Right(It, 1) <> "\" 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 (O And 1) = 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)
Dim All : All = Split(Exe.StdOut.ReadAll, "----------")(1)
If InStr(All, vbLf & "Errors:" & vbCr) Then Exit Sub
If (O And 1) = 0 Then If InStr(All, vbLf & "Encrypted = +" & vbCr) Then Exit Sub
Dim Exec, Sz, Szs, Size : Set Exec = Rgx.Execute(All) : Sum = Exec.Count
For Each Sz in REx.Execute(All)
Szs = Sz.Submatches(0) : If Len(Szs) Then Size = CDbl(Size) + Szs
Next : If (O And 4) = 4 And CDbl(Size) = 0 And Ext <> "bz" Then Exit Sub
If RgE.Test(All) Then Item = RgE.Execute(All)(0).SubMatches(1) Else _
If Sum Then Item = Rgx.Execute(All)(0).SubMatches(1)
If Sum < 2 And Size > 0 Then
With New RegExp
Dim IsExe: .Pattern = "\nPath = (\.?\\)?([^\\\r\n]+\.exe)" : Sum = 1
If .Test(All) Then Item = .Execute(All)(0).SubMatches(1) : IsExe = 1
.Pattern = "\nPath = (\.?\\)?([^\\\r\n]+)"
If .Test(All) Then
Dim Col : .Global = True : Set Col = .Execute(All)
If Not IsExe Then Item = Col(0).SubMatches(1)
If Item <> Col(Col.Count - 1).SubMatches(1) Then Sum = 2
Else Sum = 2 End If
End With
End If
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)
For Each I in Items : Size = CDbl(Size) + I.Size : Next
End If
If Sum > 0 Or FSO.GetFile(LPath(Arch)).Size > 0 Then
Dim P, Fd, NF : P = FSO.GetParentFolderName(Arch) : Fd = P & "\" & BN
If IsEmpty(Cvt) Then UTF8 Item Else Item = Cvt.ToUnicode(Item, 65001)
If Sum = 1 And ((O And 16) = 16 Or BN = Item) Then NF = P Else NF = Fd
F1 = LPath(NF & "\" & Item)
Dim FdExist: FdExist = Not FSO.FolderExists(LPath(Fd))
Dim F1Exist: F1Exist = Not (FSO.FileExists(F1) And FSO.FolderExists(F1))
If Sum > 1 And Not F1Exist Then NF = NF & "_" & Ext : F1 = LPath(NF & "\" & Item)
WSS.Run """" & Z7 & """ x """ & Arch & """ -o""" &_
NF & """" & Mode & " -y -p" & Pass, 0, True
Dim Fl, FE : Fd = LPath(Fd) : T = T + 1
Select Case True
Case FSO.FileExists(F1) And Sum = 1 Set Fl = FSO.GetFile(F1) : FE = F1Exist
Case FSO.FolderExists(F1) And Sum = 1 Set Fl = FSO.GetFolder(F1) : FE = F1Exist
Case FSO.FolderExists(Fd) Set Fl = FSO.GetFolder(Fd) : FE = FdExist :_
If Sum = 1 Then F1 = Fd
End Select : SZ = Fl.Size : P = Len(Szs) > 0 And CDbl(Size) <> SZ
If FE And (P Or ((O And 4) = 4 And SZ = 0)) Then
If (Fl.Attributes And 1) = 1 Then Fl.Attributes = 0
Fl.Delete : T = T - 1
End If : If (O And 2) = 2 And P Then FSO.DeleteFile LPath(Arch), 1
End If
End If
End Sub
Sub GetPass(Arc, Text)
Dim Test, Tm : Set Test = WSS.Exec("""" & Z7 & """ t """ & Arc & """ -y -p" & Pass)
Tm = Timer : Do While Timer - Tm < 0.1 : If Test.Status Then Exit Do End If : Loop
If Not Test.Status Then Test.Terminate
If Len(Test.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Тут вот появилось дополнение, не получится задействовать?Flasher писал(а):Не поддерживаемые:
... LZ ...
Во избежание недопониманий.Есть. Посмотрим. Т.е. там всего 5 кодеков. Не густо.Skif_off писал(а):взгляни в версии для печати, если есть интерес.
Было пару раз (1, 2). Помню только вторую тему, и опять же думал, что это фикс Dec'а.Skif_off писал(а):Вроде бы и тут обсуждалось, на примере Codecs.7z
Код: Выделить всё
ext:boz;bup;capt;cbc;dockzip;edz;gbp;hcl;lqm;notebook;oebzip;orb;pro4x;pro5x;sle;smz;tbs;ubox;useq;webz;zpiuosЕсли найдёт что-то
Думал такое, но решил дать тебе время и не приставать со скриптом распаковки. Рад что ты вернулся.Flasher писал(а):Если подумал, что я куда-то и, может, навсегда исчез, то ошибся.
Flasher писал(а):2. BIN/EFI ещё раз посмотри.
Проверю.Flasher писал(а):Найдёшь время на поиск непроверенного?
Удаляет после распаковки точнее, да в рабочий каталог к тому же. Исправил.Iori писал(а):Не распаковывает ехешник.
Начни пока с общей просьбы под All.Iori писал(а):Проверю.
