Total Commander

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

'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 
' Опциональная упаковка выбранных файлов или файлов в структуре 
' выбранных каталогов (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