Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Single Post  Topic: Перенесение файлов в папки по алфавиту 
Author Message
Batya



PostPosted: Thu Jun 07, 2012 12:33    Post subject: Reply with quote

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

_________________
Нет, я не сплю. Я просто медленно моргаю.
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group