Переименование группы файлов по их дате и времени

[Flasher]

Eug63
ОК. Тогда убираем и попробуем под

Код: Выделить всё

        If .Test(N) Then

вставить

Код: Выделить всё

MsgBox True : Wscript.Quit

Появится?

[Eug63]

Flasher
Появилось сообщение "Выполнено".

[Flasher]

Eug63
Возможно регулярки на x64 как-то иначе работают. Такой скрипт (прямо из файловой панели запускать) покажет истину?:

Код: Выделить всё

Filt = "*.jpg;*.jpeg"
Name = "2012-08-20 11-07-52.JPG"
With New Regexp
	.IgnoreCase = True
	.Pattern = "^(\d{2,4})([ -\.])(\d{2})([ -\.])(\d{2,4} +\d{2})([ -\.])"&_
	"(\d{2})([ -\.])(\d{2})(.(" & Replace(Mid(Filt, 3), ";*.", "|") & "))$"
	MsgBox .Test(Name)
End With

[Eug63]

Flasher
Появилось сообщение "Истина".
Но такого файла в панели нет.

[Flasher]

Eug63
Тогда я ничего не понимаю. Предлагаю провести тест исходника с одним файлом 2012-08-20 11-07-52.JPG в папке.
Есть ещё мысль - в 34 строке добавить выделенное красным: N = CStr(F.Name)

Но такого файла в панели нет.

Это только проверка выражения из исходника на приведённом имени файла, а не сущ. файле.

А сам скрипт где лежит?

[Eug63]

Flasher

Тогда я ничего не понимаю. Предлагаю провести тест исходника с одним файлом 2012-08-20 11-07-52.JPG в папке.
Есть ещё мысль - в 34 строке добавить выделенное красным: N = CStr(F.Name)

Без изменений.

А сам скрипт где лежит?

В этой же папке.

[sa]

Может, в качестве разделителя между датой и временем в именах используется не обычный пробел, а неразрывный, например?

[Flasher]

Так я выше предложил протестировать с конкретным именем файла.

Eug63
См. в ЛС.

Добавлено спустя 1 час 18 минут:

Выяснилось, что F.Name на x64 даёт базовое имя вместо полного. Скрипт исправлен под обе битности.

[sa]

Flasher
Надо ещё учесть случай, когда при переименовании файлы с новым именем уже существуют.

[Flasher]

sa
Я думал об этом, но не стал заморачиваться из-за путаницы в алгоритме перегруппировок (это сложнее, чем со стандартными целыми), да и на скорости скажется. Вероятность того, что соседний файл будет иметь то же время, включая секунды, достаточно мала. Ну, а добавка счётчика вряд ли устроит.

[sa]

В случае, когда переименовываются все файлы в папке (не часть), нужды в счётчике вовсе и нет. Препятствием может стать просто один из ещё не переименованных файлов.

[Flasher]

И переименованных тоже. Работа же ведётся как на плюс, так и на минус. Поэтому смысл тут только запоминании отработанного, в формировании отложенных групп, для которых может быть ещё и куча других подгрупп на разной глубине. В общем, тот ещё гемор.

Хотя можно пойти немного по другому пути.

[cut="Кое-что вырисовалось (непереименованные файлы, которые уткнулись в одно имя, отобразятся в окне):"]

Код: Выделить всё

'============================================== 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, Dict, FSO, C, Cnt, List
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 Dict  = CreateObject("Scripting.Dictionary")
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 FSO.GetAbsolutePathName("")
If C Then
  If Not IsEmpty(List) Then List = vbCr & "Непереименованные файлы:" & List
  MsgBox "           Выполнено!" & List, 4160, Title
Else MsgBox "В каталоге нет файлов с именем полной даты!" & List, 4144, Title
End If

Sub FFolder(Folder)
  Dim Items, F, N, Ext, D, Dy, Mh, Hr, Mn, Sc, n1, n2, FName, FPath, 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
          C = 1 : 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
          FName = Year(D) & .Replace(N, "$" & n1) & Mh & .Replace(N,"$" & n2)&_
          Dy & " " & Hr & .Replace(N, "$6") & Mn & .Replace(N, "$8") & Sc & Ext
          If N = F.Name Then N = FName Else N = FName & .Replace(N,"$10")
          FPath = FSO.GetParentFolderName(F.Path) & "\" & N
          If FSO.FileExists(FPath) Then Dict.Add F.Path, FPath Else F.Name = FName
        End If
      End With
    Next : Delayed
  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

Sub Delayed
  If Dict.Count Then
    Dim Key
    For Each Key in Dict.Keys
      If Not FSO.FileExists(Dict.Item(Key)) Then _
      FSO.GetFile(Key).Name = FSO.GetFileName(Dict.Item(Key)) : Dict.Remove(Key)
    Next
    If Dict.Count = Cnt Then
      If Dict.Count Then _
      For Each Key in Dict.Keys : List = List & vbCrLf & Key : Next
      Dict.RemoveAll
    Else Cnt = Dict.Count : Delayed : End If
  End If
End Sub

[/cut]

[Eug63]

Еще раз спасибо, все хорошо работает)).

[sa]

Предполагаю, что при последнем алгоритме работы скрипта, отображаться в окне будет просто нечему, поскольку все файлы благополучно переименуются.

[Flasher]

Только при условии несовпадения дат всех файлов в каждом подкаталоге. Но при разных форматах совпадения допустимы.