'================================ VBS ================================
' Добавка к именам файлов в структуре активного каталога отсутствующих
' описаний, имеющихся в конце имени одного файла cхожей именной группы
'
' Условие: путь запуска - пустой
'=====================================================================
Option Explicit: Dim ShA, Stm, Dic, FSO, Rgx, Reg, CD
Set ShA = CreateObject("Shell.Application")
Set Stm = CreateObject("SAPI.SpFileStream")
Set Dic = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Rgx = New RegExp : Rgx.Pattern = "^[^ ]+?\d+_\d+\.[A-z]{1,4}$"
Set Reg = New RegExp : Reg.Pattern = "^([^ ]+?)\d+_\d+( .+\.)[A-z]{1,4}$"
CD = FSO.GetAbsolutePathName("")
If CD = FSO.GetParentFolderName(WScript.ScriptFullName) Then WScript.Quit
ForFolder CD: MsgBox "Выполнено!", 4160, " Групповое переименование "
Sub ForFolder(Path)
Dim Items, F, N1, N2, Itms, I, NN, Folder, NP, LP, All
Set Items = ShA.NameSpace(Path).Items
Items.Filter 73920, "*_* *.*"
If Items.Count Then
For Each F In Items
If Reg.Test(F) Then
With Reg.Execute(F)(0)
N1 = .Submatches(0) : N2 = .Submatches(1)
End With
If Not Dic.Exists(N1) Then
Set Itms = ShA.NameSpace(Path).Items
Itms.Filter 73920, N1 & "*_*.*"
If Itms.Count > 1 Then
Dic.Add N1, ""
For Each I In Itms
NN = FSO.GetBaseName(I) & N2 & FSO.GetExtensionName(I)
NP = I.Parent.Self.Path & "\" & NN: LP = Len(NP) > 259
If LP Then NP = "\\?\" & NP
If Rgx.Test(I) And Not FSO.FileExists(NP) Then
If LP Then
With Stm
.Format.Type = 1 : .Open I.Path, 0 : .Read All, I.Size
.Close : .Open NP, 3, True : .Write All : .Close
End With : FSO.GetFile(I.Path).Delete
Else FSO.GetFile(I.Path).Name = NN End If
End If
Next
End If
End If
End If
Next: Dic.RemoveAll
End If: Items.Filter 73888, "*" : If Items.Count Then _
For Each Folder In Items : ForFolder Folder.Path : Next
End Sub |
