'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Опциональная упаковка выбранных файлов или файлов в структуре
' выбранных каталогов (htm(l) упаковываются вместе со своими каталогами)

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

' Примеры:
'  1) %WL "" zip
'  2) %WL "%P" RAR
'  3) "C:\My Files\List.txt" 1 exe "" -sfx7z.sfx
'  4) %WL . 7z "" -mx9 -m0=LZMA2:fb273 -m1=LZMA2:lc4
'  5) %WL "" 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 *.mht;*.htm;*.html -mx9 -m0=LZMA2 -ssw -pПАРОЛЬ

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

Option Explicit
Dim SZIP, RAR, Title, A, C, P, Ext, List, Filt, Arch, Exts, E,_
i, S, WSH, ShA, FSO, F, T, Text, Folder, Test, Items, Fl, Fd,_
File, Extn, FF, Ex, Path, PP, Name, l, PostFix, Pr, Param

'••••••••• Путь к утилите 7z.exe ••••••••••••
SZIP = "%COMMANDER_PATH%\Utils\7-Zip\7z.exe"
'••••••••• Путь к утилите rar.exe •••••••••••
RAR  = "%COMMANDER_PATH%\Plugins\arc\rar.exe"
'••••••••••••••••••••••••••••••••••••••••••••

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

Exts = "7Z | 7ZIP | ZIP | RAR | GZIP | BZIP2 | XZ | EXE | WIM"
If InStr(" " & Exts & " ", " " & Ucase(Ext) & " ") = 0 Then
  MsgBox "Указанное расширение """ & UCase(Ext) & """ не поддерживается!" &_
  vbLf & vbLf & "Список поддерживаемых расширений:" &_
  vbLf & Exts, 48, Space(20) & Title : WScript.Quit
End If

If C > 5 Then For i = 5 To C - 1 : S = S & " " & A(i) : Next End If
If InStr(P, ":") And Right(P, 1) = "." Then
  Arch = Trim(InputBox(String(5, vbLf) & "Введите базовое имя архива:",_
  Space(18) & Title, "Новый_архив")) : If Arch = "" Then WScript.Quit
  P = Left(P, Len(P) - 1)
End If

Set WSH = CreateObject("WScript.Shell")
Set ShA = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile(List,,,-1)
  Do : F = Trim(.ReadLine)
    If F > vbNullString Then
      If FSO.FolderExists(F) Then ForFolder F, T Else ForFile F, T
    End If
  Loop Until .AtEndOfStream : .Close
End With
Sub Info(Text) : WSH.Popup Text, 1.5 , "    " & Title, 64 : End Sub
If T Then Info "Упаковка завершена!" Else Info "Нет подходящих объектов!"

Sub ForFolder(Folder, Test)
  Set Folder = ShA.NameSpace(Folder)
  Set Items  = Folder.Items
  Items.Filter 192, Filt : If Items.Count Then Test = 1
  For Each Fl in Items : Run Fl.Path, FSO.GetExtensionName(Fl) : Next
  Items.Filter 160, "*"
  For Each Fd In Items
    If Right(Fd, 6) <> "_files" Then ForFolder Fd.Path, Test
  Next
End Sub

Sub ForFile(File, Test)
  Extn = FSO.GetExtensionName(File)
  If Len(Filt) Then
    If Not Ubound(Filter(Split(LCase(Filt), ";"), "*." &_
    LCase(Extn), True, 1)) Then Run File, Extn : Test = 1 End If
  Else Run File, Extn : Test = 1
  End If
End Sub

Sub Run(FF, Ex)
  If InStr(P, ":") Then
    Path = P
  Else
    PP = FSO.GetParentFolderName(FF) & "\"
    If P <> "." And P <> "" Then PP = PP & P & "\"
    If FSO.FolderExists(PP) Then Path = PP Else Path = FSO.CreateFolder(PP) & "\"
  End If
  If Len(Arch) Then
    Name = Arch & "." & Ext
  ElseIf P = "." Then
    Name = FSO.GetFileName(Left(PP, Len(PP) - 1)) & "." & Ext
  Else
    Name = FSO.GetBaseName(FF) & "." & Ext
    l = 0 : 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
      Name = FSO.GetFileName(FF) & " (" & PostFix & ")." & Ext
    Loop
  End if
  If LCase(Ex) = "htm" Or LCase(Ex) = "html" Then FF = """" & FF & """ """ &_
  Left(FF, InStrRev(FF, Ex) - 2) & "_files""" Else FF = """" & FF & """"
  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