Flasher
|
 Posted: Thu Aug 04, 2011 13:55 Post subject: |
 |
|
shveicar, пляши!
| Code: | '••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Упаковать каждый файл или содержимое каждой папки в отдельный архив
' Параметры (! - обязательный):
' 1. <путь к списку элементов> (!)
' 2. "<путь назначения>\" (!)
' 3. <расширение архива> (!)
' 4. <фильтр-список расширений файлов в корнях выделенных папок>
' разделитель - запятая (если задействован 5., то - !)
' 5. <параметры упаковки>
' Примеры:
' 1) %WL "%T" zip
' 2) %WL "%T" RAR
' 3) %WL "%P" exe "" -sfx7zCon.sfx
' 4) %WL "%P" rar "" -m5 -s -rr5p -pPASSWORD -ag_DD.MM.YY
' 5) %WL "%T" ZIP "" -mx9 -mm=Deflate -mfb=258 -mcu=on -pSECRET
' 6) %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")
SZIP = "%COMMANDER_PATH%\Utils\7-Zip\7z.exe"
RAR = "%COMMANDER_PATH%\Plugins\arc\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 |
Пути к 7z.exe и rar.exe в переменных SZIP и RAR указать свои.
Last edited by Flasher on Fri Sep 07, 2018 19:01; edited 8 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
