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 

Копирование с переименовыванием по счетчику
Goto page Previous  1, 2, 3, 4 ... 11, 12, 13  Next
 
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander printer-friendly view
View previous topic :: View next topic  
Author Message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Fri Oct 21, 2011 10:50    Post subject: Reply with quote

Мои 5 копеек:
Code:
'======================================================================
' Создание нескольких копий каждого файла из файла-списка
'
' Параметры:
' {файл-список} {целевая папка} {количество}
'
' Пример параметров при вызове из TC:
' %L "%T" 200
'======================================================================
Option Explicit
Dim FSO, FF, F, i, TF, T, Q

With WScript
  If .Arguments.Count < 3 Then
    MsgBox "Неправильно заданы параметры!", vbOKOnly + vbCritical, "Создание нескольких копий"
    .Quit
  End If
  FF = .Arguments(0)
  TF = .Arguments(1)
  Set FSO = CreateObject("Scripting.FileSystemObject")
  If (Not FSO.FolderExists(TF)) And (TF <> "") Then
    MsgBox "Некорректно указана целевая папка!", vbOKOnly + vbCritical, "Создание нескольких копий"
    Set FSO = Nothing
    .Quit
  End If
  If TF <> "" Then If Right(TF, 1) <> "\" Then TF = TF & "\"
  Q = CInt(.Arguments(2))
End With


With FSO.OpenTextFile(FF, 1)
  Do While Not .AtEndOfStream
    F = Trim(.ReadLine)
    If F <> "" Then
      If FSO.FileExists(F) Then
        If TF = "" Then T = FSO.GetParentFolderName(F) & "\" Else T = TF
        For i = 1 To Q
          FSO.CopyFile F, NextName(T & FSO.GetFileName(F))
        Next
      End If
    End If
  Loop
  .Close
End With

Set FSO = Nothing
WScript.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

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



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Fri Oct 21, 2011 12:59    Post subject: Reply with quote

Было.
Back to top
View user's profile Send private message
Avada



Joined: 01 Aug 2008
Posts: 10236
Location: Россия, Саратов

Post (Separately) Posted: Fri Oct 21, 2011 13:05    Post subject: Reply with quote

Объединяю тему с уже существующей.
_________________
Даже самая богатая фантазия
Не представит себе наши безобразия.
Back to top
View user's profile Send private message
DeathStalker



Joined: 01 Sep 2006
Posts: 331
Location: Санкт-Петербург

Post (Separately) Posted: Fri Oct 21, 2011 17:03    Post subject: Reply with quote

Всем спасибо за помощь.
_________________
Гугль - это Матрица, чем меньше его спрашивать, тем слабее будут машины во время Великой Битвы
TC10.00b6 x86 Windows 10 x64 (Windows 7 x64)
Back to top
View user's profile Send private message
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Fri Oct 21, 2011 17:52    Post subject: Reply with quote

Пусть ещё облегчённый вариант будет:
Code:
' Cоздать указанное число копий для каждого выделенного элемента
' Параметры: %L "<путь назначения>"
' Пример: %L "%P"
'===============================================================
If WScript.Arguments.Count = 0 Then WScript.Quit
L = vbNewLine
Count = InputBox(L&L&L&L&"Введите число создаваемых копий" & L &_
"для каждого элемента списка :", "             Создание копий выделенных элементов")
If IsNumeric(Count) Then             
  For Each F in Split(CreateObject("Scripting.FileSystemObject")._
  OpenTextFile(WScript.Arguments(0)).ReadAll, L)
    If F > vbNullString Then
      For n = 1 To Abs(Count)
        CreateObject("Shell.Application").NameSpace(WScript.Arguments(1)).CopyHere F, 8
      Next
    End If
  Next
End If
Back to top
View user's profile Send private message
Serrg



Joined: 25 Dec 2011
Posts: 3

Post (Separately) Posted: Sun Dec 25, 2011 17:21    Post subject: Перемещение файлов с переименованием (нумерацией) Reply with quote

Здравствуйте!
Есть такая проблема: производится перемещение файлов с разных фотоаппаратов в одну папку на компьютере. Необходимо, чтобы в папке файлы именовались просто порядковыми номерами, т.е. 01.jpg, 02.jpg, ...,10.jpg и т.д., а при добавлении файлов в эту папку, нумерация продолжалась. Пока всё это делается вручную: перемесить-выделить новые файлы-групповое переименование с установкой начального значения счетчика. Можно ли автоматизировать этот процесс? Буду благодарен всем откликнувшимся.

 !  Моторокер:
Тема объединена с текущей.
Back to top
View user's profile Send private message
Tol!k



Joined: 01 Apr 2008
Posts: 1727
Location: Арзамас

Post (Separately) Posted: Sun Dec 25, 2011 18:05    Post subject: Reply with quote

Было. Пользуйтесь поиском.
Back to top
View user's profile Send private message
Serrg



Joined: 25 Dec 2011
Posts: 3

Post (Separately) Posted: Sun Dec 25, 2011 18:28    Post subject: Reply with quote

Спасибо, что не оставили без внимания, но перед тем как задать вопрос я просмотрел все темы в разделе автоматизации, а так же пробовал поиск по словам "перемещение" и "переименование". К сожалению ничего подходящего не нашел Sad . Помогите ссылочкой, пожалуйста.
Back to top
View user's profile Send private message
Tol!k



Joined: 01 Apr 2008
Posts: 1727
Location: Арзамас

Post (Separately) Posted: Sun Dec 25, 2011 19:32    Post subject: Reply with quote

к http://forum.wincmd.ru/viewpost.php?p=62914 добавил перемещение
Code:
@echo off &setlocal enableextensions &chcp 1251 >nul
rem  Копирование файлов и папок с переименованием по счётчику
rem  Параметры: %L "D:\куда\" "Приставка_"
rem             %L "%T" "" -m
rem  -m — удалять источник
rem  Автор: Tol!k

set "trg=%~2" &set "pref=%~3"
if "%~4"=="-m" set "move=Yes"
for /f "usebackq delims=" %%f in ("%~1") do call :p "%%f"
goto :eof

:p
set "name=%~1" &set "ext=%~x1"
set /a 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 "%name:~-1%"=="\" (
  xcopy "%name%*" "%trg%\%new%" /i /e /k/r/h >nul &&if "%move%"=="Yes" rd /s /q %1
) else (
  echo f| xcopy %1 "%trg%\%new%" /k/r/h >nul &&if "%move%"=="Yes" del /f /q %1
)
goto :eof

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

Back to top
View user's profile Send private message
Tol!k



Joined: 01 Apr 2008
Posts: 1727
Location: Арзамас

Post (Separately) Posted: Sun Dec 25, 2011 19:35    Post subject: Reply with quote

http://forum.wincmd.ru/viewtopic.php?p=77596
Back to top
View user's profile Send private message
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Sun Dec 25, 2011 21:42    Post subject: Reply with quote

Serrg
А нумеровать нужно сразу или только при совпадении?
Back to top
View user's profile Send private message
Serrg



Joined: 25 Dec 2011
Posts: 3

Post (Separately) Posted: Mon Dec 26, 2011 03:48    Post subject: Reply with quote

Tol!k
Большущее спасибо за помощь - то что надо!

Flasher
Совпадений не должно быть в принципе, т.к. в фотоаппаратах файлы именуются по другому (IMG0001.jpg, P0001.jpg и т. п.).
Back to top
View user's profile Send private message
Tol!k



Joined: 01 Apr 2008
Posts: 1727
Location: Арзамас

Post (Separately) Posted: Fri Apr 13, 2012 20:33    Post subject: Reply with quote

к http://forum.wincmd.ru/viewpost.php?p=62933
добавил третий параметр — кол-во разрядов в номере (по умолч. 3)

Code:
@echo off &setlocal enableextensions &chcp 1251 >nul
rem  Копирование файлов и папок с добавлением номера
rem  Параметры: "%L" "d:\куда\" 3
rem  Автор: Tol!k
rem  http://forum.wincmd.ru/viewpost.php?p=91443

if not "%~3"=="" (set "#=%~3") else set "#=3"
setlocal enabledelayedexpansion
for /l %%i in (2,1,%#%) do (set "min=0!min!" &set "max=9!max!")
endlocal &set "min=0%min%" &set "max=9%max%"

set "trg=%~2"
for /f "delims=" %%f in ('type "%~1"') do call :p "%%f" "%%f."
goto :eof

:p
set "pre=%~n1"
if "%pre%"=="" set "pre=%~n2"
set "name=%~1" &set "ext=%~x1"
set /a n=0 &goto :%min%
:0000000000
:000000000
call :loop 100000000 &set /a n-=100000000
:00000000
call :loop 10000000 &set /a n-=10000000
:0000000
call :loop 1000000 &set /a n-=1000000
:000000
call :loop 100000 &set /a n-=100000
:00000
call :loop 10000 &set /a n-=10000
:0000
call :loop 1000 &set /a n-=1000
:000
call :loop 100 &set /a n-=100
:00
call :loop 10 &set /a n-=10
:0
call :loop 1
title "%new%"

if "%name:~-1%"=="\" (
  xcopy "%name%*" "%trg%\%new%" /i /e /k/r/h >nul
) else (
  echo f| xcopy "%name%" "%trg%\%new%" /k/r/h >nul
)
goto :eof

:loop
if "%n%"=="%max%" (
  echo %max% единиц в месте назначения,
  echo недостаточно разрядности счётчика.
  title STOP &pause >nul &exit /b 9
)
set /a n+=%1
setlocal enabledelayedexpansion
set "e=%min%%n%" &set "e=!e:~-%#%!"
endlocal &set "e=%e%"
set "new=%pre%_%e%%ext%"
if exist "%trg%\%new%" goto :loop
goto :eof

Back to top
View user's profile Send private message
obse



Joined: 30 Jul 2012
Posts: 3

Post (Separately) Posted: Mon Jul 30, 2012 16:34    Post subject: Reply with quote

Ребята, нужна помощь. Скажите, можно ли написать bat-файл, который будет находить на всех дисках (С, D, E, *) файлы скажем с расширением *.txt и копировать их в папку D:\1, и при одинаковом имени файла не заменять его, а добавлять к названию цифру. (1.txt, 1(1).txt, 1(2).txt, 1(3).txt,.....).
Читал, пробовал делать, но или в голове не так что-то или руки кривые. Помогите с файликом, пожалуйста.
Back to top
View user's profile Send private message
Avada



Joined: 01 Aug 2008
Posts: 10236
Location: Россия, Саратов

Post (Separately) Posted: Mon Jul 30, 2012 17:15    Post subject: Reply with quote

obse
Заданный вопрос ни к подфоруму "Общие вопросы", ни уж тем более к теме Ошибка ввода/вывода - как создать список нечитающихся файлов не имеет ни малейшего отношения. Читаем правила форума и учимся пользоваться поиском.
Сообщение перенесено в более подходящее место. А тут уж специалисты по автоматизации выскажут своё мнение.
_________________
Даже самая богатая фантазия
Не представит себе наши безобразия.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander All times are GMT + 4 Hours
Goto page Previous  1, 2, 3, 4 ... 11, 12, 13  Next
Page 3 of 13

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group