Total Commander

Скрипт копирует множество файлов во множество папок. Вешаем на кнопку, в параметрах указываем %L, далее выделяем файлы, жмем на кнопку, потом выделяем папки и еще раз жмем на кнопку. Выделенные файлы будут скопированы в выделенные папки. Что бы выделить папки, разбросанные в разных местах по разным дискам, используем прекрасную возможность выделять папки во время установки вида "Дерево каталогов".
С WHS только знакомлюсь, поэтому возможно не совсем по правилам написан скрип, но работает. И еще возникает исключение, если во время выделения файлов выделить каталог. Пока не догнал как исправить. Script Helper не использует, поэтому возможна работа с Total commander установленном на флешке.

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

Set WshArg = WScript.Arguments
If WshArg.Count>0 Then
Set FSO = CreateObject("Scripting.FileSystemObject")
aargument = WshArg.Item(0)
Set WSHShell = CreateObject("WScript.Shell")
Set ObjEnv = WSHShell.Environment("Process")
ttemp = ObjEnv("TEMP")
ppath = ttemp & "\filelisttemp.txt"
If FSO.FileExists (ppath) then
Set folderlist = FSO.getfile(aargument)
Set ffilelist = FSO.getfile(ppath)
Set msgfiles = ffilelist.OpenAsTextStream(1)
Set msgfolders = folderlist.OpenAsTextStream(1)
msgfilestext = msgfiles.ReadAll()
msgfolderstext = msgfolders.ReadAll()
result = MsgBox("Будем копировать?" & vbCrLf & "файлы:" & vbCrLf & msgfilestext & vbCrLf & "в папки:" & vbCrLf & msgfolderstext,36,"Внимание!")
msgfolders.Close
msgfiles.Close
If result = 6 then
Set TextStream = folderlist.OpenAsTextStream(1)
StrFolder = vbNullString
While Not TextStream.AtEndOfStream
StrFolder = TextStream.ReadLine()
Set TextStreamFL = ffilelist.OpenAsTextStream(1)
StrFiles = vbNullString
While Not TextStreamFL.AtEndOfStream
StrFiles = TextStreamFL.ReadLine()
Set copyfilename = FSO.getfile(strfiles)
copyfilename.Copy strfolder
Wend
TextStreamFL.Close
Wend
TextStream.Close
MsgBox "Скопировано",48,"Внимание!"
End If
FSO.deletefile ppath, 0
else
Set ffile = FSO.GetFile(aargument)
ppath = ttemp & "\filelisttemp.txt"
ffile.Copy ppath
MsgBox "Список файлов для копирования создан!"
End If
End If

jehaz писал(а):И еще возникает исключение, если во время выделения файлов выделить каталог. Пока не догнал как исправить.

Ошибка здесь:

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

StrFiles = TextStreamFL.ReadLine() 
Set copyfilename = FSO.getfile(strfiles)
copyfilename.Copy strfolder

Сделай:

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

StrFiles = TextStreamFL.ReadLine()
If FSO.FileExists(StrFiles) Then
  FSO.CopyFile StrFiles, strfolder
End If
If FSO.FolderExists(StrFiles) Then
  FSO.CopyFolder StrFiles, strfolder
End If

А еще также хорошо-бы проверять, что strfolder - папка, а не файл.

Немного отрихтовал свой скрипт. Теперь он копирует любое количество файлов и папок в любое количество папок. Спасибо Batya за подсказку как отсортировать файлы от папок. Пригодилось. Возможно есть мусор - пока мало опыта. Подсказывайте.

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

'===========================================================
'Скрипт копирует любое количество файлов и папок в
'любое количество папок. Не требует Script Helper.
'В параметрах к запуску указать %L
'Выделить объекты (файлы, папки) "что копировать", жмем
'кнопку. Далее выделяем папки "куда копировать", жмем кнопку.
'Если при выделении папок "куда копировать" ничего не выделено,
'скрипт прекращает работу. Или если при выделении папок
'"куда копировать" выделены файлы, то они игнорируются.
'===========================================================
Option Explicit
Dim Argument
Dim Tempdir, PathTempFile, FolderList, FileList, MsgFoldersStr, MsgFileText, MsgFolders
Dim MsgFoldersText, StrFolder, StrFiles, CopyFileName, MsgFileStr
Dim Lenstr, LastChar, Result, FileListFile
Dim WshArg, FSO, WSHShell, ObjEnv, TextStreamFL, TextStream, ObjShellApp, CopyObj
Set WshArg = WScript.Arguments
Set ObjShellApp = CreateObject("Shell.Application")
If WshArg.Count>0 Then
Set FSO = CreateObject("Scripting.FileSystemObject")
Argument = WshArg.Item(0)
Set WSHShell = CreateObject("WScript.Shell")
Set ObjEnv = WSHShell.Environment("Process")
Tempdir = ObjEnv("TEMP")
PathTempFile = Tempdir & "\FileListTemp.txt"
If FSO.FileExists (PathTempFile) then
Set FolderList = FSO.getfile(Argument)
Set FileList = FSO.getfile(PathTempFile)
Set TextStream = FolderList.OpenAsTextStream(1)
MsgFoldersStr = vbNullString
MsgFoldersText = vbNullString
While Not TextStream.AtEndOfStream
MsgFoldersStr = TextStream.ReadLine()
If FSO.FolderExists(MsgFoldersStr) Then
MsgFoldersText = MsgFoldersText & MsgFoldersStr & vbCrLf
End If
Wend
TextStream.Close
Set MsgFileStr = FileList.OpenAsTextStream(1)
MsgFileText = MsgFileStr.ReadAll()
If MsgFoldersText <> "" then
Result = MsgBox("Будем копировать?" & vbCrLf & "объекты:" & vbCrLf & MsgFileText & vbCrLf & "в папки:" & vbCrLf & MsgFoldersText,36,"Внимание!")
Else
MsgBox "Не выделены папки для для копирования!!!" & vbCrLf & "Временные файлы удалены!" & vbCrLf & "Работа скрипта завершена!",48,"Внимание!!!"
End If
MsgFileStr.Close
If Result = 6 then
Set TextStream = FolderList.OpenAsTextStream(1)
StrFolder = vbNullString
While Not TextStream.AtEndOfStream
StrFolder = TextStream.ReadLine()
Set TextStreamFL = FileList.OpenAsTextStream(1)
StrFiles = vbNullString
While Not TextStreamFL.AtEndOfStream
StrFiles = TextStreamFL.ReadLine()
If FSO.FolderExists (StrFolder) Then
Set CopyObj = ObjShellApp.NameSpace(StrFolder)
CopyObj.CopyHere StrFiles,20
End If
Wend
TextStreamFL.Close
Wend
TextStream.Close
MsgBox "Скопировано...",48,"Внимание!"
End If
FSO.deletefile PathTempFile, 0
else
Set FileListFile = FSO.GetFile(Argument)
PathTempFile = Tempdir & "\FileListTemp.txt"
FileListFile.Copy PathTempFile
MsgBox "Список файлов для копирования создан!",48,"Внимание!!!"
End If
End If
WScript.Quit

jehaz писал(а):Возможно есть мусор - пока мало опыта. Подсказывайте.

Первое и ОЧЕНЬ важное - форматируй текст кода отступами! Если ты сам при небольшом объеме еще можешь разобраться, то читать код другим просто невозможно и совсем неинтересно. Наверное, если бы код был более читабельным, то еще кто-нибудь, кроме меня, мог поучаствовать в обсуждении.
Второе - вставляй комментарии и пустые строки. Это помогает визуально разделить код на блоки.

Далее...
Зачем 2 раза открывать TextStream с именами папок, если у тебя уже сохранен массив папок в MsgFoldersText?
Смысл тот же, но я бы этот код

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

While Not TextStream.AtEndOfStream 
MsgFoldersStr = TextStream.ReadLine() 
If FSO.FolderExists(MsgFoldersStr) Then 
MsgFoldersText = MsgFoldersText & MsgFoldersStr & vbCrLf 
End If 
Wend

записал так (обрати вимание на отступы!!!)

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

While Not TextStream.AtEndOfStream 
  MsgFoldersStr = TextStream.ReadLine() 
  If FSO.FolderExists(MsgFoldersStr) Then
    MsgFoldersText = MsgFoldersText & vbCrLf & MsgFoldersStr
  End If
Wend
' Отбрасываем лидирующий vbCrLf
MsgFoldersText = Mid(MsgFoldersText, 3)

Соответственно, потом можно вместо

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

Set TextStream = FolderList.OpenAsTextStream(1) 
StrFolder = vbNullString 
While Not TextStream.AtEndOfStream
...

использовать

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

For Each StrFolder In Split(MsgFoldersText, vbCrLf)
  ...

Потом тебе и

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

If FSO.FolderExists (StrFolder) Then

не понадобится.

И еще - хорошо бы в MsgBox использовать не числовые значения, а vb-константы.

P.S. В принципе, я тоже не крутой программер, но vbs-ом увлекаюсь уже давно, и весь опыт приобретен не из книжек, а на основе "проб и ошибок".

Добавлено: Поправил немного (ступил, однако).

Batya писал(а): Первое и ОЧЕНЬ важное - форматируй текст кода отступами! Если ты сам при небольшом объеме еще можешь разобраться, то читать код другим просто невозможно и совсем неинтересно. Наверное, если бы код был более читабельным, то еще кто-нибудь, кроме меня, мог поучаствовать в обсуждении.

Торопился скорее реализовать. Исправился.

Batya писал(а): Соответственно, потом можно вместо
Код: Выделить всё
Set TextStream = FolderList.OpenAsTextStream(1) 
StrFolder = vbNullString 
While Not TextStream.AtEndOfStream
... 
использовать
Код: Выделить всё
For Each StrFolder In Split(MsgFoldersText, vbCrLf)
  ...
Потом тебе и
Код: Выделить всё
If FSO.FolderExists (StrFolder) Then 
не понадобится.

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

Batya писал(а): И еще - хорошо бы в MsgBox использовать не числовые значения, а vb-константы.

Сделано.

Batya писал(а): Добавлено: Поправил немного (ступил, однако).

Заметил. "Ввод данных за пределами файла". Было было.

Ну вот наверное конечный вариант. Только отформатировал.

Даже если оставишь выделение какое было в "что копировать" то папки сами в себя не копируются. Оболочка следит.

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

'===========================================================
' Скрипт копирует любое количество файлов и папок в
' любое количество папок. Не требует Script Helper.
' В параметрах к запуску указать %L
' Выделить объекты (файлы, папки) "что копировать", жмем
' кнопку. Далее выделяем папки "куда копировать", жмем кнопку.
' Если при выделении папок "куда копировать" ничего не выделено,
' скрипт прекращает работу. Или если при выделении папок
' "куда копировать" выделены файлы, то они игнорируются.
'===========================================================
Option Explicit
Dim Argument
Dim Tempdir, PathTempFile, FolderList, FileList, MsgFoldersStr, MsgFileText, MsgFolders
Dim MsgFoldersText, StrFolder, StrFiles, CopyFileName, MsgFileStr
Dim Lenstr, LastChar, Result, FileListFile
Dim WshArg, FSO, WSHShell, ObjEnv, TextStreamFL, TextStream, ObjShellApp, CopyObj
Set WshArg = WScript.Arguments
Set ObjShellApp = CreateObject("Shell.Application")
If WshArg.Count>0 Then
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Argument = WshArg.Item(0)
   Set WSHShell = CreateObject("WScript.Shell")
   Set ObjEnv = WSHShell.Environment("Process")
   Tempdir = ObjEnv("TEMP")
   PathTempFile = Tempdir & "\FileListTemp.txt"
   If FSO.FileExists (PathTempFile) then
      Set FolderList = FSO.getfile(Argument)
      Set FileList = FSO.getfile(PathTempFile)
      Set TextStream = FolderList.OpenAsTextStream(1)
      MsgFoldersStr = vbNullString
      MsgFoldersText = vbNullString
      While Not TextStream.AtEndOfStream
            MsgFoldersStr = TextStream.ReadLine()
            If FSO.FolderExists(MsgFoldersStr) Then
               MsgFoldersText = MsgFoldersText & MsgFoldersStr & vbCrLf
            End If
      Wend
      TextStream.Close
      Set MsgFileStr = FileList.OpenAsTextStream(1)
      MsgFileText = MsgFileStr.ReadAll()
      If MsgFoldersText <> "" then
         Result = MsgBox("Будем копировать?" & vbCrLf & "объекты:"_
          & vbCrLf & MsgFileText & vbCrLf & "в папки:" & vbCrLf & _
          MsgFoldersText,vbYesNo+vbQuestion,"Внимание!")
      Else
          MsgBox "Не выделены папки для для копирования!!!" & vbCrLf & _
          "Временные файлы удалены!" & vbCrLf & "Работа скрипта завершена!"_
          ,vbExclamation,"Внимание!!!"
      End If
      MsgFileStr.Close
      If Result = 6 then
         Set TextStream = FolderList.OpenAsTextStream(1)
         StrFolder = vbNullString
         While Not TextStream.AtEndOfStream
               StrFolder = TextStream.ReadLine()
               Set TextStreamFL = FileList.OpenAsTextStream(1)
               StrFiles = vbNullString
               While Not TextStreamFL.AtEndOfStream
                     StrFiles = TextStreamFL.ReadLine()
                     If FSO.FolderExists (StrFolder) Then
                        Set CopyObj = ObjShellApp.NameSpace(StrFolder)
                        CopyObj.CopyHere StrFiles,20
                     End If
               Wend
               TextStreamFL.Close
         Wend
         TextStream.Close
         MsgBox "Скопировано...",vbExclamation,"Внимание!"
      End If
      FSO.deletefile PathTempFile, 0
   else
    Set FileListFile = FSO.GetFile(Argument)
    PathTempFile = Tempdir & "\FileListTemp.txt"
    FileListFile.Copy PathTempFile
    MsgBox "Список файлов для копирования создан!",vbExclamation,"Внимание!!!"
   End If
End If
WScript.Quit

При запуске всех скриптов у меня общая беда:
Подскажите, что делать ?
Файлы копируются нормально - папки плохо ...
При выполнении скрипта, внутри выбранной папки ("ЧТО копирую") появляются первые две папки из директории "КУДА копирую": одна папка с файлами, другая пустая ... и в таком виде файлы копируются во все папки "КУДА копирую" ...

Разобрался - проблема исчезла.

Скрипт от Batya 100% рабочий и ОЧЕНЬ быстрый,
но для его работы надо строго выполнить 2 условия:
1) Установить программы Script Helper и KillCopy (в сообщениях от Batya есть где найти).
2) Во время использования скрипта строго следовать инструкции:
С одной стороны выделаешь папки куда копируешь, с другой - файлы и папки, которые копируешь.
Скрипт выполняешь, когда активна панель, где выделено, что копировать.

Спасибо Batya

!

А нет скрипта, где папки-приемники брались бы из текстового файла?

Kavar
Нужно как-то подоходчивей. Что-то вроде:
Можно ли поменять скрипт(или предоставить, если таковой уже имеется), чтобы выделенные папки и файлы копировались в каталоги, указанные в файле-списке, где пути к ним располагаются один под другим? >>
С:\Folder1
C:\Folder2
...

Flasher, да, именно это я и имел в виду

Batya писал(а):LocKtaR-o-DarK предложил создать скрипт для копирования нескольких файлов...
Скрипт *.vbs:
Код: Выделить всё
'========================================================
' Копирование выделенных файлов в несколько каталогов

' Параметры вызова из TC:
' %L
'========================================================
If WScript.Arguments.Count = 0 Then
  MsgBox "Не заданы параметры!", vbOKOnly + vbExclamation, "Копирование в несколько каталогов"
  WScript.Quit
End If
Dim TCS, WSH, Targets, TargStr
Set TCS = CreateObject("TCScript.Helper")
Set WSH = CreateObject("WScript.Shell")
Targets = TCS.GetTrgSelectedFiles(1)
TargStr = Join(Targets, "?")
WSH.Run "killcopy.exe |" & WScript.Arguments(0) & "|" & TargStr & "| -n", , 1
Set TCS = Nothing
Set WSH = Nothing
WScript.Quit
Как действует - выделяем каталоги КУДА копировать, переключаемся на другую панель, выделяем ЧТО копировать, запускаем скрипт.

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

Booroondook
Во-первых ненужное цитирование (в том числе и полное цитирование чужих скриптов) категорически не приветствуется. Раз нет возможности указать ссылку (как у новичка), достаточно было в данном случае просто упомянуть последний пост на предыдущей странице. Если такое упоминание вообще нужно (в данном посте — нет).
Что такое "Назначить команду кнопке", могу только догадываться. Это кнопку назначают команде, а не наоборот. Про код кнопки (ищем по форуму!) сказано многократно. Про то, как использовать vbs-скрипты — тоже. Про то, какие команды и как указывать в кнопке — как минимум, в справке.
Короче, говоря, читаем правила форума.

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

Booroondook
Для сведения: здесь никто никому не обязан пояснять очередной раз то, что уже было разжёвано десятки раз со всеми мыслимыми и немыслимыми подробностями и вполне успешно находится поиском по форуму. Более того, это прямо противоречит правилам форума.
Приведён не был не код кнопки, а текст скрипта. Что с этим (или любым другим, независимо от содержания) скриптом дальше делать, объяснялось на форуме не один раз (всего один из многих примеров, найденных хотя бы по файл vbs или по код скрипта с последующим чтением заголовков тем).
Дискуссия закончена. Замечание за повторное нарушение правил форума (пререкание с модератором и оффтоп). О дальнейших последствиях в случае продолжения в том же духе читаем в правилах.
P.S. В шапке подфорума теперь есть памятка для новичков по работе со скриптами.

Хоть топик и старый, но вопрос актуален.

Проблема такая - скрипты от Batya и jehaz отлично работают на локальной машине winXP, но мне необходимо копировать файлы по ФТП на серваке под линуксом.
В этом случае почему то оба скрипта не работают - скрипт от jehaz - пишет что "Не выделены папки для копирования!", при запуске скрипта от Бати - KillCopy выдает ошибку "File write error 6 - Неверный дескриптор".
Прошу помощи.

Total Commander

Копировать один файл в несколько папок сразу!