Flasher
|
 Posted: Fri Nov 02, 2018 02:16 Post subject: |
 |
|
Да, ладно. Мелочиться ещё...
| Code: | '==================================== VBS ====================================
' Распаковать exe-файлы Inno Setup активного каталога с распределением файлов
' по каталогам, имена которых соответствуют разрядности этих файлов: x86/x64
' Условие: путь запуска — пустой
' Параметр: %WF (без него или выбора объектов будут вовлечены все exe-файлы)
' /o — ключ перехода в созданный каталог при распаковке одного exe-файла
Option Explicit : SetLocale 1049
'============================ Путь к распаковщику ============================
Const InnoUnp = """%COMMANDER_PATH%\Plugins\wcx\MultiArc\Addons\innounp.exe"""
'======================================================== Автор: Flasher © ===
Dim FSO, Dic, ShA, WSS, T, Arg, Rgx, CD, Exts, HLink, Items, C, i, BN, FBN, Fl
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dic = CreateObject("Scripting.Dictionary")
Set ShA = CreateObject("Shell.Application")
Set WSS = CreateObject("WScript.Shell")
Set Rgx = New RegExp : T = Timer
Set Arg = WSH.Arguments
CD = FSO.BuildPath(WSS.CurrentDirectory, "\")
If Not FSO.FolderExists(CD) Then WScript.Quit
If StrComp(CD, FSO.GetParentFolderName(WSH.ScriptFullName) & "\", 1) = 0 Then WSH.Quit
Exts = "*,1." & Replace("acm;acx;ax;com;cnv;cpl;dll;drv;exe;fmt;lib;msi;ocx;scr;pnf;qtx;" &_
"scf;scp;sdb;so;sys;theme;tlb;vxd;vdf;wcx;wcx64;wdx;wdx64;wfx;wfx64;wlx;wlx64", ";", ";*,1.")
If WSS.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion") > "5.1" _
Then HLink = "%ComSpec% /q/c mklink /h" Else HLink = "fsutil hardlink create"
Rgx.Global = 1 : Rgx.MultiLine = 1 : Rgx.Pattern = ".+\.[Ee][Xx][Ee]$"
If Arg.UnNamed.Count > 0 Then _
Set Items = Rgx.Execute(FSO.OpenTextFile(Arg(0),,,-1).ReadAll) Else _
Set Items = ShA.NameSpace(CD).Items : Items.Filter 73920, "*.exe"
If Items.Count = 0 Then WSH.Quit
Rgx.Pattern = "(,\d|[_—\-]?x?64)(?=\.[A-z]+$)"
For i = 0 To Items.Count - 1
BN = FSO.GetBaseName(Items.Item(i))
If Not FSO.FolderExists(BN) Then C = C + 1 : WSS.Run InnoUnp & " -x -d" &_
"""" & CD & BN & "\x86"" -c{app} -a -y """ & Items.Item(i) & """", 0, 1 :_
If FSO.GetFolder(BN).Size Then Recursion ShA.NameSpace(CD & BN & "\x86")
Next
If C > 0 Then If Arg.Named.Exists("o") And C = 1 Then _
WSS.Exec "%COMMANDER_EXE% /O /S """ & CD & BN & """" Else _
WSS.Popup Space(13) & "Выполнено!" & vbCr & " Время выполнения: " &_
TimeSerial(0, 0, Timer - T), 2, "Распаковка exe-файлов Inno Setup ", 4160
Sub Recursion(Folder)
If Not FSO.FileExists(Folder.Self.Path) Then
Dim NPath, Itms, F1, F2, Fl, Fn : Set Itms = Folder.Items
NPath = Replace(Folder.Self.Path & "\", "\x86\", "\x64\")
ShA.NameSpace(Left(NPath, 3)).NewFolder Mid(NPath, 4)
Itms.Filter 73920, Replace(Exts, ",1", "64")
For Each Fl in Itms
Fl = Fl.Path : FSO.GetFile(Fl).Move NPath
Dic.Add Rgx.Replace(Fl, ""), Empty
Next
For Each Fl in FSO.GetFolder(Folder.Self.Path).Files
If Rgx.Test(Fl.Path) = 0 Then If Not Dic.Exists(Fl.Path) Then _
WSS.Run HLink & " """ & NPath & "\" & Fl.Name & """ """ & Fl & """", 0
Next : Dic.RemoveAll
Itms.Filter 73920, Exts
If Itms.Count > 0 Then
For Each F1 in Itms
FBN = FSO.GetBaseName(F1.Path)
Set F2 = Folder.ParseName(Left(FBN, Len(FBN) - 1) & "2" & Right(F1.Path, 4))
If Is64bit(F1) Then Set Fl = F1 : Set Fn = F2 Else Set Fl = F2 : Set Fn = F1
FSO.MoveFile Fl.Path, NPath & Rgx.Replace(FSO.GetFileName(Fl.Path), "")
Fn.Name = Rgx.Replace(FSO.GetFileName(Fn.Path), "")
Next
End If : Itms.Filter 73888, "*"
For Each i in Itms : Recursion i.GetFolder : Next
End If
End Sub
Function Is64bit(oF)
Dim ArrB, PE, S
With CreateObject("SAPI.SpFileStream")
.Open oF.Path : .Seek(60) : .Read ArrB, 1 : .Seek AscB(ArrB) + 4
.Read ArrB, 2 : PE = AscB(ArrB) & AscB(MidB(ArrB, 2))
If PE <> 761 And PE <> 100134 Then
.Seek 4
For i = 1 To oF.Size
.Read ArrB, 1 : S = S & AscB(ArrB)
If InStrRev(S, "806900") Then .Read ArrB, 2 : Exit For
Next : PE = AscB(ArrB) & AscB(MidB(ArrB, 2)) : S = Empty
End If : .Close
End With : Is64bit = Eval(PE = 100134)
End Function |
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Last edited by Flasher on Tue Nov 06, 2018 03:43; edited 9 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
