Копирование с переименовыванием по счетчику

[Dimsok]

http://forum.wincmd.ru/viewpost.php?p=85158
Изменил, чтобы именовались с пробелами и без скобок. Только нужна подсказка, что поправить, чтобы если в пункте назначения уже был файл с таким же именем без номера, сразу именовался как "название файла 2", а не название файла 1"

[Flasher]

Ошибку я так и не воспроизвёл, но с пробелом некорректность таки была.
[cut="Обновлённый вариант:"]

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

'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Cоздать указанное число копий/пустышек для каждого выбранного элемента
' с добавлением счётчика после базового имени, начиная с последнего номера

' Параметры: %WL "<путь назначения>" <число копий> <вставка до №> <расширение нового файла>
' Если указан 5-й параметр, то создаваться будут пустые элементы

' Примеры:   %WL "%P"   |   %WL "%T" 3   |   %WL "%P" 5 _v   |   %WL "%T" 1 "" txt
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••

Option Explicit: Dim C, List, Path, Count, Px, Ext, ShA, FSO
Dim Rgx, F, FN, Test, Ex, BN, Max, i, n, M, Items, Exist, FP

With WSH.Arguments
  C = .Count : If C = 0 Then WSH.Quit
  If C = 1 Then MsgBox "Должно быть указано не менее 2-х параметров!", 48 : WSH.Quit
  List = .Item(0) : Path = .Item(1) : If C > 2 Then Count = .Item(2)
  If Count = "" Then Count = Trim(InputBox(String(4, vbLf) & "Введите число создаваемых копий"&_
  vbLf & "для каждого выбранного элемента:", Space(13) & "Создание копий выбранных элементов"))
  If Not IsNumeric(Count) Then WSH.Quit : End If : If C > 3 Then Px = .Item(3)
  If C = 5 Then If .Item(4) <> "" Then Ext = "." & .Item(4) End If
End With : Set Rgx = New RegExp : Rgx.Pattern = "^(.*\D)?(([0]*)\d+)$"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ShA = CreateObject("Shell.Application")
Set List = FSO.OpenTextFile(List,,,-1)

Do : F = Trim(List.ReadLine)
  FN = FSO.GetFileName(F)
  If FSO.FolderExists(F) Then
    Test = 1 : BN = FN
  ElseIf FSO.FileExists(F) Then
    Test = 0 : BN = FSO.GetBaseName(FN)
    Ex = FSO.GetExtensionName(F) : If C < 5 And Len(Ex) Then Ext = "." & Ex
  End If : Max = 0 : FP = FSO.BuildPath(Path, FN)
  Exist = Not (FSO.FolderExists(FP) Or FSO.FileExists(FP)) And Not Rgx.Test(BN)
  If Rgx.Test(BN) Then
    M = Rgx.Execute(BN)(0).SubMatches(1) : Max = M : BN = Left(BN, Len(BN) - Len(M))
  ElseIf Right(BN, Len(Px)) <> Px Then
    n = 1
    For i = 1 To Len(Px)
      If Left(Px, i) = Right(BN, i) Then n = i
    Next : BN = BN & Mid(Px, n)
  End If : Set Items = ShA.NameSpace(Path).Items
  Items.Filter 73952, BN & "*" & Ext
  For Each i in Items
    FP = i : If Test = 0 Then FP = FSO.GetBaseName(i)
    If Rgx.Test(FP) Then Set FN = Rgx.Execute(FP)(0) : M = FN.SubMatches(1) :_
    If M > Max And FN.SubMatches(0) = Left(FN.SubMatches(0), Len(BN & Px)) Then Max = M
  Next : i = 1 : If Exist Then i = 0 : Count = Count - 1
  For i = i To Count
    If i Then
      If Rgx.Execute(Max)(0).SubMatches(2) = "" Then
        Max = Max + 1
      Else
        If Len(Max + 1) >= Len(Max) Then Max = Max + 1 Else _
        Max = String(Len(Max) - Len(Max + 1), "0") & Max + 1
      End If : FP = FSO.BuildPath(Path, BN & Max) & Ext
    ElseIf Not Rgx.Test(Max) Then Max = Max + 1
    End If
    If Test Then
      If C = 5 Then FSO.CreateFolder   FP & Ext  Else FSO.GetFolder(F).Copy FP, 0
    Else
      If C = 5 Then FSO.CreateTextFile(FP & Ext) Else FSO.CopyFile F, FP, 0
    End if
  Next
Loop Until List.AtEndOfStream : CreateObject("WScript.Shell").SendKeys "^r"

[/cut]Сделал, чтобы 00...№ нормально переименовывались.
Ну, если тебе не нужна юникодность, пляска от последнего номера с быстрым его нахождением, урезание совпадений, то нет проблем, пользуйся более простеньким вариантом.

[Dimsok]

Там была какая-то ошибка с mid. Если удалить проблемную строку, то при наличии файла жаловалось, что файл уже имеется вместо того, чтобы именоваться более высоким номером.
Вот сейчас норм. стало, спасибо. А можно точно такой же вариант, но с перемещением? Тут в теме находил подобный скрипт, но чего-то не то.

Добавлено спустя 16 минут:

Хм, поторопился. Ошибка появляется (Line 63, Char 56, file already exists), если, к примеру, копирую файл down 2.png в папку, где есть файлы down 3-down 10. По идее должно создаваться down 11. Ну и хотелось бы, чтобы если в папке нет файлов более низкого значения, именовалось более низкими цифрами сначала, а потом по восходящей. Т.е при копировании down 4 не в down 5 сразу, а down, down 2, down 3 и т.д.

Добавлено спустя 29 минут:

Ещё странность. Вроде пробовал только, после down именовалось сразу down 2, а теперь снова стало сначала down 1.

Добавлено спустя 3 минуты:

Ещё одна странность. при копировании выделенных down 2, down 3 всё как нужно. оба файла копируются, а если копировать down, down 2, то копируется только down.

[Flasher]

А можно точно такой же вариант, но с перемещением?

Сделать-то можно, но я бы предпочёл что-то вроде этого. Там системное автопереименование.

копирую файл down 2.png в папку, где есть файлы down 3-down 10

Ошибки не вижу. Но с созданием есть проблемка. Исправим.

при копировании down 4 не в down 5 сразу, а down

Так скрипт работает от последнего номера, дыры латать не должен, т.к. искать объекты затруднительно.

Ещё странность.

Это не странность. У меня во всех скриптах счётчик начинается с единицы. Помню лишь раз, когда просили на двойку поправить. Единица - это первая копия, в то время как оригинал без счётчика. Такая логика.

а если копировать down, down 2, то копируется только down.

Хм. Странно, что сразу не заметил. Убёрем проблему.

[Dimsok]

Flasher или забыл или сильно обленился .
Через пару дней сильно понадобится сей скрипт.

[Flasher]

Оба "или" мимо. Семейные обстоятельства подводят. Плюс ты не развил тему "за/против". Перемещение, например, я не вижу смысла добавлять, т. к. оно может касаться только одного экземпляра.

[Dimsok]

[table][tr][td]копирую файл down 2.png в папку, где есть файлы down 3-down 10[/td] [/tr][/table]Ошибки не вижу. Но с созданием есть проблемка. Исправим.

[table][tr][td]а если копировать down, down 2, то копируется только down.[/td] [/tr][/table]Хм. Странно, что сразу не заметил. Убёрем проблему.

Добавлено спустя 7 минут:

И что значит " касаться одного экземпляра"? Например, я хочу скопировать (переместить) много файлов в каталог с совпадающими именами. Если скопированные удалялись бы из исходного каталога было бы видно всё ли перемещается или нет. А то скопируешь, удалишь потом, а окажется, они не все скопировались с переименованием.

[Flasher]

Когда цитируешь, обосновывай для чего и смотри на результат (тут таких тегов нет).

Файлов-то много, но копий в случае перемещения нет. А здешние скрипты созданы для умножения копий. К тому же в тот же каталог перемещать вообще нет смысла.

[Dimsok]

Привык кнопкой в опере цитировать.
А жал я на неё, потому что ты заговорил о ненужности перемещения, как будто кроме этого нечего менять.
А кто говорил про перемещение в тот же каталог. Мне например нужно из десятков папок где файлы имеют одинаковые названия все это расположить в одной

[Flasher]

Слабый аргумент. Я же не буду сперва одно, потом другое править, когда лучше за один присест всё вместе в коде сопоставить.

А для перемещения при одном экземпляре специфика счётчика — не такая уж и важная вещь. Разве кода по приведённой ссылке для этого недостаточно?

[Dimsok]

Это ты про это: http://forum.wincmd.ru/viewpost.php?p=123747

Мне как раз специфика важна. Там он называет так, как делает коммандер, просто добавляет "copy", а надо чтобы именно возрастающими цифрами. Во-первых, что-то вроде "Copy (2)" не оч. эстетично, а во-вторых я привык искать файлы по первым буквам, а это что, всё будет по-одинаковому называться.

[sa]

называет так, как делает коммандер, просто добавляет "copy", а надо чтобы именно возрастающими цифрами.

Разве Total Commander при автоматическом переименовании копируемых файлов не использует возрастающие числа (в скобках)? Или речь не о нём?

[Dimsok]

sa
Ну наверное так, не помню. Помню, что там тоже в скобках что-то, а подстроить счётчик под себя нельзя. Было бы можно, вопросов не было бы, пользовался им.

[sa]

Помню, что там тоже в скобках что-то

Для однозначности приведу строчку из Hist_rus.txt:

- Кнопка "Опции" в диалоге копирования по F5: Новые опции для автоматического переименования копируемого файла либо файла назначения при конфликте имён. Имена будут выглядеть как filename(2).ext, filename(3).ext и т.д.

[elshad66]

Допустим некая прога A генерирует маску ,и сохраняет файл mask.png в определенной папке 1
B тоже время открыта прога Б ,и она использует другую маску mask.png ,из папки 2
Перетащить или заменить маску из папки 1 в папку 2,не получается т.к. маска уже используется прогой Б
приходиться в ручную переименновывать,,добавлять номер mask1.png,и тогда можно перетащить
Нужен BATник или CMD или еще что ,чтоб одним кликом ,перекинуть файл mask.png из папки 1 в папку 2 с добавлением номера,
в тот код что в начале темы подставил свои данные ,присвоил CMD.и положил рядом с маской ,кликаю на файл потом на cmd но не работает
может где то накосячил, в программировании не оч силен, поправьте код если не затруднит

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

@echo off &chcp 1251 >nul 
rem  Копирование файлов и папок с добавлением счётчика 
rem  Параметры кнопки: %L "%T" 
rem  или: %L "d:\C:\cw-6510\" 
rem  Автор: Tol!k 

set "C:\cw-6510" 
setlocal enableextensions 
for /f "usebackq delims=" %%f in ("%~1") do call :p "%%f" "%%f." 
exit /b 

:p  
set "mask.png" &set "C:\cw-6510" 
set "n=0" 
call :loop 1000 &set /a n-=1000 
call :loop 100 &set /a n-=100 
call :loop 10 &set /a n-=10 
call :loop 1 
title %new% 
if "mask.png"=="\" ( 
xcopy "mask.png" "C:\cw-6510" /i /s/e /k/r/h >nul 
) else ( 
echo f| xcopy "mask.png" "C:\cw-6510" /k/r/h >nul 
) 
goto :eof 

:loop 
if "%n%"=="9999" ( 
title STOP 
echo 9999 единиц в месте назначения, 
echo недостаточно разрядности счётчика. 
pause >nul &exit 
) 
set /a n+=%1 
set "e=000%n%" 
set "e=%e:~-4%" 
set "new=%prist%_%e%%ext%" 
if exist "%targ%\%new%" call :loop %1 
goto :eof 

файл mask.png лежит здесь
C:\Documents and Settings\Admin\Рабочий стол\egl\EGL3Desktop
перекинуть нужно в
C:\cw-6510