Total Commander

Код: Выделить всё

'================================ VBS ================================
' Копировать выбранные папки с переименованием по шаблону [a-z][01-99]
' + Отчёт по шаблону: <исходный относительный путь к файлу> </новый>

' Условие:   пустое поле «Путь запуска:»

' Параметры: %WF "<относительный путь назначения>" "имя лога"
' Пример:    %WF iblock Log.txt
'=====================================================================
Option Explicit
Dim A, T, Sym, REx, TF, LF, Items, Nm, Fd, n, c, x, F, NP
Set A = WSH.Arguments: If A.Count Then T = A(1) Else WSH.Quit
Sym = Split("a b c d e f g h i j k l m n o p q r s t u v w x y z")
Set REx = New RegExp : REx.Pattern = "([a-z]+)(\d+)"

With CreateObject("Scripting.FileSystemObject")
  Set TF = .OpenTextFile(A(0),,,-1)
  Set LF = .OpenTextFile(A(2),8,1,-1)
  With CreateObject("Shell.Application").NameSpace(.GetAbsolutePathName(""))
    .NewFolder T : Set Items = .ParseName(T).GetFolder.Items
  End With
  Items.Filter 8224, "*"
  If Items.Count Then
    Set Nm = REx.Execute(Items.Item(Items.Count - 1))(0)
    c = Nm.SubMatches(0) : x = Len(c) : c = Asc(c) - 97
    n = CInt(Nm.SubMatches(1))
    If c = 26 And n = 99 Then x = x + 1
    If n < 99 Then n = n + 1 Else n = 1 : c = c + 1
  Else c = 0 : n = 1 : x = 1 End If
  Set REx = Nothing : Set Items = Nothing
  Do: Fd = TF.ReadLine
    If Right(Fd, 1) <> "\" Then Exit Do
    NP = .BuildPath(T, String(x, Sym(c)) & Right("0" & n, 2))
    .GetFolder(Fd).Copy NP : If c = 26 And n = 99 Then x = x + 1
    If n < 99 Then n = n + 1 Else n = 1 : c = c + 1
    For Each F In .GetFolder(Fd).Files
      LF.WriteLine Fd & F.Name & " /" & Replace(NP, "\", "/") & "/" & F.Name
    Next
  Loop Until TF.AtEndOfStream : TF.Close : LF.Close
End With
CreateObject("WScript.Shell").Popup "  Выполнено!", 2, " Копирование каталогов     ", 4160