1 (изменено: Smitis, 2011-08-13 00:23:31)

Тема: VBScript: Перенумерация файлов и папок

Перенумерация файлов и папок.

Лирическое отступление smile Не знаю кому как, а мне слишком часто приходится изменять числовую нумерацию в именах файлов. То в документации. То в архиве фоток. То отсканированные листы надо перименовать и перенумеровать. Недавно архив комиксов разбирал, то же этот скрипт пригодился.

Скрипт предназначен для выполнения двух задач:
- изменение существующей нумерации файлов или папок с заданным шагом.
- выравнивание существующей нумерации до нужной длины для обеспечения нормальной сортировки файлов.

Для запуска использовать cscript.

- Скрипт ищет в именах файлов или папок числовые значения и изменяем их с заданным шагом (в случае перенумерации) или выравнивает их до нужного количества цифр (в случае выравнивания). При выравнивании число либо дополняется слева нулями до нужной длины, либо усекается до нужной длины, отбрасыванием лишних цифр. В случае отключения выравнивания (/NA) отбрасыватся ведущие нули.
- Расширения файлов (но не папок) игнорируются.
- Можно задать маску файлов/папок, подлежащих обработке. Маска задаётся стандартным для dos/windows способом с использованием подстановочных знаков "*" и "?". Можно перечислить несколько масок, разделив их с точкой с запятой.
- Начальное значение счётчика задаётся числом. Если в числе цифр больше одной и есть ведущие нули, длина числа берётся в качестве поля для выравнивания. Например, если требуется нумерация с единицы и цифр должно быть 5, необходимо ввести 00001, или использовать параметр /A5.
- Если начальный счётчик не задан, выполняется только выравнивание чисел дополнением нулями или усечение слева до количества, заданного параметром /A, либо выполняется отбрасывание незначащих нулей слева, если использован параметр /NA.
- Если в имени чисел несколько, обрабатывается последнее. При необходимости можно выбрать, какое число обрабатывать (параметр /M#).
- Задав специальный параметр /FF можно взять начальный номер из первого обработанного файла. Чтобы не вводить его вручную...
- В конце делается пауза, чтобы посмотреть результат.
- Сортировка обрабатываемых файлов лежит на совести ОС (по алфавиту, типу и т.п.)
- Файлы и папки обрабатываются только в текущей папке, без обхода подпапок.
- Код возврата - количество переименованных файлов (0 - переименований не было) или -1 в случае ошибки в параметрах.
- Косую черту "/" перед параметрами можно не ставить.
- Есть режим тестирования (/T) для проверки без реального переименования файлов и папок.
- Скрипт обрабатывает файл descript.ion с описаниями файлов (используется в FAR Manager) в кодировке CP-1251 и при необходимости вносит в него исправления.

vrenum.vbs

' Перенумерация файлов или папок

' 2011.07.31 - v.1.05
' 2011.08.12 - v.1.06

Option Explicit
On Error Resume Next

Dim x

Dim fso, shl, rex, shap
Dim m, mat, mats, matn, matv, matp, matl
Dim a, au, args
Dim a1, a_int, a_val
Dim newv, newl

Set fso = CreateObject("Scripting.FileSystemObject")
Set shl = CreateObject("WScript.Shell")
Set rex = New RegExp
Set shap = CreateObject("Shell.Application")

' Аргументы
Dim p_quiet, p_pause, p_test
Dim p_descr, p_align, p_renum
Dim p_field, p_slen, p_start, p_step, p_firstf
Dim p_mask, p_files, p_folders
Dim p_matlast, p_matnum
p_quiet = 0
p_pause = True
p_test = False
p_descr = True
p_field = 0         ' Поле для выравнивания
p_align = True      ' Выравнивание, если возможно
p_matlast = True
p_matnum = -1
p_renum = False     ' Перенумерация, иначе - только выравнивание
p_slen = 0          ' Длина параметра, задающего p_start. Будет исп. как длина поля
p_start = 0         ' Стартовое значение при перенумерации
p_step = 1          ' Шаг нумерации
p_firstf = False    ' Взять начальный номер из первого обрабатываемого файла
p_mask = "*"        ' Маска файлов
p_files = True      ' Обрабатывать только файлы
p_folders = False   ' Обрабатывать только папки

Dim f1, f2, fn1, fn2, fx, fxx
Dim f, fc
Dim fa()
Dim ne, nf, nd, na, nn ' Счётчики
ne = 0  ' Счётчик ошибок
nf = 0  ' Счётчик обработанных файлов
nd = 0  ' Счётчик описаний
na = 0  ' Счётчик найденных имён файлов
nn = 0  ' Счётчик перенумерации

' Разбор аргументов командной строки
Set args = WScript.Arguments
If args.Count = 0 Then
    HELP
    WScript.Quit
End If
For Each a In args
    au = UCase(a)
    If Left(au,1) = "/" Then
        au = Mid(au,2)
    End If
    a1 = Left(au,1)
    a_int = IsInt(Mid(au,2))
    If a_int Then
        a_val = CLng(Mid(au,2))
    End If
    Select Case au
        Case "Q"
            p_quiet = 2
            p_pause = False
        Case "Q1"
            ' Вывести только результирующую информацию
            p_quiet = 1
        Case "Q2"
            ' Без паузы
            p_pause = False
        Case "T"
            ' Тестирование (вывод результатов без реального переименования)
            p_test = True
        Case "ND"
            ' Не обрабатывать descript.ion
            p_descr = False
        Case "NA"
            ' Не выравнивать при перенумерации
            p_align = False
        Case "ML","LM"
            ' Последнее совпадение
            p_matlast = True
            'p_matnum = -1
        Case "F"
            ' Обрабатывать только папки
            p_files = False
            p_folders = True
        Case "FF"
            ' Брать начальный номер из первого обрабатываемого файла
            If p_renum Then
                ' Конфликт параметров
                HELP
                ERRQ -1
            End If          
            p_firstf = True
            p_renum = True
        Case Else
            If a1 = "A" And a_int Then
                ' align - выравнивание поля (дополнение нулями)
                p_field = a_val
                p_align = True
                If p_field = 0 Then
                    HELP
                    ERRQ -1
                End If
            ElseIf a1 = "M" And a_int Then
                p_matnum = a_val
                p_matlast = False
                If p_matnum = 0 Then
                    HELP
                    ERRQ -1
                End If
            ElseIf a1 = "S" And a_int Then
                ' Шаг нумерации
                p_step = a_val
                If p_step = 0 Then
                    HELP
                    ERRQ -1
                End If
            ElseIf InStr(au,"*")>0 Or InStr(au,"?")>0 Then
                ' Файлы по маске
                p_mask = a
            ElseIf IsInt(au) And Not p_firstf Then
                ' Если число - начальное значение для перенумерации,
                ' либо шаг перенумерации, если начальное число уже задано,
                ' но в случае параметра /FF - ошибка
                If Not p_renum Then
                    p_renum = True
                    p_start = CLng(au)
                    p_slen = Len(au)
                    If p_slen > 1 And Left(au,1) = "0" Then
                        p_field = p_slen
                        p_align = True
                    End If
                Else
                    p_step = CLng(au)
                    If p_step = 0 Then
                        HELP
                        ERRQ -1
                    End If
                End If
            Else
                ' Неправильный параметр
                HELP
                ERRQ -1
            End If
    End Select
Next

rex.Pattern = "(\d+)"
rex.IgnoreCase = True
rex.Global = True

' Чтение описаний
Dim des
If p_descr Then
    Set des = New descr
    des.load
End If

' Проверка ширины поля
If p_renum Then
    If p_field < p_slen Then
        p_field = p_slen
    End If
End If

If p_folders Then
    ' Обработка папок
    nn = p_start
    na = 0
    Set fc = shap.NameSpace(shl.CurrentDirectory).Items()
    fc.Filter 32, p_mask
    For Each f1 In fc
        If rex.Test(f1) Then
            ' Если есть число - в массив для дальнейшей обработки
            ReDim Preserve fa(na)
            fa(na) = f1
            na = na+1
        End If
    Next
    If na Then
        For Each f1 In fa
            Set mats = rex.Execute(f1)
            If mats.Count > 0 Then
                If p_matlast Then
                    matn = mats.Count-1
                Else
                    matn = p_matnum-1
                End If
                If matn < mats.Count Then
                    f2 = f1
                    matv = mats(matn).Value
                    matl = Len(matv)
                    matp = mats(matn).FirstIndex
                    If p_firstf Then
                        ' Взять начальный счётчик из имени файла
                        nn = matv
                        p_firstf = False
                    End If
                    If p_renum Then
                        ' При перенумерации используем счётчик
                        newv = CStr(nn)
                        If p_field > Len(newv) And p_align Then
                            ' Выравнивание найденного числа если его длина меньше длины заданного поля.
                            newv = Right(String(p_field,"0")&newv,p_field)
                        End If
                    Else
                        ' При простом выравнивании используем старое значение
                        newv = matv
                        If Not p_align Then
                            newv = newv+0
                        ElseIf p_field > matl Then
                            ' Дополнение нулями
                            newv = Right(String(p_field,"0")&newv,p_field)
                        ElseIf p_field > 0 Then
                            ' Усечение
                            newv = Right(newv,p_field)
                        End If
                    End If
                    f2 = Left(f2,matp) & newv & Mid(f2,matp+matl+1)
                    If f1 <> f2 Then
                        ' Папка требует переименования
                        If p_quiet = 0 Then
                            WScript.Echo f1
                            WScript.Echo "-> " & f2
                        End If
                        nf = nf+1
                        If Not p_test Then
                            Err.Clear
                            fso.MoveFolder f1, f2
                            'Set ff = fso.GetFolder(f1)
                            'Err.Clear
                            'ff.Name = f2
                            If Err.Number <> 0 Then
                                ne = ne+1
                                ERRW
                            ElseIf p_descr Then
                                des.move f1, f2
                            End If
                        ElseIf Len(des.getx(f1)) Then
                            nd = nd+1
                        End If
                    End If
                    ' Чтобы не было пропусков, номер увеличиваем всегда
                    nn = nn + p_step
                End If
            End If
        Next
    End If
End If

If p_files Then
    ' Обработка файлов
    nn = p_start
    na = 0
    Set fc = shap.NameSpace(shl.CurrentDirectory).Items()
    fc.Filter 64, p_mask
    For Each f1 In fc
        x = InStrRev(f1,".")
        If x > 1 Then
            fn1 = Left(f1,x-1)
            fx = Mid(f1,x)
        Else
            fn1 = f1
            fx = ""
        End If
        If rex.Test(fn1) Then
            ' Если есть число - в массив для дальнейшей обработки
            ReDim Preserve fa(na)
            fa(na) = f1
            na = na+1
        End If
    Next
    If na Then
        For Each f1 In fa
            ' Для файлов исключаем расширение из обработки
            x = InStrRev(f1,".")
            If x>1 Then
                fn1 = Left(f1,x-1)
                fx = Mid(f1,x)
            Else
                fn1 = f1
                fx = ""
            End If
            Set mats = rex.Execute(fn1)
            If mats.Count > 0 Then
                If p_matlast Then
                    matn = mats.Count-1
                Else
                    matn = p_matnum-1
                End If
                If matn < mats.Count Then
                    fn2 = fn1
                    matv = mats(matn).Value
                    matl = Len(matv)
                    matp = mats(matn).FirstIndex
                    If p_firstf Then
                        ' Взять начальный счётчик из имени файла
                        nn = matv
                        p_firstf = False
                    End If
                    If p_renum Then
                        ' При перенумерации используем счётчик
                        newv = CStr(nn)
                        If p_field > Len(newv) And p_align Then
                            ' Выравнивание найденного числа если его длина меньше длины заданного поля.
                            newv = Right(String(p_field,"0")&newv,p_field)
                        End If
                    Else
                        ' При простом выравнивании используем старое значение
                        newv = matv
                        If Not p_align Then
                            newv = newv+0
                        ElseIf p_field > matl Then
                            ' Дополнение нулями
                            newv = Right(String(p_field,"0")&newv,p_field)
                        ElseIf p_field > 0 Then
                            ' Усечение
                            newv = Right(newv,p_field)
                        End If
                    End If
                    fn2 = Left(fn2,matp) & newv & Mid(fn2,matp+matl+1)
                    f2 = fn2 & fx
                    If fn1 <> fn2 Then
                        ' Файл требует переименования
                        If p_quiet = 0 Then
                            WScript.Echo f1
                            WScript.Echo "-> " & f2
                        End If
                        nf = nf+1
                        If Not p_test Then
                            Err.Clear
                            fso.MoveFile f1, f2
                            'Set ff = fso.GetFile(f1)
                            'Err.Clear
                            'ff.Name = f2
                            If Err.Number <> 0 Then
                                ne = ne+1
                                ERRW
                            ElseIf p_descr Then
                                des.move f1, f2
                            End If
                        ElseIf Len(des.getx(f1)) Then
                            nd = nd+1
                        End If
                    End If
                    ' Чтобы не было пропусков, номер увеличиваем всегда
                    nn = nn + p_step
                End If
            End If
        Next
    End If
End If

If p_quiet < 2 Then
    WScript.Echo "FOUND:  " & nf
    WScript.Echo "ERRORS: " & ne
End If
If p_descr Then
    If Not p_test Then
        nd = des.dc
    End If
    des.save
    If p_quiet < 2 Then
        WScript.Echo "DESCR:  " & nd
    End If
End If
If p_pause Then
    WScript.StdOut.Write "Press ENTER key to continue . . ."
    x = WScript.StdIn.Read(1)
End If

WScript.Quit ne

'----------------------------------------------------------------------------------------------------------
Sub HELP
    WScript.Echo "Using:"
    WScript.Echo "  vrenum [options] [mask] start [step]"
    WScript.Echo "  - renum from start number"
    WScript.Echo "or"
    WScript.Echo "  vrenum [options] [mask] [/]FF [[/]S#]"
    WScript.Echo "  - get start number from first file and renum"
    WScript.Echo "or"
    WScript.Echo "  vrenum [options] [mask] [/]A#"
    WScript.Echo "  - align numbers"
    WScript.Echo "where:"
    WScript.Echo "  mask    - file masks separated by ';' character"
    WScript.Echo "            samples:"
    WScript.Echo "              *.jpg"
    WScript.Echo "              *.doc;*.docx;readme.*"
    WScript.Echo "  start   - start number for renum"
    WScript.Echo "  step    - step for renum,"
    WScript.Echo "options:"
    WScript.Echo "  [/]Q    - quiet (no output)"
    WScript.Echo "  [/]Q1   - output only result info"
    WScript.Echo "  [/]Q2   - without pause"
    WScript.Echo "  [/]S#   - renum step, default 1"
    WScript.Echo "  [/]F    - rename folders only"
    WScript.Echo "  [/]A#   - align field"
    WScript.Echo "  [/]NA   - no align"
    WScript.Echo "  [/]M#   - match number, default last"
    WScript.Echo "  [/]ML   - last match"
    WScript.Echo "  [/]ND   - not porcess descript.ion"
    WScript.Echo "  [/]T    - testing without real rename"
End Sub

'----------------------------------------------------------------------------------------------------------
' Проверить, что это целое число
Function IsInt( s )
    Dim i, l
    l = Len(s)
    IsInt = False
    If l Then
        IsInt = True
        For i=1 To l
            If InStr("0123456789",Mid(s,i,1)) = 0 Then
                IsInt = False
                Exit For
            End If
        Next
    End If
End Function

'----------------------------------------------------------------------------------------------------------
Sub ERRQ( cod )
    If Err.Number <> 0 Then
        ERRW
        If cod Then
            WScript.Quit cod
        End If
    End If
End Sub
'----------------------------------------------------------------------------------------------------------
Sub ERRW
    If p_quiet = 0 Then
        WScript.Echo "!! ERROR: " & CStr(Err.Number) & " - " & Err.Description
    End If
End Sub

'==========================================================================================================
' Класс для работы с descript.ion
' ver. 2.05.B (без setpath,setx)
'----------------------------------------------------------------------------------------------------------

Class descr
    Public da
    Public dc
    Public dfp ' description file path

'----------------------------------------------------------------------------------------------------------

Private Sub Class_Initialize
    dfp = "descript.ion"
    ReDim da(1,0)
    da(0,0) = ""
    da(1,0) = ""
End Sub

'----------------------------------------------------------------------------------------------------------

Private Sub Class_Terminate
    ReDim da(0)
    dfp = Null
End Sub

'----------------------------------------------------------------------------------------------------------

Public Sub load
    dc = 0 ' Счётчик изменений сразу сбрасываем, типа, изменений ещё не было
    Dim s, x, fn, ft
    Dim i : i = 0
    Dim h
    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(dfp) Then
            Exit Sub
        End If
        Set h = .OpenTextFile(dfp,1) ' ForReading
        Do While Not h.AtEndOfStream
            i = i+1
            ReDim Preserve da(1,i)
            s = Trim(h.ReadLine)
            If Left(s,1) = """" Then
                ' Имя в кавычках, ищем завершающие кавычки
                x = InStr(2,s,"""")
                If x Then
                    fn = Mid(s,2,x-2)
                    ft = LTrim(Mid(s,x+1))
                Else
                    fn = s
                    ft = ""
                End If
            Else
                ' Имя не в кавычках, ищем пробел
                x = InStr(s," ")
                If x Then
                    fn = Left(s,x-1)
                    ft = LTrim(Mid(s,x+1))
                Else
                    fn = s
                    ft = ""
                End If
            End If
            ' Если строка неправильная, ft бедет пустым
            da(0,i) = fn
            da(1,i) = ft
        Loop
        h.Close
    End With
End Sub

'----------------------------------------------------------------------------------------------------------

Public Function getx( f )
    Dim i
    Dim u : u = UBound(da,2)
    Dim fu : fu = UCase(f)
    If Len(f) Then
        ' Описания просматриваем с конца, так как действительным является последнее.
        For i=u To 0 Step -1
            If fu = UCase(da(0,i)) Then
                getx = da(1,i)
                Exit Function
            End If
        Next
    End If
    getx = ""
End Function

'----------------------------------------------------------------------------------------------------------

Public Sub move( f1, f2 )
    Dim i
    Dim fud
    Dim fu1 : fu1 = UCase(f1)
    Dim fu2 : fu2 = UCase(f2)
    Dim fnd : fnd = False
    Dim u : u = UBound(da,2)
    If Len(f2) Then
        ' Переименование
        ' Описания просматриваем с конца, так как действительным является последнее.
        ' Если будут дубляжи f1 - пропускаем.
        ' Если будут дубляжи f2 - удаляем.
        For i=u To 0 Step -1
            fud = UCase(da(0,i))
            If fud = fu1 Then
                ' Меняем имя файла
                ' Но только один раз
                If Not fnd Then
                    da(0,i) = f2
                    dc = dc+1
                    fnd = True
                End If
            ElseIf fud = fu2 Then
                ' Удаляем имя и описание
                ' Но только если переименование уже было
                If fnd Then
                    da(0,i) = ""
                    da(1,i) = ""
                End If
            End If
        Next
    Else
        ' Удаление
        For i=0 To u
            fud = UCase(da(0,i))
            If fud = fu1 Then
                ' Удаляем имя и описание
                da(0,i) = ""
                da(1,i) = ""
                dc = dc+1
            End If
        Next
    End If
End Sub

'----------------------------------------------------------------------------------------------------------

Public Sub save
    If dc = 0 Then
        ' Если не было изменений нефиг и записывать
        Exit Sub
    End If
    Dim u : u = UBound(da,2)
    Dim h
    Dim i, s, d0, d1
    Dim n : n = 0
    With CreateObject("Scripting.FileSystemObject")
        Set h = .OpenTextFile(dfp,2,Not .FileExists(dfp)) ' ForWriting
        For i=0 To u
            d0 = da(0,i)
            d1 = da(1,i)
            If Len(d0) Then
                ' Не пустое имя файла
                If Len(d1) Then
                    ' Это была правильная строка
                    If InStr(d0," ") Then
                        s = """" & d0 & """ " & d1
                    Else
                        s = d0 & " " & d1
                    End If
                Else
                    ' Это была неправильная строка
                    s = d0
                End If
                h.WriteLine( s )
                n = n+1
            End If
        Next
        dc = 0 ' Изменений больше нет
        h.Close
        If n = 0 Then
            ' Файл пустой
            .DeleteFile dfp, True
        Else
            Set h = .GetFile(dfp)
            h.Attributes = 34
        End If
    End With
End Sub

'----------------------------------------------------------------------------------------------------------

End Class

'==========================================================================================================

2

Re: VBScript: Перенумерация файлов и папок

V. 1.06
- Исправлен баг - если значение параметра /M было больше, чем чисел в имени, переименование происходило неправильно. Теперь такие файлы и папки пропускаются.

3

Re: VBScript: Перенумерация файлов и папок

Развитие скрипта получило продолжение уже в виде исполняемого файла
http://www.cyberforum.ru/cmd-bat/thread1226601.html