'============================================== VBS ===============================================
' Прибавить/отнять часы, минуты, секунды в датах базовых имён файлов в структуре активного каталога
' Разделителем величин в исходном формате базового имени может быть дефис, пробел или точка.
' Примеры форматов базовых имён: yyyy-MM-dd HH-mm-ss; yyyy.MM.dd HH-mm-ss; dd-MM yyyy HH mm.ss
' Условие: путь запуска - пустой
' Параметры: [-<часы>] [-<минуты>] [-<секунды>] <фильтр-список расширений> <вкл/выкл рекурсию:1/0>
' Примеры: 1 0 0 *.jpg;*.jpeg 1
' 4 -5 -3 *.mp3;*.flac;*.ogg 0
'==================================================================================================
Option Explicit : Dim H, M, S, Filt, Recur, Shell, Regex, FSO
Const Title = " Правка даты в именах файлов "
With WScript.Arguments
If .Count <> 5 Then MsgBox "Укажите 5 параметров!", 4144, Title : WScript.Quit
H = .Item(0) : M = .Item(1) : S = .Item(2) : Filt = .Item(3) : Recur = .Item(4)
End With
Set Shell = CreateObject("Shell.Application")
Set Regex = New Regexp : Regex.IgnoreCase = True
Set FSO = CreateObject("Scripting.FileSystemObject")
Regex.Pattern = "^(\d{2,4})([ -\.])(\d{2})([ -\.])(\d{2,4} +\d{2})([ -\"&_
".])(\d{2})([ -\.])(\d{2})(.(" & Replace(Mid(Filt, 3), ";*.", "|") & "))$"
FFolder CreateObject("WScript.Shell").CurrentDirectory
MsgBox " Выполнено!", 4160, Title
Sub FFolder(Folder)
Dim Items, F, N, Ext, D, Dy, Mh, Hr, Mn, Sc, n1, n2, Fd
Set Folder = Shell.NameSpace(Folder)
Set Items = Folder.Items
Items.Filter 8384, Filt
If Items.Count Then
For Each F In Items
N = FSO.GetFileName(F.Path)
With Regex
If .Test(N) Then
Ext = "" : If N = F.Name Then Ext = .Replace(N,"$10")
D = CDate(.Replace(N, "$1$2$3$4$5:$7:$9")) + TimeSerial(H,M,S)
Dy = Day(D) : Mh = Month(D) : Hr = Hour(D) : Mn = Minute(D)
Sc = Second(D) : Call AddNull(Dy)(Mh)(Hr)(Mn)(Sc)
If Len(.Replace(N,"$1")) = 4 Then n1 = 2 : n2 = 4 Else n1 = 4 : n2 = 2
F.Name = Year(D) & .Replace(N, "$" & n1) & Mh & .Replace(N,"$" & n2)&_
Dy & " " & Hr & .Replace(N, "$6") & Mn & .Replace(N, "$8") & Sc & Ext
End If
End With
Next
End If
If Recur = 1 Then
Items.Filter 8352, "*"
For Each Fd In Items : FFolder Fd.Path : Next
End If
End Sub
Function AddNull(DateT)
DateT = Right("0" & DateT, 2) : Set AddNull = GetRef("AddNull")
End Function |