'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Упаковать выделенное в архив(ы) с двойным расширением
' Параметры (! - обязательный):
' 1. <путь к списку элементов> (!)
' 2. "<путь назначения>\" (!)
' 3. <расширение архива> (!)
' 4. <не разделять/разделять по группам расширений: 0/1>
' 5. <параметры упаковки>
' Примеры:
' 1) %L "%T" zip 0
' 2) %L "%P" exe 1 -sfx7zCon.sfx
' 3) %L "%T" ZIP 1 -mx9 -mm=Deflate -mfb=258 -mcu=on -pSECRET
' 4) %L "%T" 7Z 1 -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 Flag = .Item(3)
If Len(List) > 0 And C < 4 Then
MsgBox "Не выполнено условие:" & L & "минимальное число параметров - 4",_
vbExclamation, Space(23) & "Пакетная упаковка"
Wscript.Quit
End If
If C > 4 Then
For i = 4 to C - 1 : S = S & " " & .Item(i) : Next
End If
End With
Exts = "7Z | 7ZIP | ZIP | 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 : Const M = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WSH : Set WSH = CreateObject("WScript.Shell")
SZIP = """%COMMANDER_PATH%\Utils\7-Zip\7z.exe"""
Set TF = FSO.OpenTextFile(List, 1)
Mass = Split(Replace(TF.ReadAll, L, "|" & L), L)
TF.Close : Set TF = Nothing
F = Left(Mass(0), Len(Mass(0)) - 1) : WD = FSO.GetParentFolderName(F)
If InStrRev(Right(WD, 2), ":") Then BN = "pack" Else BN = FSO.GetFileName(WD)
PF = Path & BN & "." : Ext1 = FSO.GetExtensionName(F)
Name = PF & Ext1 & "." & Ext
Filt = Filter(Mass, "." & Ext1 & "|", True, 1)
If Ubound(Filt) + 1 = Ubound(Mass) Then
Pack SZIP, Path, Name, S, List, Ext
ElseIf FSO.FolderExists(F) Or Flag = 0 Then
Name = PF & Ext
Pack SZIP, Path, Name, S, List, 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 = FSO.GetExtensionName(F)
Name = PF & Ext1 & "." & Ext
If Not Dict.Exists(Ext1) Then
Dict.Add Ext1, "" : Set TF = FSO.OpenTextFile(List, 2, True)
TF.Write Replace(Join(Filter(Mass, "." & Ext1 & "|", True, 1), L), "|", "")
TF.Close : Set TF = Nothing : Pack SZIP, Path, Name, S, List, Ext
End If
End If
Next : Dict.RemoveAll : Set Dict = Nothing
End If : WSH.Popup "Упаковка завершена!", 1.4, "Результат", 64
Set FSO = Nothing : Set WSH = Nothing : WScript.Quit
Sub Pack(SZ, Dir, NM, SS, File, Ex)
OF = NM
Do While FSO.FileExists(Dir & FSO.GetFileName(NM))
n = n + 1
If n < 10^M Then PostFix = Right(String(M, "0") & n, M) Else PostFix = n
NM = Dir & FSO.GetBaseName(OF) & " (" & PostFix & ")." & Ex
Loop : WSH.Run SZ & " a """ & NM & """" & SS & " -y @""" & File & """ -scsWIN", 0, True
End Sub |
