Batya

|
Posted: Thu Jun 07, 2012 12:33 Post subject: |
|
|
savigrand wrote: | Но хотелось бы узнать про реализацию с помощью группового переименования, т.к. этот инструмент более гибок в плане применения регулярных выражения на лету (если с помощью скрипта, то надо править сам скрипт, если условия задачи изменились). |
В следующем vbs-скрипте используются регулярные выражения для задания соответствия - см. шапку скрипта в части "Изменяемые параметры":
Code: | '=====================================================================
' Перемещение выделенных файлов\папок в соответствующие им папки на
' противоположной панели TC
' Параметры вызова из TC:
' %L "%T"
'=====================================================================
Option Explicit
Dim EF
Set EF = CreateObject("Scripting.Dictionary")
'========== Изменяемые параметры =====================================
'Массив соответствия, задаваемый регулярными выражениями
EF.Add "^[\dA-Za-z].*$", "0-9-A-Z"
EF.Add "^([А-Яа-я]).*$", "$1"
'=====================================================================
Dim Title, Mess, FSO, ListF, List, Target, Fold, File, NewPath, REx, K, M, i
' Проверяем параметры
Title = "Внимание!"
If WScript.Arguments.Count < 2 Then
Mess = "Неправильно указаны параметры!"
MessQuit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
ListF = WScript.Arguments(0)
Target = WScript.Arguments(1)
If Right(Target, 1) <> "\" Then Target = Target & "\"
If Not FSO.FileExists(ListF) Then
Mess = "Неправильно указан файл-список обрабатываемых файлов!"
MessQuit
End If
If Not FSO.FolderExists(Target) Then
Mess = "Неправильно указана целевая папка!"
MessQuit
End If
Set REx = New RegExp
List = Split(FSO.OpenTextFile(ListF).ReadAll, vbNewLine)
For Each File In List
Fold = ""
If File <> "" Then
For Each K In EF.Keys
REx.Pattern = K
If REx.Test(FSO.GetFileName(File)) Then
Fold = REx.Replace(FSO.GetFileName(File), EF(K))
Exit For
End If
Next
If Fold <> "" Then
Fold = Target & Fold & "\"
If FSO.FolderExists(Fold) Then
NewPath = NextName(Fold & FSO.GetFileName(File))
If FSO.FileExists (File) Then FSO.MoveFile File, NewPath
If FSO.FolderExists(File) Then
If Right(File, 1) = "\" Then File = Mid(File, 1, Len(File) - 1)
FSO.MoveFolder File, NewPath
End If
End If
End If
End If
Next
MsgBox "Выполнено!", vbOKOnly + vbInformation, "Результат"
Quit
Function NextName(pPath)
Dim lPath, lName, lExt, li, lAdd
Const lQ = 1 'Минимальное количество цифр в номере
With CreateObject("Scripting.FileSystemObject")
lPath = .GetParentFolderName(pPath)
If lPath <> "" Then lPath = lPath & "\"
lName = .GetBaseName(pPath)
lExt = .GetExtensionName(pPath)
NextName = pPath
Do While .FileExists(NextName) Or .FolderExists(NextName)
li = li + 1
If li < 10^lQ Then
lAdd = Right(String(lQ, "0") & li, lQ)
Else
lAdd = li
End If
NextName = lPath & lName & "_" & lAdd & "." & lExt
Loop
End With
End Function
Sub MessQuit
MsgBox Mess, vbOKOnly + vbError, Title
Quit
End Sub
Sub Quit
Set FSO = Nothing
Wscript.Quit
End Sub |
_________________ Нет, я не сплю. Я просто медленно моргаю. |
|