Архивирование выбранных в панели элементов
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Опциональная упаковка выбранных файлов/папок в создаваемы(й,е) архив(ы)
'
' Для содержимого выбранных папок учитывается активный список исключений.
' При наличии папок в выбранном списке расширение файлов не добавляется.
' При упаковке одного элемента наследуется имя этого элемента,
' в ином случае наследуется имя родительского каталога.
'
' Параметры (! - обязательный):
' 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
1. выбор типа архива (rar, zip, ну, если возможно, sfx); 2. выбор степени сжатия; 3. добавление 5% на восстановление; 4. возможность создания пароля (естественно, одинакового для всех упакованных за один раз архивов); 5. возможность выбора имени (полное имя файла или полное имя файла с датой - год, месяц, день - на конце); 6. возможность выбора директории создания - текущая панель, противоположная панель.
Алгоритм действий: выделяем группу файлов, нажимаем кнопку(с настраиваемыми параметрами) и получаем группу архивов - в нужной директории с полными именами файлов, плюс, если возможно, с датой на конце (по выбору).
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Упаковать каждый файл или содержимое каждой папки в отдельный архив
' Параметры (! - обязательный):
' 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