Рекурсивная пофайловая упаковка

shveicar

Здравствуйте, Данная Тема является продолжением темы и в виду её детализации - вынесена отдельно. Моя задача заключается в следующем и если скрипт для этой цели может быть создан, просьба добавить в его параметры возможность создания следующих пунктов -

1) выбор типа архива(rar, zip, sfx)

2) фильтр-список расширений файлов (.jpg, .avi и др)

3)параметры упаковки (выбор степени сжатия, возможность установки пароля, и поддержки функции удаления файлов после архивирования).

Еще раз повторюсь(во избежании недоразумений), каждый создаваемый архив должен помещаться в ту-же папку, где лежит исходный (архивируемый) файл, независимо от глубины вложенности. Архив должен иметь имя исходного файла (без расширения) Пример- файл.flv - после архивации будет иметь имя файл.rar Ну и главное, каждый файл должен быть упакован в свой архив, архивация желательно в фоне, и должна иметь последовательный (во избежании перегрузки процессора) тип. Заранее Благодарен, надеюсь на понимание.

Flasher

shveicar писал(а):Архив должен иметь имя исходного файла (без расширения)

Этот момент не смущает?:

Flasher писал(а):в один архив могут положиться только те файлы, которые лежать в одной папке и имеют одно базовое имя

shveicar

Flasher писал(а):Этот момент не смущает?:в один архив могут положиться только те файлы, которые лежать в одной папке и имеют одно базовое имя

Если я правильно понимаю: речь идет о возможном совпадении одинаковых имен файлов, с разными расширениями, которые при архивации дадут одинаковые имена архивов.( типа файл.jpg и файл.avi). Если да, то

1) В скрипте же будет опция выбора расширений типов файлов. - (надо-же смотреть что архивируется)

2) и почему-бы не добавить в скрипт опцию ошибка (одинаковые имена) + возможность пропустить, остановить или продолжить, (или это слишком сложно)?

Спасибо.

Flasher

1) Но она не обязательная. Фильтра может не быть, как в примере ранее обсуждаемого скрипта. А если фильтр (допустим, flv,wmv) и есть, то всё равно могут быть совпадения (имя.flv, имя.wmv).
2) Пропустить не знаю как, продолжение и выход организовать можно. Я предлагаю так: если базовое имя архива совпадает с базовым именем файла, то упаковывать в архив с полным именем файла.

shveicar

Flasher писал(а):Я предлагаю так: если базовое имя архива совпадает с базовым именем файла, то упаковывать в архив с полным именем файла.

Тоже грамотное решение, - пусть будет так.

Flasher

Ну, что ж. Пробуем.

Код: Выделить всё

'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Упаковка каждого выделенного файла или файла в структуре выделенных
' каталогов в отдельный архив

' Параметры (! - обязательный): 
'  1. <путь к списку элементов> (!)
'  2. "<путь назначения>\" (!) (если установить "", то рядом с исходником,
'     если написать "имя папки", то в папку рядом с исходником;
'  3. <расширение архива> (!)
'  4. <фильтр-список расширений файлов> 
'     разделитель - запятая (если задействован 5., то - !)
'  5. <параметры упаковки>

' Примеры:
'  1) %L "" zip
'  2) %L "%P" RAR
'  3) "C:\My Files\List.txt" 1 exe "" -sfx7zCon.sfx
'  4) %L "" rar "" -m5 -s -rr5p -pPASSWORD -ag_DD.MM.YY
'  5) %L "%T" ZIP "" -mx9 -mm=Deflate -mfb=258 -mcu=on -pSECRET 
'  6) %L "%T" 7Z avi,flv,wmv,mkv -mx9 -m0=LZMA2 -ssw -pПАРОЛЬ

' Автор - Flasher ©
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••

With WScript.Arguments
  On Error Resume Next
  List = .Item(0)
  P    = .Item(1)
  Ext  = .Item(2)
  If .Count > 3 Then Filt = .Item(3)
  If Len(List) > 0 And .Count < 3 Then
    MsgBox  "Не выполнено условие:" & vbnewline & "минимальное число параметров - 3",_
    vbExclamation, "       Рекурсивная пофайловая упаковка"
    Wscript.Quit
  End If
End With

If Err.Number > 0 Then
  MsgBox  "Не выбраны элементы для упаковки!", vbExclamation,_
  "         Рекурсивная пофайловая упаковка"
  Wscript.Quit
End If

Set Dict = CreateObject("Scripting.Dictionary")
  Exts = "7Z | 7ZIP | ZIP | RAR | GZIP | BZIP2 | XZ | EXE | WIM"
  For Each E in Split(Exts, " | ")
    Dict.Add Trim(E), ""
  Next
  If Not Dict.Exists(Ucase(Ext)) Then
    MsgBox "Указанное расширение """ & UCase(Ext) & """ не поддерживается!" & vbnewline &_
    vbnewline & "Список поддерживаемых расширений:" & vbnewline & Exts, vbExclamation,_
    "                    Рекурсивная пофайловая упаковка"
    WScript.Quit
  End If
Set Dict = Nothing

Set Args = CreateObject("Scripting.Dictionary")
  For Each A In WScript.Arguments
    i = i + 1
    Args.Add i, A
    If i > 4 Then S = S & " " & A
  Next
Set Args = Nothing

Dim WSH
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
SZIP = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%\Utils\Arch\7z.exe")
RAR  = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%\Utils\Arch\rar.exe")

With FSO.OpenTextFile(WScript.Arguments(0), 1)
  Do While Not .AtEndOfStream
    F = Trim(.ReadLine)
    If F > vbNullString Then
      If FSO.FolderExists(F) Then
        ForFolder FSO.GetFolder(F)
      Else ForFile F
      End If
    End If
  Loop
  .Close
End With

WSH.Popup "Упаковка завершена!", 1.4 , "Результат", 64
Set FSO = Nothing
Set WSH = Nothing
WScript.Quit

Sub ForFolder(Folder)
  Dim N
  For Each N In Folder.SubFolders
    ForFolder N
  Next
  For Each N In Folder.Files 
    ForFile N
  Next
End Sub

Sub ForFile(File)
  If Len(Filt) > 0 Then
    For Each Fi in Split(Filt,",")
      If StrComp(Fi,FSO.GetExtensionName(File),1) = 0 Then Run File
    Next
  Else Run File
  End If
End Sub

Sub Run(FF)
  If InStr(P, ":") > 0 Then
    Path = P
  Else
    PP = FSO.GetFile(FF).ParentFolder & "\" & P
    If FSO.FolderExists(PP) Then
      Path = PP & "\"
    Else Path = FSO.CreateFolder(PP) & "\"
    End If
  End If
  If Not FSO.FileExists(Path & FSO.GetBaseName(FF) & "." & Ext) Then
    Name = FSO.GetBaseName(FF) & "." & Ext
  Else
    Name = FSO.GetFileName(FF) & "." & Ext
    Const M = 1
    Do While FSO.FileExists(Path & Name)
      l = l + 1
      If l < 10^M Then
        PostFix = Right(String(M, "0") & l, M)
      Else
        PostFix = l
      End If
      Name = FSO.GetFileName(FF) & " (" & PostFix & ")." & Ext
    Loop
  End If
  If LCase(Ext) <> "rar" Then
    Pr = SZIP
    Param = "a """ & Path & Name & """ """ & FF & """" & S
  Else
    Pr = RAR
    Param = "a -ep1" & S & " """ & Path & Name & """ """ & FF & """"
  End If
  WSH.Run """" & Pr & """ " & Param, 0, True
End Sub

Опять же напоминаю об указании путей к 7z.exe/rar.exe в скрипте.
Add: немного косметики...

shveicar

Вот это другое дело. Завтра еще раз проверю на "больших" файлах - обязательно напишу, Большое спасибо. Единственное что можно добавить, что при параметрах ("%P" или "%T") при наличии в разных папках одинаковых (по расширению) файлов с одинаковыми именами, но с разным содержимом, - архивы создаются не полностью, то-есть пакуются файлы с меньшим содержимым (можно подумать, что скрипт идет по пути наименьшего сопротивления)

, но это мелочь, путаница может возникнуть только у того, кто начнет массовую упаковку, не проверив все содержимое. А так, в режиме (1) папки пробивает - влет(в смысле, архивирует при любой глубине).

Flasher

shveicar писал(а):Вот это другое дело.

Это не дело другое, это скрипт другой.

shveicar

Сегодня проверил, с "большими" файлами - порядок, единственная просьба, можно ли сделать, чтобы в ходе процесса архивирования, в трее, появлялось окно процесса, как например в этом скрипте или вообще, как либо обозначить процедуру архивирования,(конечно окно с "упаковка завершена" в конце выскакивает, но и само исчезает) иначе не понятно, идет процесс, закончен, или вообще ничего не происходит. (Это актуально если файлов много и они "крупные"). Спасибо.

Flasher

Консольные окна? Ну их.. Можно колонки включить - и будет слышен звук, сулящий об окончании. Окно я специально всплывающим сделал, чтобы глаза не мозолило, актуально для небольшого объёма файлов.
Не нравится исчезновение - меняем

Код: Выделить всё

WSH.Popup "Упаковка завершена!", 1.4 , "Результат", 64

на

Код: Выделить всё

MsgBox "    Упаковка завершена!", vbInformation, "      Рекурсивная пофайловая упаковка"

Нет, конечно, можно поменять в предпоследней строке 0 на 2, но я бы не советовал.

shveicar

Вот теперь порядок, Огромное Спасибо, Извиняюсь за недоразумение в предыдущей теме. А теперь- Можно и сплясать!!!

Batya · Сообщение **Batya** » Пн авг 08, 2011 11:21

Flasher писал(а): " Рекурсивная пофвйловая упаковка"

Опечатка.

Предложение - во втором параметре возможность использовать не только абсолютный, но и относительный путь.
Вместо

Код: Выделить всё

  If P <> "1" Then Path = P

пишем

Код: Выделить всё

  If InStr(P, ":") > 0 Then Path = P

и ниже

Код: Выделить всё

  If InStr(P, ":") = 0 Then Path = F1.ParentFolder & "" & P

Т.е. можно паковать в каталог, лежащий рядом с исходным файлом. Если каталог не надо, параметр указать пустым - "".

Совет - список расширений лучше указать один раз (на случай правки). Примерно так:

Код: Выделить всё

Set Dict = CreateObject("Scripting.Dictionary") 
  Exts = "7Z | 7ZIP | ZIP | RAR | GZIP | BZIP2 | XZ | EXE | WIM"
  For Each E in Split(Exts, " | ")
    Dict.Add LCase(Trim(E)), "" 
  Next 
  If Not Dict.Exists(Lcase(Ext)) Then 
    MsgBox "Указанное расширение """ & UCase(Ext) & """ не поддерживается!" & vbnewline &_ 
    vbnewline & "Список поддерживаемых расширений:" & vbnewline & Exts, vbExclamation,_ 
    "                    Рекурсивная пофайловая упаковка" 
    WScript.Quit 
  End If

Flasher

Batya писал(а):Предложение - во втором параметре возможность использовать не только абсолютный, но и относительный путь.

Не понял. Для чего это может понадобиться? Указал %P/%T и ладно.

Batya писал(а):Т.е. можно паковать в каталог, лежащий рядом с исходным файлом.

Что значит можно? Это и так можно. Строка 111.

Batya писал(а):и ниже

F1 объявляется в процедуре. Зачем строку с её участием наверх переносить?

Batya писал(а):Совет - список расширений лучше указать один раз (на случай правки).

Думаешь список увеличится? Что-то сомневаюсь. В общем-то, предложение здравое, хоть и мелочёвка, позже поправлю (там правда ты не учёл регистр - Exists(Ucase(Ext)). Тут ещё счётчик понадобился при совпадении полных имён при упаковке в один каталог.

Batya · Сообщение **Batya** » Пн авг 08, 2011 14:11

Flasher писал(а):Не понял. Для чего это может понадобиться?

Например, я хочу, чтобы для каждого выделенного файла архив создавался в папке Arc рядом с файлом.

Flasher писал(а):Что значит можно? Это и так можно. Строка 111.

Сейчас твой скрипт может создавать архив рядом с файлом, а я имел в виду в папке рядом.

Flasher писал(а):F1 объявляется в процедуре. Зачем строку с её участием наверх переносить?

Не надо переносить. Имелось в виду, также поменять соответствующую строку (ту самую 111-ю) ниже.

Flasher писал(а):там правда ты не учёл регистр - Exists(Ucase(Ext)

Учёл:

Batya писал(а):Dict.Add LCase(Trim(E)), ""

Flasher

Batya писал(а):для каждого выделенного файла архив создавался в папке Arc рядом с файлом.

Тогда ещё эту папку и создавать придётся, если её нет. Упаковщики сами этого, по-моему, не делают.

Batya писал(а):а я имел в виду в папке рядом

Всё, въехал. Подумаю.
Add: Остановлюсь, пожалуй, на одной дополнительной папке вместо относительного пути. Для создания вложенных цикл нужен, не хочу этим перегружать скрипт.

Batya писал(а):Имелось в виду, также поменять соответствующую строку (ту самую 111-ю) ниже.

Понятно. Я воспринимаю "ниже" как "следом" или "под".

Batya писал(а):Учёл:

Хм. Точно. Тогда уж проще без лишнего, просто заменить одну букву, как я написал.