Переименование с созданием структуры подкаталогов

[angry_dog]

Помогите пожалуйста решить проблему. Можно ли переименовать и как папки вида folder-XXXX-folder в вид folder\XXXX\folder

[mod="Avada"]Вопрос отделён в отдельную тему и перенесён в другой подфорум. Замечание за нарушение п. 9 правил форума (оффтоп).[/mod]

[Avada]

angry_dog
Если речь идёт о простом переименовании, а не о создании структуры подкаталогов, то такое переименование здесь невозможно в принципе: обратный слэш \ частью имени являться не может.

[angry_dog]

Речь идёт именно о создании структуры подкаталогов. Возможно ли? При замене символа "-" на "\" пишет о невозможности переименования

[Avada]

angry_dog
Структура каталогов ни простым, ни групповым переименованием исходного имени папки не создаётся: нельзя одну операцию подменять другой. О недопустимости замены чего бы то ни было на слэш уже было сказано. Имеет ли решение задача в принципе — вопрос к специалистам по скриптам.

[angry_dog]

angry_dog
О недопустимости замены чего бы то ни было на слэш уже было сказано.

Про замену понятно. Но если по F7 создать новую папку со слэшем в имени, то TC создаёт именно структуру папок. Вот и задался вопросом: а можно ли переименовать имя папки в структуру папок. В любом случае спасибо за помощь.

[Avada]

Вот и задался вопросом: а можно ли переименовать имя папки в структуру папок.

Если поставить курсор на папку folder-XXXX-folder, нажать F7, а потом в окне ввода в подставленном шаблоне дефисы заменить на обратные слэши, мы получим именно структуру папок на основе имени исходной папки, которая при этом как была, так и останется. Но это не будет переименованием, и такое можно за раз проделать только с одной папкой (которая под курсором).

[Batya]

Помогите пожалуйста решить проблему. Можно ли переименовать и как папки вида folder-XXXX-folder в вид folder\XXXX\folder

Держи vbs-скрипт.

[angry_dog]

Держи vbs-скрипт.

Я был бы Вам безмерно благодарен, если бы Вы обьяснили как им пользоваться.

[Avada]

angry_dog
Первый этап (скачать и установить; пояснения — в Readme-файле):
Script Helper
Второй этап (по любому скрипту, приведённому на форуме в текстовом виде):
Как использовать Script-ы?

[Batya]

Первый этап (скачать и установить; пояснения — в Readme-файле):
Script Helper

Ну, для моего скрипта по ссылке Script Helper не нужен, хотя на будущее лучше поставить.

По поводу моего скрипта... Я его просмотрел глазами - он не будет рабоать с папками, а только с файлами. Возможность обработки папок добавлю позднее.

[angry_dog]

Я его просмотрел глазами - он не будет рабоать с папками, а только с файлами

Именно так. С файлами работает как часы. С папкой - пишет ошибку пути.

Возможность обработки папок добавлю позднее.

Подписался на эту тему. Буду ждать помощи. Больше неоткуда. Спасибо

[Tol!k]

angry_dog, попробуй.
"Переименовывает" по одной папке

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

TOTALCMD#BAR#DATA
%COMMANDER_PATH%\folder-XXXX-folder.cmd
%N
%COMMANDER_PATH%\TOTALCMD.EXE,33
Переименование папки с созданием структуры подкаталогов


-1

::::::::::::::::::::::::: folder-XXXX-folder.cmd :::::::::::::::::::::::::
@echo off &chcp 1251 >nul
rem Переименование папки с созданием структуры подкаталогов:
rem папка вида folder-XXXX-folder — в вид folder\XXXX\folder\
set "folder=%~1"
set "newfolder=%folder:-=\%"
if not exist "%newfolder%" md "%newfolder%\"
if exist "%~1\*" move "%~1\*" "%newfolder%\"
rd %1 /q
::::::::::::::::::::::::: folder-XXXX-folder.cmd :::::::::::::::::::::::::

[Batya]

Буду ждать помощи.

Готово:

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

'==============================================================================
' Создание дерева папок согласно разделителя в имени файла\папки.
' В именах создаваемых папок первый символ делается заглавным.
' Например,если разделитель "_", а имя файла "abc_de_fghi_jk.ext", то
'   будет создано "abc\de\fghi\jk.ext".

' Параметры:
' {список файлов\папок} [{целевая папка} [{режим} [{разделители} [{обрабатываемые разделители}]]]]
' где {режим} по разрядам может принимать значения:
'   1-й разряд цифр:
'     1 - копирование (по умолчанию},
'     2 - перемещение;
'   2-й разряд цифр:
'     1 - переименовывать файл\папку (по умолчанию},
'     2 - не переименовывать.
' Если не указана {целевая папка}, то используется текущая папка.
' Можно указать несколько разделителей, перечислив их через символ "".
' Параметр {обрабатываемые разделители} указывает, какие разделители
'   в имени файла\папки учитываются при создании дерева папок. Данный параметр
'   представляет из себя набор 0 и 1, задающих необходимость (0 - нет,
'   1 - да) обработки разделителя в соответствующей позиции слева направо.

' Пример параметров вызова из TC:
' %L "%T" 22 "_\-\test" 101

' Автор - Batya
'==============================================================================
Option Explicit
'================= Изменяемые параметры =======================================
Const DefaultMode       = 11    'Режим по умолчанию
Const UpperCaseMode     = False 'Изменять ли регистр первого символа имени папки
Const DefaultSeparators = "_\-" 'Разделители по умолчанию
'==============================================================================
Dim FSO, FileList, TargetDir, Mode, Separators, Mess, WSH, F, NameArr, r, i, S
Dim Path, Name, FullPath, SepPos, SepPosArr, IsFolder, BaseName

SetMess
Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
CheckParam
For Each F In Split(FSO.OpenTextFile(FileList).ReadAll, vbNewLine)
  If F = "" Then Exit For
  IsFolder = False
  If FSO.FolderExists(F) Then IsFolder = True
  If IsFolder Then
    BaseName = FSO.GetFolder(F).Name
  Else
    BaseName = FSO.GetBaseName(F)
  End If
  NameArr = Split(Separate(BaseName, Separators, SepPosArr, vbNewLine), vbNewLine)
  If TargetDir = "" Then
    Path = FSO.GetAbsolutePathName(FSO.GetParentFolderName(F))
  Else
    Path = TargetDir
  End If
  r = UBound(NameArr)
  On Error Resume Next
  For i = 0 To r - 1
    Name = NameArr(i)
    If Name <> "" Then
      If UpperCaseMode Then Name = UCase(Left(Name,1)) & Mid(Name, 2)
      Path = Path & "" & Name
      If Not FSO.FolderExists(Path) Then FSO.CreateFolder Path
      If Err.Number <> 0 Then
        MessBox Mess(5) & vbNewLine & Err.Description, 1
        Err.Clear
        Quit
      End If
    End If
  Next
  If Rank(Mode, 2) = 2 Then NameArr(r) = BaseName
  FullPath = Path & "" & NameArr(r)
  If Not IsFolder Then FullPath = FullPath & "." & FSO.GetExtensionName(F)
  If IsFolder Then
    Select Case Rank(Mode, 1)
      Case 1 FSO.CopyFolder GetPath(F), FullPath
      Case 2 FSO.MoveFolder GetPath(F), FullPath
    End Select
  Else
    Select Case Rank(Mode, 1)
      Case 1 FSO.CopyFile F, FullPath
      Case 2 FSO.MoveFile F, FullPath
    End Select
  End If
  If Err.Number <> 0 Then
    MessBox Mess(5) & vbNewLine & Err.Description, 1
    Err.Clear
    Quit
  End If
  On Error GoTo 0
Next

MessBox Mess(6), 3

Quit

Sub CheckParam
  If WScript.Arguments.Count = 0 Then
    MessBox Mess(1), 1
    Quit
  End If
  FileList = WScript.Arguments(0)
  If Not FSO.FileExists(FileList) Then
    MessBox Mess(2), 1
    Quit
  End If
  If WScript.Arguments.Count > 1 Then
    TargetDir = WScript.Arguments(1)
    If Not TargetDir = "" Then
      TargetDir = GetPath(TargetDir)
      If Not FSO.FolderExists(TargetDir) Then
        MessBox Mess(3), 1
        Quit
      End If
    End If
  Else
    TargetDir = ""
  End If
  If WScript.Arguments.Count > 2 Then
    Mode    = WScript.Arguments(2)
    If Mode = "" Then Mode = DefaultMode
    If IsNumeric(Mode) Then
      Mode = CInt(Mode)
    Else
      MessBox Mess(4), 1
      Quit
    End If
    If Not(Rank(Mode,1) = 1 Or Rank(Mode,1) = 2) Then
      MessBox Mess(4), 1
      Quit
    End If
    If Not(Rank(Mode,2) = 1 Or Rank(Mode,2) = 2) Then
      MessBox Mess(4), 1
      Quit
    End If
  Else
    Mode = DefaultMode
  End If
  If WScript.Arguments.Count > 3 Then
    S = WScript.Arguments(3)
  Else
    S = ""
  End If
  If S = "" Then S = DefaultSeparators
  Separators = Split(S, "")
  If WScript.Arguments.Count > 4 Then
    SepPos  = WScript.Arguments(4)
    If Not IsNumeric(SepPos) Then
      MessBox Mess(7), 1
      Quit
    End If
    r = Len(SepPos) - 1
    ReDim SepPosArr(r)
    For i = 0 To r
      S = Mid(SepPos, i + 1, 1)
      If Not(S = 0 Or S = 1) Then
        MessBox Mess(7), 1
        Quit
      End If
      SepPosArr(i) = (S = 1)
    Next
  Else 
    SepPosArr = Array()
  End If
End Sub

Sub SetMess
  Set Mess = CreateObject("Scripting.Dictionary")
  Mess.Add 0,  "Создание дерева папок"
  Mess.Add 1,  "Не указаны входные параметры!"
  Mess.Add 2,  "Файл-список не существует!"
  Mess.Add 3,  "Целевая папка не существует!"
  Mess.Add 4,  "Неправильно указан режим работы скрипта!"
  Mess.Add 5,  "Операция прервана по причине ошибки:"
  Mess.Add 6,  "Операция завершена."
  Mess.Add 7,  "Неправильно указан параметр позиций обрабатываемых разделителей!"
End Sub

Function MessBox(pMess, pMode)
  Dim lIcon
  Select Case pMode
    Case 1 lIcon = vbCritical    + vbOKOnly
    Case 2 lIcon = vbExclamation + vbOKOnly
    Case 3 lIcon = vbInformation + vbOKOnly
    Case 4 lIcon = vbExclamation + vbOKCancel
  End Select
  MessBox = MsgBox(pMess, lIcon, Mess(0))
End Function

Function GetPath(pPath)
  GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
End Function

Function Separate(pText, pSeparators, pSepPosArr, pL)
  Dim ss, sf, lPos0, lPos1, lS, lText
  ss = "<":sf = ">":lText = pText
  For Each lS In pSeparators
    lPos0 = 1
    Do
      lPos1 = InStr(lPos0, lText, ss)
      If lPos1 = 0 Then
        lText = Left(lText, lPos0 - 1) & Replace(Mid(lText, lPos0), lS, ss & lS & sf)
        lPos0 = 1
      Else
        lText = Left(lText, lPos0 - 1) & Replace(Mid(lText, lPos0, lPos1 - lPos0), lS, ss & lS & sf) &_
                Mid(lText, lPos1)
        lPos0 = InStr(lPos1 + 1, lText, sf) + 1
      End If
    Loop Until lPos0 = 1
  Next
  lPos0 = 1:i = 0
  r = UBound(pSepPosArr)
  Do
    lPos1 = InStr(lPos0, lText, ss)
    If lPos1 > 0 Then
      lPos0 = InStr(lPos1 + 1, lText, sf) + 1
      If r >= i Then
        If pSepPosArr(i) Then lText = Left(lText, lPos1 - 1) & pL & Mid(lText, lPos0):lPos0 = lPos1 + Len(pL)
      Else
        lText = Left(lText, lPos1 - 1) & pL & Mid(lText, lPos0):lPos0 = lPos1 + Len(pL)
      End If
      i = i + 1
    Else
      lPos0 = 1
    End If
  Loop Until lPos0 = 1
  lText = Replace(lText, ss, ""):lText = Replace(lText, sf, "")
  Separate = lText
End Function

Function Rank(pNumber, pPosition)
  Rank = Left(Right(pNumber, pPosition), 1)
End Function

Sub Quit
  Set Mess = Nothing
  Set FSO  = Nothing
  Set WSH  = Nothing
  WScript.Quit
End Sub

Согласно изначально поставленной задачи, параметры вызова из TC должны быть:

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

%L "" 12 "-"

[mod="CaptainFlint"]Скрипт отредактирован по просьбе Batya: исправлена ошибка при работе с количеством параметров меньше 5.[/mod]

[angry_dog]

Не получается. Где-то туплю. В параметрах запуска скрипта поставил: %L "" 12 "-". Путь запуска очистил. После запуска создаётся первая папка, потом ошибка:" Операция прервана - Путь не найден"

Согласно изначально поставленной задачи, параметры вызова из TC должны быть:

Если быть точным, задача такая: из папки (лучше группы папок) вида: folder - 2009 - folder создать структуру folder\2009 - folder с перемещением содержимого изначальной папки ниже на подкаталог.
Большое Вам спасибо за помощь.
P.S. C ошибкой в пути запуска разобрался - забыл пробелы перед и после тире. Теперь не могу найти параметры, что бы второй разделитель не обрабатывался и вторая по глубине вложения папка оставалась вида: 2009 - folder

[Batya]

Теперь не могу найти параметры, что бы второй разделитель не обрабатывался и вторая по глубине вложения папка оставалась вида: 2009 - folder

Для такого варианта парметры должны быть следующие:

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

%L "" 12 " - " 10