Flasher
|
 Posted: Sat Aug 06, 2011 23:29 Post subject: |
 |
|
Ну, что ж. Пробуем.
| Code: | '••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Упаковка каждого выделенного файла или файла в структуре выделенных
' каталогов в отдельный архив
' Параметры (! - обязательный):
' 1. <путь к списку элементов> (!)
' 2. "<путь назначения>\" (!) (если установить "", то рядом с исходником,
' если написать "имя папки", то в папку рядом с исходником;
' 3. <расширение архива> (!)
' 4. <фильтр-список расширений файлов>
' разделитель - запятая (если задействован 5., то - !)
' 5. <параметры упаковки>
' Примеры:
' 1) %L "" zip
' 2) %L "%P" RAR
' 3) "C:\My Files\List.txt" 1 exe "" -sfx7zCon.sfx
' 4) %L "" rar "" -m5 -s -rr5p -pPASSWORD -ag_DD.MM.YY
' 5) %L "%T" ZIP "" -mx9 -mm=Deflate -mfb=258 -mcu=on -pSECRET
' 6) %L "%T" 7Z avi,flv,wmv,mkv -mx9 -m0=LZMA2 -ssw -pПАРОЛЬ
' Автор - Flasher ©
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
With WScript.Arguments
On Error Resume Next
List = .Item(0)
P = .Item(1)
Ext = .Item(2)
If .Count > 3 Then Filt = .Item(3)
If Len(List) > 0 And .Count < 3 Then
MsgBox "Не выполнено условие:" & vbnewline & "минимальное число параметров - 3",_
vbExclamation, " Рекурсивная пофайловая упаковка"
Wscript.Quit
End If
End With
If Err.Number > 0 Then
MsgBox "Не выбраны элементы для упаковки!", vbExclamation,_
" Рекурсивная пофайловая упаковка"
Wscript.Quit
End If
Set Dict = CreateObject("Scripting.Dictionary")
Exts = "7Z | 7ZIP | ZIP | RAR | GZIP | BZIP2 | XZ | EXE | WIM"
For Each E in Split(Exts, " | ")
Dict.Add Trim(E), ""
Next
If Not Dict.Exists(Ucase(Ext)) Then
MsgBox "Указанное расширение """ & UCase(Ext) & """ не поддерживается!" & vbnewline &_
vbnewline & "Список поддерживаемых расширений:" & vbnewline & Exts, vbExclamation,_
" Рекурсивная пофайловая упаковка"
WScript.Quit
End If
Set Dict = Nothing
Set Args = CreateObject("Scripting.Dictionary")
For Each A In WScript.Arguments
i = i + 1
Args.Add i, A
If i > 4 Then S = S & " " & A
Next
Set Args = Nothing
Dim WSH
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
SZIP = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%\Utils\Arch\7z.exe")
RAR = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%\Utils\Arch\rar.exe")
With FSO.OpenTextFile(WScript.Arguments(0), 1)
Do While Not .AtEndOfStream
F = Trim(.ReadLine)
If F > vbNullString Then
If FSO.FolderExists(F) Then
ForFolder FSO.GetFolder(F)
Else ForFile F
End If
End If
Loop
.Close
End With
WSH.Popup "Упаковка завершена!", 1.4 , "Результат", 64
Set FSO = Nothing
Set WSH = Nothing
WScript.Quit
Sub ForFolder(Folder)
Dim N
For Each N In Folder.SubFolders
ForFolder N
Next
For Each N In Folder.Files
ForFile N
Next
End Sub
Sub ForFile(File)
If Len(Filt) > 0 Then
For Each Fi in Split(Filt,",")
If StrComp(Fi,FSO.GetExtensionName(File),1) = 0 Then Run File
Next
Else Run File
End If
End Sub
Sub Run(FF)
If InStr(P, ":") > 0 Then
Path = P
Else
PP = FSO.GetFile(FF).ParentFolder & "\" & P
If FSO.FolderExists(PP) Then
Path = PP & "\"
Else Path = FSO.CreateFolder(PP) & "\"
End If
End If
If Not FSO.FileExists(Path & FSO.GetBaseName(FF) & "." & Ext) Then
Name = FSO.GetBaseName(FF) & "." & Ext
Else
Name = FSO.GetFileName(FF) & "." & Ext
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
End If
Name = FSO.GetFileName(FF) & " (" & PostFix & ")." & Ext
Loop
End If
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 |
Опять же напоминаю об указании путей к 7z.exe/rar.exe в скрипте.
Add: немного косметики...
Last edited by Flasher on Fri Aug 12, 2011 14:30; edited 7 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
