Flasher
|
 Posted: Sat Aug 13, 2011 23:56 Post subject: |
 |
|
Подумал, пусть тут тоже будет:
| Code: | '•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Распаковка выделенных архивов и архивов в структуре
' выделенных каталогов в одноименные папки рядом с архивами
' Параметры: %L <расширения архивов через запятую>
' Пример: %L 7z,7zip,arc,bzip2,rar,zip
' Автор - Flasher ©
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
Dim WSH, FSO
Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Proga = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%\Utils\7-Zip\7z.exe")
With WScript.Arguments
On Error Resume Next
List = .Item(0)
Filt = .Item(1)
If Len(List) > 0 And .Count < 2 Then
MsgBox "Укажите оба параметра!",_
vbExclamation, " Рекурсивная упаковка"
Wscript.Quit
End If
End With
If Err.Number > 0 Then
MsgBox "Не выбраны элементы для распаковки!", vbExclamation,_
" Рекурсивная пофайловая распаковка"
End If
Set Dict = CreateObject("Scripting.Dictionary")
Exts = "7z, 7zip, arj, bz2, bzip2, cab, chm, chw, cpio, cramfs, deb, dmg, doc, exe, fat, gz, gzip, hfs, hxs, iso, lha, lzma, mbr, msi, ntfs, ppt, rar, rpm, scap, squashfs, swm, tar, taz, tbz, tbz2, tgz, vhd, wim, xar, xls, xz, zip"
For Each E in Split(Exts, ", ")
Dict.Add Trim(E), ""
Next
With FSO.OpenTextFile(List, 1)
Do While Not .AtEndOfStream
F = Trim(.ReadLine)
If F <> "" Then
If FSO.FolderExists(F) Then
ForFolder FSO.GetFolder(F)
Else ForFile F
End If
End If
Loop
.Close
End With
Set Dict = Nothing
WSH.Popup "Распаковка завершена!", 1.4 , "Результат", 64
Set WSH = Nothing
Set FSO = 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)
For Each Fi in Split(Filt,",")
If StrComp(Fi,FSO.GetExtensionName(File),1) = 0 And Dict.Exists(LCase(Fi)) Then
NF = FSO.CreateFolder(FSO.GetParentFolderName(File) & "\" & FSO.GetBaseName(File) & "\" )
WSH.Run """" & Proga & """ x """ & File & """ -o""" & NF & """ -y", 0, True
End If
Next
End Sub |
Распаковываться будут архивы только с поддерживаемыми форматами (42 расширения). |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
