View previous topic :: View next topic |
Author |
Message |
helb
Joined: 08 Oct 2014 Posts: 57
|
(Separately) Posted: Mon Nov 03, 2014 20:33 Post subject: Распаковка и развертывание избыточной вложенности папок |
|
|
Требовалось решение проблемы с распаковкой вслепую (Alt+F9), когда неизвестно, что в корне архива и можно получить или избыточные вложенные директории или кучу файлов скопом, где не нужно, а также развертывание само по себе.
Скрипт в одно нажатие:
1) Файлы отдает 7zip'у на распаковку в папку с именем архива и применяет к образовавшимся папкам второе;
2) Папки развертывает по принципу: если внутри всего один объект, перемещать на уровень вверх и удалять пустую (своего рода Flatten directories)
По окончании, если потребовались действия, выдает информацию о перемещенных объектах и/или конфликтах. Я повесил на F9 и использую с 7zG.exe (отображает прогресс)
unpack-unfold.vbs:
Code: |
'============================================================
' Распаковка и развертывание избыточной вложенности папок (by helb)
' Указанные в списке: архивы — распаковывает в одноимённые папки с развертыванием, папки — развертывает (пустые удаляет)
' Параметры: <listfile> ["<path>"] (если путь не указан, распаковывает в место нахождения архива)
' TC: %WL "%P"
'====================== Путь к 7z/7zG =======================
tool = "B:\Progs\Archivers\7-Zip\7zG.exe"
'============================================================
with WScript.Arguments
if .Count = 0 then WScript.Quit
List = .Item(0)
if .Count > 1 then Path = .Item(1) else Path = ""
end with
if Right(Path, 1) <> "\" and Path <> "" then Path = Path & "\"
set FSO = CreateObject("Scripting.FileSystemObject")
set sh = CreateObject("WScript.Shell")
conflicts = "" : unfolded = 0
for each F in Split(FSO.OpenTextFile(List, 1, false, -1).ReadAll, vbNewLine)
if objExists(F) > 0 then
if FSO.FileExists(F) then 'archive(file)
if Path <> "" then BN = Path else BN = FSO.GetParentFolderName(F) & "\"
BN = BN & FSO.GetBaseName(F) : NN = BN : n = 0
do while FSO.FolderExists(NN)
n = n + 1
NN = BN & " (" & n & ")"
loop
sh.Run tool & " x """ & F & """ -o""" & NN & "\"" -y", 8, true
else 'folder
NN = F
if Right(NN, 1) = "\" then NN = Left(NN, Len(NN)-1)
end if
if FSO.FolderExists(NN) then
cnt = (FSO.GetFolder(NN).Files).Count + (FSO.GetFolder(NN).SubFolders).Count
if cnt = 1 then
set fObjs = FSO.GetFolder(NN).Files
if fObjs.Count = 0 then set fObjs = FSO.GetFolder(NN).SubFolders
for each fObj in fObjs
targetPath = fObj.ParentFolder.ParentFolder & "\"
if fObj.Name = fObj.ParentFolder.Name then
set parent = FSO.GetFolder(fObj.ParentFolder)
FSO.CreateFolder(targetPath & "DCF8E1E9-F66B-4C95-A4E7-47B9591DADBA")
fObj.Move(targetPath & "DCF8E1E9-F66B-4C95-A4E7-47B9591DADBA\")
parent.Move(targetPath & "DCF8E1E9-F66B-4C95-A4E7-47B9591DADBA_t")
fObj.Move(targetPath)
FSO.DeleteFolder targetPath & "DCF8E1E9-F66B-4C95-A4E7-47B9591DADBA", true
parent.Delete(true)
unfolded = unfolded + 1
elseif objExists(targetPath & fObj.Name) > 0 then
conflicts = conflicts & fObj.Name & vbNewLine
else
fObj.Move(targetPath)
FSO.DeleteFolder NN, true
unfolded = unfolded + 1
end if
next
elseif cnt = 0 then
FSO.DeleteFolder NN, true
unfolded = unfolded + 1
end if
end if
end if
next
if conflicts <> "" or unfolded > 0 then WScript.Echo("Unfolded: " & unfolded & vbNewLine & "Conflicts: " & vbNewLine & conflicts)
'0=not exists, 1=is file, 2=is folder
function objExists(name)
if FSO.FileExists(name) then
objExists = 1
elseif FSO.FolderExists(name) then
objExists = 2
else
objExists = 0
end if
end function
|
|
|
Back to top |
|
 |
Nick
Joined: 26 Dec 2014 Posts: 107
|
(Separately) Posted: Fri Dec 26, 2014 20:47 Post subject: |
|
|
Выходит с ошибкой
Строка: 28
Символ 11
Ошибка: Не удается найти указанный файл
...
Источник: (null)
TC 8.51a x64 |
|
Back to top |
|
 |
Flasher

Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Fri Dec 26, 2014 21:15 Post subject: |
|
|
Nick
Сперва вопрос - какая задача поставлена?
Я могу предложить (по аналогии с этим)
 вариант оптимальнее: 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 & "\:""" |
_________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|
Back to top |
|
 |
Nick
Joined: 26 Dec 2014 Posts: 107
|
(Separately) Posted: Mon Dec 29, 2014 16:36 Post subject: |
|
|
Flasher wrote: | Nick
Сперва вопрос - какая задача поставлена? |
Распаковать все выделенные архивы через WinRAR в активную панель.
Каждый архив должен распаковываться в отдельную папку (с именами архивов).
Опционально:
Если в начальной папке, подпапка и родительская папка – одинаковые, то оставить одну. (Например: «Новая папка\Новая папка\file.txt», то оставить только одну («Новая папка\file.txt)).
ИЛИ
Опционально:
Если архив уже содержит внутри такое же название папки как и самого архива, то применить распаковку в текущую папку, если нет – распаковать в папку с именем архива. Т.е. какая-то проверка еще до разархивирования.
(Но этот вариант, наверно сложнее и возможно дольше будет выполняться.) |
|
Back to top |
|
 |
Flasher

Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Mon Dec 29, 2014 16:42 Post subject: |
|
|
Nick
Так и думал, что только архивов касается. Тогда в тему по приведённой ссылке и переносимся. _________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|
Back to top |
|
 |
|
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|