Изменения:
- Исключён ключ /X (выбор расширений) за ненадобностью (теперь это делает другой скрипт по маске, к тому же он из-за неточности был регистрозависимым).
- Вместо пустой строки для замены можно ввести один символ \ (быстрее набирать 
).
- Добавлено переименование только папок (ключ /F) или папок и файлов (ключ /FF)(по умолчанию переименовываются только файлы).
- Обработка описаний из файла descript.ion (в кодировке CP-1251).
vrenn.vbs
' Переименование файлов с использование регулярных выражений
' Расширения файлов не изменяются!
' Для папок, в отличии от файлов, расширения не имеют для системы значения, поэтому их имена обрабатываются целиком.
' v.3.00
Option Explicit
On Error Resume Next
Dim x
Dim fso, shl, rex, mat
Set fso = CreateObject("Scripting.FileSystemObject")
Set shl = CreateObject("WScript.Shell")
Set rex = New RegExp
' Аргументы
Dim p_xn, p_find, p_with
Dim p_quiet, p_sens, p_eni, p_glob, p_descr
Dim p_files, p_folders
p_xn = 0
p_find = "" ' Что ищем
p_with = "" ' На что меняем
p_quiet = 0
p_sens = False
p_eni = False
p_glob = True
p_descr = True
p_files = True
p_folders = False
Dim a, au, args
' Разбор аргументов командной строки с именами
Set args = WScript.Arguments.Named
If args.Exists("Q") Then
p_quiet = 2
End If
If args.Exists("Q1") Then
' Вывести только результирующую информацию
p_quiet = 1
End If
If args.Exists("S") Then
p_sens = True
End If
If args.Exists("ND") Then
p_descr = False
End If
If args.Exists("1") Then
' Только одну замену в имени
p_glob = False
End If
If args.Exists("F") Then
' Обрабатывать только папки
p_files = False
p_folders = True
End If
If args.Exists("FF") Then
' Обрабатывать и файлы и папки
p_files = True
p_folders = True
End If
' Разбор аргументов командной строки без имён
Set args = WScript.Arguments.Unnamed
For Each a In args
au = UCase(Left(a,2))
If a = "\" Then
' Пустая строка
a = ""
End If
If p_xn < 1 Then
p_find = a
p_xn = 1
ElseIf p_xn < 2 Then
p_with = a
p_xn = 2
Else
' Неправильный параметр
help
WScript.Quit
End If
Next
If p_xn < 1 Or p_find = "" Then
' Недостаточно аргументов
' или пустой патерн
help
WScript.Quit -1
End If
rex.Pattern = p_find
rex.IgnoreCase = Not p_sens
rex.Global = p_glob
' Проверка правильности регулярного выражения
Err.Clear
rex.Test("A")
If Err.Number Then
WScript.Echo "ERROR # " & CStr(Err.Number) & " " & Err.Description
WScript.Quit -2
End If
' Чтение описаний
Dim des
If p_descr Then
Set des = New descr
des.load
End If
Dim f1, f2, fn1, fn2, fx, fxx
Dim ne, nf, nd, na ' Счётчики
Dim f, ff, fc
Dim fa()
ne = 0
nf = 0
nd = 0
If p_folders Then
' Обработка папок
na = 0
Set fc = fso.GetFolder(".").SubFolders
For Each f In fc
f1 = f.Name
If rex.Test(f1) Then
If p_xn = 1 Then
' Вывод списка
WScript.Echo f1
nf = nf+1
Else
' В массив для переименования
ReDim Preserve fa(na)
fa(na) = f1
na = na+1
End If
End If
Next
If na Then
For Each f1 In fa
f2 = rex.Replace(f1,p_with)
If f1 <> f2 Then
' Папка требует переименования
If p_quiet = 0 Then
WScript.Echo f1
WScript.Echo "-> " & f2
End If
nf = nf+1
Err.Clear
fso.MoveFolder f1, f2
'Set ff = fso.GetFolder(f1) ' Другой способ
'Err.Clear
'ff.Name = f2
If Err.Number <> 0 Then
ne = ne+1
If p_quiet = 0 Then
WScript.Echo "!! ERROR: " & CStr(Err.Number) & " - " & Err.Description
End If
ElseIf p_descr Then
des.move f1, f2
End If
End If
Next
End If
End If
If p_files Then
' Обработка файлов
na = 0
Set fc = fso.GetFolder(".").Files
For Each f In fc
f1 = f.Name
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
If p_xn = 1 Then
' Вывод списка
WScript.Echo f1
nf = nf+1
Else
' В массив для переименования
ReDim Preserve fa(na)
fa(na) = f1
na = na+1
End If
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
fn2 = rex.Replace(fn1,p_with)
f2 = fn2 & fx
If fn1 <> fn2 Then
' Файл требует переименования
If p_quiet = 0 Then
WScript.Echo f1
WScript.Echo "-> " & f2
End If
nf = nf+1
Err.Clear
fso.MoveFile f1, f2
'Set ff = fso.GetFile(f1) ' Другой способ
'Err.Clear
'ff.Name = f2
If Err.Number <> 0 Then
ne = ne+1
If p_quiet = 0 Then
WScript.Echo "!! ERROR: " & CStr(Err.Number) & " - " & Err.Description
End If
ElseIf p_descr Then
des.move f1, f2
End If
End If
Next
End If
End If
If p_quiet < 2 Then
WScript.Echo "FOUND: " & nf
If p_xn > 1 Then
' Если не вывод списка, а переименование
WScript.Echo "ERRORS: " & ne
End If
End If
If p_descr Then
nd = des.dc
des.save
If p_quiet < 2 Then
WScript.Echo "DESCR: " & nd
End If
End If
WScript.Quit ne
'----------------------------------------------------------------------------------------------------------
Sub Help
WScript.Echo "Using:"
WScript.Echo " vrenn patern"
WScript.Echo " - list"
WScript.Echo "or"
WScript.Echo " vrenn [options] patern replace"
WScript.Echo " - rename"
WScript.Echo "where:"
WScript.Echo " patern - regular expression patern (sintax is wsh)"
WScript.Echo " replace - regular expression replace (sintax is wsh)"
WScript.Echo "options:"
WScript.Echo " /q - quiet (no output)"
WScript.Echo " /q1 - output only result info"
WScript.Echo " /f - rename folders only"
WScript.Echo " or"
WScript.Echo " /ff - rename folder and files"
WScript.Echo " otherwise rename files only"
WScript.Echo " /s - case sensifity"
WScript.Echo " /1 - only one match (otherwise all matches)"
WScript.Echo " /nd - not porcess descript.ion"
'WScript.Echo " /eni - not ighore file extensions"
End Sub
'==========================================================================================================
' Класс для работы с descript.ion
' ver. 2.01
'----------------------------------------------------------------------------------------------------------
Class descr
Public da
Public dc
Public fso
'----------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize
Set fso = CreateObject("Scripting.FileSystemObject")
' Загрузка из файла при создании
'da.load
End Sub
'----------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate
Set fso = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------
Public Sub load
dc = 0 ' Счётчик изменений сразу сбрасываем, типа, изменений ещё не было
Dim i, u, s, x, fn
Dim dx ' промежуточный массив
Dim dt ' текст с описаниями
Dim ft
Set ft = fso.OpenTextFile("descript.ion",1) ' ForReading
dt = ft.ReadAll
dx = Split(dt,vbCrLf)
dt = Null
u = UBound(dx)
ReDim da(1,u)
For i=0 To u
s = Trim(dx(i))
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
Next
End Sub
'----------------------------------------------------------------------------------------------------------
Public Sub move( f1, f2 )
Dim i, u : u = UBound(da,2)
Dim fud
Dim fu1 : fu1 = UCase(f1)
Dim fu2 : fu2 = UCase(f2)
Dim fnd : fnd = False
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 ft
Set ft = fso.OpenTextFile("descript.ion",2) ' ForWriting
Dim i, u, s, d0, d1
u = UBound(da,2)
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
ft.WriteLine( s )
End If
Next
dc = 0 ' Изменений больше нет
End Sub
'----------------------------------------------------------------------------------------------------------
End Class
'==========================================================================================================