View previous topic :: View next topic |
Author |
Message |
Yura48745
Joined: 24 Jan 2018 Posts: 1
|
(Separately) Posted: Wed Jan 24, 2018 16:50 Post subject: |
|
|
Code: |
'===================================================
' Копирование файлов\папок (в т.ч. из ярлыков)
'
' Параметры:
' {файл-список} {целевая папка}
'
' Пример параметров при вызове из TC:
' %L "%T"
'===================================================
Sub xCopy (Path, TargetPath)
Dim lnkName, xFolder, colFiles, objFile, colFolders, objFolder, res
if Canceled then Exit Sub
If LCase(FSO.GetExtensionName(Path)) = "lnk" Then
lnkName = Replace(FSO.GetFileName(Path), ".lnk", "")
Path = WSH.CreateShortcut(Path).TargetPath
If FSO.FileExists(Path) then lnkName = lnkName & "." & FSO.GetExtensionName(Path)
End If
If Right(Path, 1) = "\" Then Path = Left(Path, Len(Path) - 1)
If FSO.FileExists(Path) Then
if lnkName = "" then lnkName = FSO.GetFile(Path).Name
If FSO.FileExists(TargetPath & lnkName) and not ReplaceAll Then
res = msgbox ("File " & FSO.GetFile(Path).Name & " already exists", vbYesNoCancel, "Replase all")
Select Case res
Case 6 ' Yes
ReplaceAll = true
FSO.CopyFile Path, TargetPath & lnkName
Case 2 ' Cancel
Canceled = true
Exit Sub
End Select
else
FSO.CopyFile Path, TargetPath & lnkName
End If
End If
If FSO.FolderExists(Path) Then
Set xFolder = FSO.GetFolder(Path)
Set colFiles = xFolder.Files
Set colFolders = xFolder.subFolders
if lnkName = "" then lnkName = FSO.GetFolder(Path).Name & "\"
if Not FSO.FolderExists(TargetPath & lnkName) then FSO.CreateFolder(TargetPath & lnkName)
For Each objFolder in colFolders
xCopy objFolder, TargetPath & lnkName & "\"
Next
For Each objFile in colFiles
xCopy objFile, TargetPath & lnkName & "\"
Next
Set colFolders = Nothing
Set colFiles = Nothing
Set xFolder = Nothing
End If
End Sub
Dim WSH, FSO, FF, ReplaceAll, Canceled
if WScript.Arguments.count < 2 then WScript.Quit 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Set FF = FSO.OpenTextFile(WScript.Arguments(0), 1)
ReplaceAll = false
Canceled = false
Do While Not FF.AtEndOfStream
xCopy FF.ReadLine, WScript.Arguments(1)
Loop
FF.Close
Set FF = Nothing
Set WSH = Nothing
Set FSO = Nothing
WScript.Quit 0 |
Добавлено спустя 17 секунд: |
|
Back to top |
|
|
Lisabon
Joined: 18 Feb 2011 Posts: 147
|
(Separately) Posted: Wed Jan 24, 2018 22:29 Post subject: |
|
|
Было бы хорошо, ещё добавить поддержку юникод. |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Thu Jan 25, 2018 10:37 Post subject: |
|
|
Lisabon
Не проблема. Но не лучше в контексте какого-то из скриптов со счётиком? В т. ч. нужно определиться, оставлять ли имена папок прежними при наличии одноимённых.
Что касаемо рекурсии, то я бы копировал папки как есть (с .lnk), а уже после производил бы замену в получателях. _________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|
Back to top |
|
|
Lisabon
Joined: 18 Feb 2011 Posts: 147
|
(Separately) Posted: Thu Jan 25, 2018 12:37 Post subject: |
|
|
Flasher
Quote: | я бы копировал папки как есть (с .lnk), а уже после производил бы замену в получателях. |
Можно и так.
Можно ещё добавить дополнительно параметр. Если надо, со счётчиком, то добавляем параметр. Если не надо, со счётчиком, то не добавляем параметр и перезаписываются файлы.
Было бы неплохо, если возможно, добавить индикацию процесса копирования или просто показать диалог при копировании, мол, идёт копирование ожидайте. Это будет полезно, когда копируется большой файл или папка. |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Thu Jan 25, 2018 13:32 Post subject: |
|
|
Lisabon
Опцию перезаписи/счётчика сделать можно. Но я писал о папках, а не файлах. Т.е. имена папок при совпадении трогать или как?
Lisabon wrote: | Было бы неплохо, если возможно, добавить индикацию процесса копирования или просто показать диалог при копировании, мол, идёт копирование ожидайте. | ОК. Можно сделать прогресс без lnk, а потом всплыв. окошко. _________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|
Back to top |
|
|
Lisabon
Joined: 18 Feb 2011 Posts: 147
|
(Separately) Posted: Thu Jan 25, 2018 14:11 Post subject: |
|
|
Flasher
Quote: | имена папок при совпадении трогать или как? |
Если со счётчиком, то трогать имена, если без счётчика, то не трогать имена. |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Thu Jan 25, 2018 14:47 Post subject: |
|
|
Lisabon
В ТС по умолчанию структура папок сохраняется, а заданное автопереименование работает только в отношении файлов. Т. е. получается, что вместо переименования одноимённых файлов будут переименованы только корневые папки. Это разве хорошо?
И если трогать имена папок, то системный прогресс (напомню скрипт) не получится. Придётся отдельный рисовать. _________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|
Back to top |
|
|
Lisabon
Joined: 18 Feb 2011 Posts: 147
|
(Separately) Posted: Thu Jan 25, 2018 15:40 Post subject: |
|
|
Flasher
Сделай, как посчитаешь лучше, правильнее... |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Fri Jan 26, 2018 00:39 Post subject: |
|
|
Lisabon
Ошибся насчёт автопереименования файлов. Смотри, в общем:
Code: | '•••••••••••••••••••••••• VBS ••••••••••••••••••••••••
' Копирование/перемещение выбранного по заданному пути
' с последующей заменой lnk-ярлыков на целевые объекты
' Условие: путь запуска — пустой
' Примечание: в пути достаточно правильной буквы диска
'
' Параметры: %WF "<путь назначения>" <copy/move>
' Ключ системного автопереименования объектов: /r
' Примеры: %WF "%PMy Folder" copy /r
' %WF D:\New\New2\New3\New4\New5 move
'•••••••••••••••••••••••••••••••• Автор: Flasher © •••
Option Explicit : Dim A, FSO, REx, Rgx, T, Ren,_
D, Dic, Col, ShA, oFolder, oList, List, Folders,_
N, Items, F, Nm, Targ, Lnk, i, FPath, FlEx, FdEx
Set A = WSH.Arguments : If A.Count = 0 Then WSH.Quit
Set FSO = CreateObject("Scripting.FileSystemObject")
Set REx = New RegExp : REx.Pattern = "([.+[\(){$^])"
Set Rgx = New RegExp : Rgx.IgnoreCase = True
T = Timer: If A.Named.Exists("r") Then Ren = 8
REx.Global = True : D = FSO.GetDriveName(A(1))
Set Dic = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
Set ShA = CreateObject("Shell.Application")
ShA.NameSpace(D).NewFolder Mid(A(1), Len(D) + 2)
Set oFolder = ShA.NameSpace(FSO.GetAbsolutePathName(""))
List = FSO.OpenTextFile(A(0),,,-1).ReadAll
oList = Split(List, vbNewLine)
For Each N in Filter(oList, ";")
Nm = N
If StrComp(FSO.GetExtensionName(N), "lnk", 1) _
= 0 Then N = oFolder.ParseName(N).GetLink.Target
Set Items = oFolder.Items
Items.Filter 78064, Replace(N, ";", "?")
Rgx.Pattern = "(^|\n)" & REx.Replace(N, "\$1") & "(\r|$)"
For Each F in Items
If Not F.IsLink Then N = "" Else N = F.GetLink.Path
F = FSO.GetFileName(F.Path)
If InStr(F, ";") Then Dic.Add F, N : Exit For
Next : List = Rgx.Replace(List, "$1")
Next
Rgx.Pattern = "\r\n$" : List = Rgx.Replace(List, "")
Folders = Left(List, InStrRev(List, "\"))
For Each N in Filter(oList, ".lnk", 1, 1)
If InStr(N, ";") = 0 Then
With oFolder.ParseName(N)
If .IsLink Then _
Col.Add N, .GetLink.Path : Rgx.Pattern = "(^|\n)" &_
REx.Replace(FSO.GetBaseName(N),"\$1") & "\.lnk(\r|$)":_
List = Rgx.Replace(List, "$1" & .GetLink.Target & "$2")
End With
End If
Next : Set Items = oFolder.Items
Rgx.Pattern = "(^|\n)" & FSO.GetFileName(A(1)) & "\\(\r|$)"
List = Rgx.Replace(List, "$1") : If List = "" Then WSH.Quit
Set Targ = ShA.NameSpace(A(1)) : Items.Filter 78064,_
Replace(Replace(List, "\", ""), vbCrLf, ";")
Execute "Targ." & A(2) & "Here Items, 4112 + Ren"
For Each D in Array(Dic, Col)
If D.Count Then
For Each F in D
FPath = D(F) : FlEx = FSO.FileExists(FPath)
FdEx = FSO.FolderExists(FPath)
If FlEx Or FdEx Then
If LCase(A(2)) = "move" Then _
If FlEx Then FSO.DeleteFile F, 1 Else FSO.DeleteFolder F, 1
Targ.CopyHere FPath, 4112 + Ren
End If
Next
End If : Set D = Nothing : i = 1
Next
For Each F in Split(Folders, vbCrLf) : FFolder FSO.BuildPath(A(1), F) : Next
T = Timer - T
If T > 3 Then
Dim Sec, Title : If T < 10 Then Sec = 2 Else If T < 30 Then Sec = 4
Title = "Копирование": If LCase(A(2)) = "move" Then Title = "Перемещение"
CreateObject("WScript.Shell").Popup "Выполнено!", Sec, " " & Title, 4160
End If
Sub FFolder(Folder)
Dim oFold, File, Fold
Set oFold = ShA.NameSpace(Folder)
Set Items = oFold.Items : Items.Filter 78032, "*"
For Each File in Items
If File.IsLink And LCase(FSO.GetExtensionName(File.Path)) <> "url" Then _
oFold.CopyHere File.GetLink.Path, 4112 + Ren : FSO.DeleteFile File.Path, 1
Next : Items.Filter 78000, "*"
For Each Fold in FSO.GetFolder(Folder).SubFolders
If FSO.FolderExists(Fold) Then FFolder Fold.Path
Next
End Sub |
_________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Last edited by Flasher on Mon Jan 29, 2018 22:16; edited 2 times in total |
|
Back to top |
|
|
Lisabon
Joined: 18 Feb 2011 Posts: 147
|
(Separately) Posted: Fri Jan 26, 2018 01:51 Post subject: |
|
|
Flasher
Погонял немного... Нашёл пару багов.
Кнопка вот такая:
Code: | TOTALCMD#BAR#DATA
C:\ReadMe.vbs
%WF "%T" copy
C:\Windows\System32\WScript.exe,2
ReadMe
-1
|
Total Commander 9.12 32-bit, Windows 8.1 64-bit
1. При копировании с ярлыка файла/папки, так и не с ярлыка, а просто файл или папку, размер которых превышает 200 МБ , после операции копирования вылазит сообщение с ошибкой:
Code: | Сценарий: C:\ReadMe.vbs
Строка: 0
Символ: 1
Ошибка: Недопустимый вызов или аргумент процедуры
Код: 800A0005
Источник: Ошибка выполнения Microsoft VBScript |
Сами файл/папка копируются в полном объёме.
2. Если ярлыки имеют имена:
Code: | 1992.10 - Out Of Space (Elektra 2-66346).LNK
1992.11 - Out Of Space (XLS 35CD).LNK
2009.11 - Invaders Must Die (HOSPCDS06).LNK
2012.09.04 - 7th Mini Album - Mirage.LNK |
то копирование с ярлыка, не происходит. Если произвести копирование папки с выше указанными именами, то копируются папки без проблем. |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Fri Jan 26, 2018 02:17 Post subject: |
|
|
Lisabon
1. Вряд ли это с размером связано. Я тестировал с большими файлами без бага, так что-то другое. Позже буду смотреть.
2. Поправил 31 строку. _________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|
Back to top |
|
|
Lisabon
Joined: 18 Feb 2011 Posts: 147
|
(Separately) Posted: Fri Jan 26, 2018 11:57 Post subject: |
|
|
Flasher
Ещё есть пожелание, если возможно...
Допустим есть кнопка:
Code: | TOTALCMD#BAR#DATA
C:\ReadMe.vbs
%WF "%T" copy /r
C:\Windows\System32\WScript.exe,2
ReadMe
-1
|
Есть ярлык на файл/папку. Путь источника равен получателю. При копировании с ярлыка, после копирования файла/папки, переименовывается ярлык, тобишь добавляется к имени ярлыка . Так вот, можно ли ярлык не переименовывать ибо смысла нет никакого.
Ещё нашёл баг с использованием имени ярлыка:
Quote: | 01 mka dvd-audio araw;24bit,96000hz,4608kbs.lnk |
При копировании с ярлыка, выдаёт ошибку:
Code: | Сценарий: C:\ReadMe.vbs
Строка: 33
Символ: 5
Ошибка: Требуется объект
Код: 800A01A8
Источник: Ошибка выполнения Microsoft VBScript |
А при попытке копирования файла с именем:
Code: | 01 mka dvd-audio araw;24bit,96000hz,4608kbs.mka |
ничего не происходит.
Last edited by Lisabon on Tue Jan 30, 2018 12:42; edited 1 time in total |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Fri Jan 26, 2018 13:46 Post subject: |
|
|
Lisabon wrote: | Так вот, можно ли ярлык не переименовывать ибо смысла нет никакого. | А зачем вообще пытаться копировать в ту же папку, если нет смысла? Тогда нужно вообще запрет на копирование при совпадении путей делать.
Lisabon wrote: | Ещё нашёл баг с использованием имени ярлыка: | Быстро же ты на эту ситуацию вышел. Тут дело в ";". Увы, но мелкомягкие выбрали разрешённый в именах делитель для масок. Что с них взять? Я могу заменять на ? и проверять, чтобы был только один такой файл в папке, а в случае нескольких отсяенные будут скопированны вне общей группы (без прогресса). Не сильно комильфо, но всё же. _________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|
Back to top |
|
|
Lisabon
Joined: 18 Feb 2011 Posts: 147
|
(Separately) Posted: Fri Jan 26, 2018 16:15 Post subject: |
|
|
Flasher
Quote: | А зачем вообще пытаться копировать в ту же папку, если нет смысла? |
Не очень понял... В общем, есть ярлык, он в по одному пути, файл на который ссылается ярлык, не находятся рядом.
Я выбираю ярлык, с которого надо скопировать файл. В левой и правой файловой панелях, пути одинаковы и там находится только ярлык:
После обработки, получаем вот такой результат:
Зачем копировать в папку, где находится сам ярлык? Ну, например, для получения копии файла, где находится ярлык.
Quote: | Тогда нужно вообще запрет на копирование при совпадении путей делать. |
Если используется кнопка
Code: | TOTALCMD#BAR#DATA
C:\ReadMe.vbs
%WF "%T" copy /r
C:\Windows\System32\WScript.exe,2
ReadMe
-1
|
, то зачем делать запрет. |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Fri Jan 26, 2018 16:50 Post subject: |
|
|
Lisabon wrote: | После обработки, получаем вот такой результат: | А. Т. е. замена не происходит. Так бы и писал. Ладно, поправимо, хотя и через ...
Lisabon wrote: | Ну, например, для получения копии файла, где находится ярлык. | А смысл в копиях в том же каталоге какой? Это же не бэкапер или размножитель. Цель такая не ставилась, вроде.
Lisabon wrote: | , то зачем делать запрет. | Так суть автопереименования не в создании дублей, а в предотвращении перезаписи и необходимости содержать потенциально разные по содержимому файлы. _________________ Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой. |
|
Back to top |
|
|
|
|
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
|