Single Post - Переименование файлов в RAR-архиве в TC

Желающие могут оценить скрипт:

Code:

'====================== VBS ======================
' Назначение: переименование объекта под курсором,
' в т. ч. расположенного в архиве допустимого типа

' Условие: требуется компонент TCScript.dll

Option Explicit: Dim Z7G, RAR, WSS, Title
'=========== Пути к утилитам 7zG и rar ===========
Z7G = """%COMMANDER_PATH%\Utils\7-zip\7zG.exe"""
RAR = """%COMMANDER_PATH%\Utils\WinRAR\rar.exe"""
'============================ Автор: Flasher © ===

Set WSS = CreateObject("WScript.Shell")
Title = " Переименование объекта под курсором"
If WSH.Arguments.Named.Exists("sel") Then
Dim Sel, Ln, L, N, A : L = "{HOME}"
Sel = Split(WSH.Arguments.Named("sel"), "|")
If Sel(0) Then L = "{LEFT " & Sel(0) - 1 & "}"
If Sel(1) Then N = "+{LEFT " & Sel(1) + 1 & "}"
Do : A = WSS.AppActivate(Title) : Loop Until A
If Sel(0) + Sel(1) Then WSS.SendKeys L & "+{END}" & N
WSH.Quit
End If
Dim FSO, TCH, Dir
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TCH = CreateObject("TCScript.Helper") : TCH.Pause = 0
Dir = TCH.GetSrcPath: If Dir = "" Then Quit 1002
If FSO.FolderExists("\\?\" & Dir) Then Quit 1002
If InStr(Dir, "/") Or Left(Dir, 3) = "\\\" Then Quit 1002
Dim APath, Ext, ArrB, i, Dec, Exts, FName, RExp, NName, Y, Ins, Util, SD, M, W
FName = TCH.GetInfo("SN"): If FName = ".." Then Quit 2912
If Mid(FName, 2, 2) = ":\" Then FName = Mid(FName, 4)
APath = Left(Dir, Len(Dir) - Len(Left(FName, InStrRev(FName, "\"))) - 1)
With CreateObject("SAPI.SpFileStream") .Open APath : .Read ArrB, 4 : .Close : End With
For i = 1 To 4 : Dec = Dec & AscB(MidB(ArrB, i, 1)) : Next
Ext = FSO.GetExtensionName(APath)
If Dec = 807534 Or StrComp(Ext, "crx", 1) = 0 Then Quit 1002
Exts = "|7z|7zip|bz2|bzip2|esd|exe|gz|gz2|gzip|gzip2|rar|swm|tar|tbz|tbz2|tgz|txz|wim|xz|"
If InStr(1, Exts, "|" & Ext & "|", 1) = 0 Then
WSS.Popup "Данный тип архива не поддерживает переименование!", 2, Title, 4144
Else
Y = (CreateObject("htmlfile").ParentWindow.Self.Screen.Height-18240/_
WSS.RegRead("HKCU\Control Panel\Desktop\WindowMetrics\AppliedDPI"))*7.5
Set RExp = New RegExp : RExp.Pattern = "[""/*:|?<>]" : NName = FName
Do: WSS.Run """" & WSH.ScriptFullName & """ /sel:" &_
InStr(StrReverse(NName), "\") & "|" & Len(FSO.GetExtensionName(NName))
NName = InputBox(vbCr & vbCr & Ins & String(3, vbCr) & "Введите новое имя:", Title, NName,,Y)
If Trim(NName) = "" Then Set RExp = Nothing : Quit 0
If RExp.Test(NName) Then Ins = Space(23) & "Ошибка: недопустимое имя!" Else Exit Do
Loop
If StrComp(Ext, "rar", 1) = 0 Then Util = RAR : SD = "tk" Else Util = Z7G : SD = "stl"
M = 0 : W = 0 : If SD <> "" Then W = 1 : If InStr(FName, "\") Then M = 2
WSS.Run Util & " rn -" & SD & " -- """ & APath & """ """ & FName & """ """ & NName & """", M, W
If SD <> "" And M = 0 Then TCH.SetSrcPath Dir
End If : Quit 0
Sub Quit(Num) : If Num Then TCH.SendCommand Num
Set FSO = Nothing : Set TCH = Nothing : Set WSS = Nothing : WSH.Quit : End Sub