Total Commander Knowledge Base

Есть вопрос?

Поищите ответ в самой большой русскоязычной базе знаний по Total Commander!

Архивирование выбранных в панели элементов

Q: Возможно ли сделать по умолчанию, чтобы при упаковке однотипных файлов архив имел такое имя, например: Документы.ext.zip.
A: Решение - vbs-скрипт (следует указать верный путь к актуальной версии 7z.exe в шапке кода):
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Опциональная упаковка выбранных файлов/папок в создаваемы(й,е) архив(ы)
'
' Для содержимого выбранных папок учитывается активный список исключений.
' При наличии папок в выбранном списке расширение файлов не добавляется.
' При упаковке одного элемента наследуется имя этого элемента,
' в ином случае наследуется имя родительского каталога.
'
' Параметры (! - обязательный):
'  1. <путь к списку элементов> (!)
'  2. "%P" (!)
'  3. "<путь назначения>" (!)
'  4. <расширение архива> (!)
'  5. <не/разделять по группам расширений: 0/1>
'  6. <не/добавлять дату и время к имени архива: 0/1>
'  7. <параметры упаковки>
'
' Примеры:
'  1) %WL "%P" "%T" zip
'  2) %WL "%P" "%T" 7z 1 0 -mx9 -m0=LZMA2 -ssw -pПАРОЛЬ
'  3) %WL "%P" "%T" ZIP 1 1 -mx9 -mm=Deflate -mfb=258 -mcu=on -pSECRET
'  4) %WL "%P" "%T" exe 0 1 -sfx7z.sfx -mx9 -m0=LZMA2:fb273 -m1=LZMA2:lc4

Option Explicit: Dim SZIP
'•••••••••••••••• Путь к 7z.exe ••••••••••••••••
SZIP = """%COMMANDER_PATH%\Utils\7-Zip\7z.exe"""
'••••••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••

Dim List, IDir, ODir, Ext, L, Flag, C, CurD, CrDate, i, Exts, WSS,_
S, FSO, CINI, All, IStr, IgList, Mass, F, BN, PF, Ext1, Filt, Dict
With WSH.Arguments
  On Error Resume Next
  List = .Item(0) : If Err.Number > 0 Then _
  MsgBox  "Не выбраны элементы для упаковки!", 48, Space(25) & "Пакетная упаковка": WSH.Quit
  On Error GoTo 0 : IDir = .Item(1) : ODir = .Item(2) : Ext = .Item(3)
  L = vbnewline : C = .Count : If C > 4 Then Flag = .Item(4) : If C > 5 Then CurD = .Item(5)
  If CurD Then CrDate = "_" & Replace(Date, "/", ".") & "_" & Replace(Time, ":", ChrW(-230))
  If Len(List) > 0 And C < 4 Then
    MsgBox  "Не выполнено условие:" & L & "минимальное число параметров - 4",_
    4144, Space(23) & "Пакетная упаковка" : WSH.Quit
  End If
  If C > 6 Then For i = 6 to C - 1 : S = S & " " & .Item(i) : Next
End With

Exts = "| 7Z  | 7ZIP | EXE | GZ2 | GZIP2 | SWM | WIM | ZIPX |" &_
vbCr & "| ZIP | ODS | TAR | JAR | DOCX | ODT | XLSX | XPI | EPUB |"
If InStr(Replace(Exts, " ", ""), "|" & UCase(Ext) & "|") = 0 Then _
MsgBox "Указанное расширение """ & Ext & """ не поддерживается!" &_
vbCr & vbCr & "Список поддерживаемых расширений:" &_
vbCr & Exts, 4144, Space(38) & "Пакетная упаковка" : WSH.Quit

Set WSS = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set CINI = FSO.OpenTextFile(WSS.ExpandEnvironmentStrings("%COMMANDER_INI%"))
All = CINI.ReadAll : CINI.Close : Set CINI = Nothing
If InStr(All, L & "IgnoreListFileEnabled=1") Then
  IStr = Split(All, L & "IgnoreListFile=")(1) : IgList = Trim(Left(IStr, InStr(IStr, L) - 1))
  If Mid(IgList, 2, 1) <> ":" Or Not InStr(IgList, "%") Then IgList = "%COMMANDER_PATH%\" & IgList
  IgList = " -xr@""" & IgList & """"
End If : ODir = FSO.BuildPath(ODir, "\")

With FSO.OpenTextFile(List,,,-1) Mass = Split(Replace(.ReadAll, L, "|" & L), L) : .Close :End With
All = "" : F = Left(Mass(0), Len(Mass(0)) - 1)
If IDir = "" Or InStrRev(Right(IDir, 2), ":") Then
  BN = "pack"
ElseIf Ubound(Mass) = 1 Then BN = FSO.GetFileName(F)
   If FSO.FileExists(F) Then BN = FSO.GetBaseName(BN)
Else BN = FSO.GetFileName(IDir) End If
PF = ODir & BN & CrDate & "." : Ext1 = LCase(FSO.GetExtensionName(F))
Filt = Filter(Mass, "." & Ext1 & "|", True, 1)
If Ubound(Filt) + 1 = Ubound(Mass) Then
  Pack PF & Ext1 & "." & Ext
ElseIf FSO.FolderExists(F) Or Flag = 0 Then
  Pack PF & Ext
ElseIf Flag = 1 Then
  Set Dict = CreateObject("Scripting.Dictionary")
  For Each F in Mass
    If F <> "" Then
      F = Left(F, Len(F) - 1) : Ext1 = LCase(FSO.GetExtensionName(F))
      If Not Dict.Exists(Ext1) Then
        Dict.Add Ext1, ""
        With FSO.OpenTextFile(List,2,,-1)
          .Write Replace(Join(Filter(Mass, "." & Ext1 & "|", True, 1), L), "|", "") : .Close
        End With : Pack PF & Ext1 & "." & Ext
      End If
    End If
  Next : Dict.RemoveAll : Set Dict = Nothing
End If : WSS.Popup "Упаковка завершена!", 1.4, " Результат", 4160

Sub Pack(Nm)
  Dim LN, x : LN = FSO.GetBasename(Nm) : Nm = LN & "." & Ext
  While FSO.FileExists("\\?\" & ODir & Nm) Or FSO.FolderExists("\\?\" & ODir & Nm)
    x = x + 1 : Nm = LN & " (" & x & ")." & Ext
  Wend : Nm = ODir & Nm
  WSS.Run SZIP & " a """ & Nm & """" & S & IgList & " -y @""" & List & """ -scsUTF-16LE", 0, True
End Sub

Примечание: по сути это стандартная упаковка, но с бонусом, который позволяет в результате наблюдать архивы с двойным расширением в случае его совпадения.
Не менее важным бонусом является 5-й параметр, позволяющий создавать группу архивов из выделенных файлов с добавкой вторых расширений в имена этих архивов. Рекомендую!

Обращаю также внимание на ключи упаковки в примере 4). Тестирование комбинаций разных ключей показало, что чаще всего этот вариант является лучшим по сжатию для 7z и exe(sfx).
Скрипт поддерживает работу с длинными (более 259 символов) путями исходных объектов и получателя!

Flasher
15.11.2014

Q: Можно изменить скрипт так, чтобы он был с такими параметрами (желательно изменяемыми)?:

     1. выбор типа архива (rar, zip, ну, если возможно, sfx);
     2. выбор степени сжатия;
     3. добавление 5% на восстановление;
     4. возможность создания пароля (естественно, одинакового для всех упакованных за один раз архивов);
     5. возможность выбора имени (полное имя файла или полное имя файла с датой - год, месяц, день - на конце);
     6. возможность выбора директории создания - текущая панель, противоположная панель.

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

A: Есть смысл сделать новый (следует указать верный путь к 7z.exe и rar.exe в середине кода):
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Упаковать каждый файл или содержимое каждой папки в отдельный архив

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

' Примеры:
'  1) %WL "%T" zip
'  2) %WL "%T" RAR
'  3) %WL "%P" exe "" -sfx7zCon.sfx
'  4) %WL "%T" 7z "" -mx9 -m0=LZMA2:fb273 -m1=LZMA2:lc4               (лучшее сжатие)
'  5) %WL "%P" rar "" -m5 -s -rr5p -pPASSWORD -ag_DD.MM.YY
'  6) %WL "%T" ZIP "" -mx9 -mm=Deflate -mfb=258 -mcu=on -pSECRET
'  7) %WL "%T" 7Z txt,doc,bat,cmd, -mx9 -m0=LZMA2 -ssw -pПАРОЛЬ

' Автор - Flasher ©
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Установка и проверка параметров:
With WScript.Arguments
  On Error Resume Next
  List = .Item(0) : Path = .Item(1) : Ext  = .Item(2)
  If Err.Number > 0 Then
    MsgBox  "Не выбраны элементы для упаковки!", 48, Space(25) & "Пакетная упаковка"
    Wscript.Quit
  End If : On Error GoTo 0
  L = vbnewline : C = .Count : If C > 3 Then Filt = .Item(3)
  If Len(List) > 0 And .Count < 3 Then
    MsgBox  "Не выполнено условие:" & L & "минимальное число параметров - 3",_
    vbExclamation, Space(23) & "Пакетная упаковка"
    Wscript.Quit
  End If
  If C > 5 Then
    For i = 5 to C - 1 : S = S & " " & .Item(i) : Next
  End If
End With : Const M = 1
' Проверка поддержки указанного расширения архива:
Exts = "7Z | 7ZIP | ZIP | RAR | GZIP | BZIP2 | XZ | EXE | WIM"
If InStr(Exts, Ucase(Ext)) = 0 Then
  MsgBox "Указанное расширение """ & UCase(Ext) & """ не поддерживается!" & L &_
  L & "Список поддерживаемых расширений:" & L & Exts, 48,_
  Space(38) & "Пакетная упаковка" : WScript.Quit
End If

Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WSH : Set WSH = CreateObject("WScript.Shell")

'================ Путь к 7z.exe ================
SZIP = "%COMMANDER_PATH%\Utils\7-Zip\7z.exe"
'================ Путь к rar.exe ===============
RAR  = "%COMMANDER_PATH%\Utils\WinRAR\rar.exe"
'===============================================

' Построение цикла для упаковки массива элементов:
For Each F in Split(FSO.GetFile(List).OpenAsTextStream(1, -1).ReadAll, L)
  If F > vbNullString Then
    If FSO.FileExists(F) Then
      If Len(Filt) > 0 Then
        Ext1 = LCase(FSO.GetExtensionName(F))
        If Ext1 <> "" Then
          If InStr(LCase(Filt), Ext1 & ",") > 0 Then Filtr F, SZIP, RAR, Ext, Path, S
        End If
      Else Filtr F, SZIP, RAR, Ext, Path, S
      End If
    Else
      Name = FSO.GetFileName(F) & "." & Ext : Str = ""
      If LCase(Ext) <> "rar" Then
        If Len(Filt) > 0 Then
          For Each E in Split(Filt, ",") : Str = Str & " """ & F & """*." & LCase(E) : Next
        Else Str = " """ & F & """*"
        End If
        WSH.Run """" & SZIP & """ a """ & Path & Name & """ """ & F & """*\" & Str & S, 0, True
      Else
        Set PF = FSO.GetFolder(F)
        For Each FF in PF.SubFolders : Period Str, FF, RAR, S, Path, Name : Next
        For Each FF in PF.Files
          If Len(Filt) > 0 Then
            Ext1 = LCase(FSO.GetExtensionName(FF))
            If Ext1 <> "" Then
              If InStr(LCase(Filt), Ext1 & ",") > 0 Then Period Str, FF, RAR, S, Path, Name
            End If
          Else Period Str, FF, RAR, S, Path, Name
          End If
        Next : If Str <> "" Then WSH.Run """" & RAR & """ a -ep1 -ri15" & S & " """ & Path & Name & """" & Str, 0, True
      End If
    End IF
  End If
Next
' Вывод сообщения и выход:
WSH.Popup "Упаковка завершена!", 1.4, "Результат", 64
Set FSO = Nothing : Set WSH = Nothing : WScript.Quit

' Процедура упаковки файлов:
Sub Filtr(FN, SZ, RA, Ex, P, K)
  Nm = FSO.GetBaseName(FN) & "." & Ex : Name = Nm : l = 0
  Do While FSO.FileExists(P & Name)
    l = l + 1 : If l < 10^M Then PostFix = Right(String(M, "0") & l, M) Else PostFix = l
    Name = Nm & " (" & PostFix & ")." & Ext
  Loop
  If LCase(Ex) <> "rar" Then
    Pr = SZ : Param = "a """ & P & Name & """ """ & FN & """" & K
  Else
    Pr = RA : Param = "a -ep1" & K & " """ & P & Name & """ """ & FN & """"
  End If : WSH.Run """" & Pr & """ " & Param, 0, True
End Sub
' Процедура упаковки папок в RAR по частям, исходя из ограничения длины комстроки:
Sub Period(St, FP, RR, K, Dir, NF)
  St = St & " """ & FP & """"
  If Len(St) > 1900 Then
    WSH.Run """" & RR & """ a -ep1 -ri15" & K & " """ & Dir & NF & """" & St, 0, True
    St = ""
  End If
End Sub

Flasher
17.11.2014