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
Flasher



PostPosted: Sat Jan 28, 2017 15:10    Post subject: Reply with quote

sibirnik
Тогда так. Если есть файлы с разными расширениями, то для каждой группы свой счётчик.
Code:
'========================================================
' Переименовать файлы внутри выбранных папок по их именам
' при включении алфавитной сортировки (по умолч. прямой)

' Параметры: %WL
' необязат.: <фильтр-список расширений>
'            <cортировка обратная: 1>
' Примеры:   %WL
'            %WL *.jpg;*.jpeg 1
'========================================================
With WSH.Arguments
  C = .Count : If C = 0 Then WSH.Quit
  List = .Item(0) : If C > 1 Then Filt = .Item(1)
  If Filt = "" Then Filt = "*.*"
  If C = 2 Then Sort = .Item(2)
End With : Set ShA = CreateObject("Shell.Application")
Set Lst = CreateObject("System.Collections.ArrayList")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Reg = New RegExp : Reg.IgnoreCase = True
Set Rgx = New RegExp : Rgx.Global = True
Rgx.Pattern = "([()+.[^{$])"

With FSO.OpenTextFile(List,,,-1)
  Do : P = Trim(.ReadLine)
    If FSO.FolderExists(P) Then
      Set Path  = ShA.NameSpace(P)
      Set Items = Path.Items
      Items.Filter 73952, Filt
      If Items.Count Then
        For Each F in Items
          If FSO.FileExists(F.Path) Then Lst.Add CStr(F)
        Next : i = 1 : Lst.Sort : If Sort = 1 Then Lst.Reverse
        For Each F in Lst
          Ext = FSO.GetExtensionName(F)
          Reg.Pattern = "^" & Rgx.Replace(_
          Path.Title, "\$1") & " \(\d+\)\.?" & Ext & "$"
          If Not Reg.Test(F) Then
            If Len(Ext) Then Ext = "." & Ext
            FP = P & Path.Title : FN = FP & " (" & i & ")" & Ext
            While FSO.FileExists(FN) Or FSO.FolderExists(FN)
              i = i + 1 : FN = FP & " (" & i & ")" & Ext
            Wend
            FSO.GetFile(P & F).Name = Path.Title & " (" & i & ")" & Ext
          End If
        Next : Lst.Clear
      End If
    End If
  Loop Until .AtEndOfStream : .Close
End With
MsgBox Space(18) & "Выполнено!", 4160,_
" Переименование файлов внутри папок      "

P.S.: И опять же - не нужно пренебрегать правилами языка (заглавными и точками).
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.


Last edited by Flasher on Sun Jan 29, 2017 15:22; edited 8 times in total
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group