Flasher
|
 Posted: Thu Jan 19, 2017 21:28 Post subject: |
 |
|
Пробуй:
| Code: | '•••••••••••••••••••••••••• VBS •••••••••••••••••••••••••••
' Назначение: Преобразование типов выбранных архивов
' с сохранением даты модификации в новых
' Условие: Наличие инсталляции системного аддона TC4Shell
' Страница загрузки: http://www.tc4shell.com/ru/download/
' Параметры: %WL "<путь назначения>" <новое расширение>
' Необязат.: "<параметры упаковки>" <удалять исходники: 1>
' Примеры: %WL "%P" 7z "-mx9 -m0=LZMA2:fb273 -m1=LZMA2:lc4"
' %WL "%T" zip "-mx9 -mm=Deflate -mfb=258 -mcu=on"
' %WL "%P" exe "-sfx7z.sfx -mx9" 1
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
Option Explicit: Dim C, Par, Del, List, Trg, ExtN, FSO, ShA
'••••••••••••••••• Путь к утилите 7z.exe ••••••••••••••••••
Const Z7 = """%COMMANDER_PATH%\Utils\7-zip\7z.exe"""
'••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••
Const Title = " Преобразование типов выбранных архивов "
With WSH.Arguments : C = .Count : Par = " -sdel"
Select Case True : Case C = 0 WSH.Quit
Case C < 3 MsgBox " Укажите хотя бы 3 параметра!", 4144, Title : WSH.Quit
Case C > 3 Par = .Item(3) & Par: If C = 5 Then Del = .Item(4)
End Select : List = .Item(0) : Trg = .Item(1) : ExtN = .Item(2)
End With : Dim Exts: Exts = " 7Z | 7ZIP | EXE | GZ2 | GZIP2 | SWM | WIM "&_
"| ZIPX " & vbCr & " ZIP | ODS | TAR | JAR | DOCX | ODT | XLSX | XPI | EPUB"
If InStr(Exts & " ", " " & Ucase(ExtN) & " ") = 0 Then _
MsgBox "Указанное расширение """ & ExtN & """ не поддерживается!" &_
vbCr & vbCr & "Список поддерживаемых расширений:" &_
vbCr & Exts, 4144, Title : WSH.Quit
Dim WSS, Reg, Tmp, Temp, F, Ext, Arch, Items, NN, NA
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ShA = CreateObject("Shell.Application")
Set WSS = CreateObject("WScript.Shell")
Set Reg = New Regexp : Dim OS, PassW, Enc, EnCrypt, T, P : OS = WSS._
RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
Reg.IgnoreCase = True: Reg.Pattern = "^(001|7z(|ip)|a|apm|arj?|bz(|ip)2|" &_
"cab|cpio|ch[iqmw]|cramfs|deb|dmg|docx?|e(sd|pub|xe|xt[234]?)|fat|gz(|ip" &_
")|hfsx?|hx[sirqw]|ihex|img|iso|jar|li[bt]|l(zh|ma)|lha|mbr|ms(i|lz|sp)|" &_
"mub|n(si|tf)s|od[st]|qcow(|2c?)|r00|rar|rpm|pkg|ppmd|ppt|squashfs|scap|" &_
"swm|t[agx]z|tar|tbz2?|u(d|efi)f|vdi|vhd|vmdk|wim|x(ar|lsx?|pi|z)|z|zipx?)$"
Tmp = ShA.NameSpace(WSS.Environment("Process")("TEMP")).Self.Path & "\"
Temp = Tmp & FSO.GetBaseName(FSO.GetTempName) : FSO.CreateFolder Temp
With FSO.OpenTextFile(List,,,-1)
Do : F = .ReadLine : Ext = FSO.GetExtensionName(F)
If FSO.FileExists(F) And Ext <> ExtN And Reg.Test(Ext) Then
Set Arch = ShA.NameSpace(F)
If Arch.Self.IsFolder Then
Set Items = Arch.Items : Items.Filter 73952, "*" : PassW = Chr(0)
NN = FSO.GetBaseName(F) & "." & ExtN : NA = FSO.BuildPath(Trg, NN)
Enc = Len(Arch.Self.ExtendedProperty("System.IsEncrypted"))
If Enc And InStr("|7z|7zip|gz|gzip|", "|" & Ext & "|") Then _
EnCrypt = " -mhe" Else EnCrypt = ""
If Not FSO.FileExists(NA) And (Items.Count Or Enc) Then
If OS <= "5.1" Or Enc Then T = 8192 Else T = (_
CLng(Items.Item(0).ExtendedProperty("System.SFGAOFlags"))And 8192)
If T = 8192 Then GetPass F, Passw, "", Enc Else _
WSS.Run Z7 & " x """ & F & """ -o""" & Temp & """ -y -p", 0, True
If PassW <> "" Then
P = Par: If PassW <> Chr(0) Then P = Par & " -p" & PassW & EnCrypt
WSS.Run Z7 & " a """ & NA & """ """ & Temp & "\*"" " & P, 0, True
If FSO.FileExists(NA) Then ShA.NameSpace(Trg).ParseName(NN)._
ModifyDate = FSO.GetFile(Arch.Self.Path).DateLastModified :_
C = 0 : If Del = 1 Then FSO.DeleteFile F, 1
End If
End If
End If
End If
Loop Until .AtEndOfStream : .Close
End With : FSO.DeleteFolder Temp : If C = 0 Then C = 24 : NA = "Выполнено!"_
Else C = 12 : NA = "Нет подходящих архивов!"
If FSO.FolderExists(Tmp & "TC4Shell") Then FSO.DeleteFolder Tmp & "TC4Shell"
WSS.Popup Space(C) & NA, 5, Title, 4160
Sub GetPass(Arc, P, Text, Num)
If OS > "5.1" Or Num Or P <> Chr(0) Then _
P = InputBox(vbCr & "Архив: """ & Arc & """" & vbCr & vbCr &_
Text & vbCr & vbCr & "Введите пароль:", " " & Title, P)
If P <> Chr(0) Then Text = Space(40) & "Пароль неверен!"
If Len(P) Then _
WSS.Run Z7 & " x """ & Arc & """ -o""" & Temp & """ -y -p" & P, 0, True :_
If FSO.GetFolder(Temp).Size = 0 Then GetPass Arc, P, Text, 1
End Sub |
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Last edited by Flasher on Wed Jan 25, 2017 20:26; edited 23 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
