Single Post - Замена имен выделенных файлов копией имени исходного файла

Вот что получилось на скорую руку:

Code:

'=====================================================================================
' Переименовывать имена элементов пассивной панели в имя элемента активной

' Внимание!: используется компонент Script Helper ActiveX for TC

' Параметры: 1) %V; 2) <полное/базовое имя: 0/1>;
' 3) при наличии совпавших расширений в выбранном списке:
' а) выдавать сообщение: 0
' б) добавлять № счётчика: 1
' Пример: %V 0 1
'=====================================================================================

With WScript.Arguments
If .Count = 0 Then WScript.Quit
File = .Item(0) : OBN = .Item(1) : Add = .Item(2)
End With : Const M = 0
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dict = CreateObject("Scripting.Dictionary")
With CreateObject("TCScript.Helper")
.LockTC True : List = .GetTrgSelectedFiles(1) : .LockTC False
End With : L = vbNewLine

If Add = 0 Then
S = "" : i = 0
For Each F in List
If F <> "" Then
If FSO.FileExists(F) Then
Ext = FSO.GetExtensionName(F) : FN = FSO.GetFileName(F)
If Not Dict.Exists(Ext) Then
Dict.Add Ext, FN : i = i + 1
Else
FF = Dict.Item(Ext) : If InStr(S, FF) = 0 Then S = S & L & FF
S = S & L & FN
End If
End If
End If
Next : If S <> "" Then
MsgBox "В выбранном списке есть файлы с одним расширением:" & L & _
S, 48, Space(30) & "Вынужденное завершение" : Dict.RemoveAll : Quit
End If : Dict.RemoveAll
End If

For Each F in List
If F <> "" Then
NN = FSO.GetFileName(File) : PF = FSO.GetParentFolderName(F) & "\"
If FSO.FileExists(F) Then
If OBN Then
Ext = FSO.GetExtensionName(F)
If FSO.FileExists(File) Then NN = FSO.GetBaseName(NN) & "." & Ext Else _
NN = FSO.GetFileName(File) & "." & Ext
End If : If Add = 1 And Not FSO.FileExists(PF & NN) Then ReName NN
If Not FSO.FileExists(PF & NN) Then FSO.GetFile(F).Name = NN
Else
If FSO.FileExists(File) Then NN = FSO.GetBaseName(NN)
ReName NN
If Not FSO.FolderExists(PF & NN) Then FSO.GetFolder(F).Name = FSO.GetFileName(NN)
End If
End If
Next : Quit

Sub Rename(FName)
FNm = FName : n = 0
Do While FSO.FileExists(FName) Or FSO.FolderExists(FName)
n = n + 1 : If n < 10^M Then PFix = Right(String(M, "0") & n, M) Else PFix = n
If FSO.FileExists(FNm) Then
FName = FSO.GetBaseName(FNm) & " (" & PFix & ")." & FSO.GetExtensionName(FNm)
Else FName = FSO.GetFileName(FNm) & " (" & PFix & ")"
End If
Loop
End Sub : Sub Quit : Set FSO = Nothing : Set Dict = Nothing : WScript.Quit : End Sub