Копирование файла, а не ярлыка?
Select messages from
# through # FAQ
[/[Print]\]
Goto page Previous  1, 2, 3, 4, 5, 6  Next  :| |:
Total Commander -> Автоматизация Total Commander

#16:  Author: Yura48745 PostPosted: Wed Jan 24, 2018 16:50
    —
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 секунд:

#17:  Author: Lisabon PostPosted: Wed Jan 24, 2018 22:29
    —
Было бы хорошо, ещё добавить поддержку юникод.

#18:  Author: FlasherLocation: Москва PostPosted: Thu Jan 25, 2018 10:37
    —
Lisabon
Не проблема. Но не лучше в контексте какого-то из скриптов со счётиком? В т. ч. нужно определиться, оставлять ли имена папок прежними при наличии одноимённых.
Что касаемо рекурсии, то я бы копировал папки как есть (с .lnk), а уже после производил бы замену в получателях.

#19:  Author: Lisabon PostPosted: Thu Jan 25, 2018 12:37
    —
Flasher
Quote:
я бы копировал папки как есть (с .lnk), а уже после производил бы замену в получателях.

Можно и так.
Quote:
со счётиком

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

#20:  Author: FlasherLocation: Москва PostPosted: Thu Jan 25, 2018 13:32
    —
Lisabon
Опцию перезаписи/счётчика сделать можно. Но я писал о папках, а не файлах. Т.е. имена папок при совпадении трогать или как?
Lisabon wrote:
Было бы неплохо, если возможно, добавить индикацию процесса копирования или просто показать диалог при копировании, мол, идёт копирование ожидайте.
ОК. Можно сделать прогресс без lnk, а потом всплыв. окошко.

#21:  Author: Lisabon PostPosted: Thu Jan 25, 2018 14:11
    —
Flasher
Quote:
имена папок при совпадении трогать или как?

Если со счётчиком, то трогать имена, если без счётчика, то не трогать имена.

#22:  Author: FlasherLocation: Москва PostPosted: Thu Jan 25, 2018 14:47
    —
Lisabon
В ТС по умолчанию структура папок сохраняется, а заданное автопереименование работает только в отношении файлов. Т. е. получается, что вместо переименования одноимённых файлов будут переименованы только корневые папки. Это разве хорошо?
И если трогать имена папок, то системный прогресс (напомню скрипт) не получится. Придётся отдельный рисовать.

#23:  Author: Lisabon PostPosted: Thu Jan 25, 2018 15:40
    —
Flasher
Сделай, как посчитаешь лучше, правильнее...

#24:  Author: FlasherLocation: Москва PostPosted: Fri Jan 26, 2018 00:39
    —
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


Last edited by Flasher on Mon Jan 29, 2018 22:16; edited 2 times in total

#25:  Author: Lisabon PostPosted: Fri Jan 26, 2018 01:51
    —
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

то копирование с ярлыка, не происходит. Если произвести копирование папки с выше указанными именами, то копируются папки без проблем.

#26:  Author: FlasherLocation: Москва PostPosted: Fri Jan 26, 2018 02:17
    —
Lisabon
1. Вряд ли это с размером связано. Я тестировал с большими файлами без бага, так что-то другое. Позже буду смотреть.
2. Поправил 31 строку.

#27:  Author: Lisabon PostPosted: Fri Jan 26, 2018 11:57
    —
Flasher
Ещё есть пожелание, если возможно...
Допустим есть кнопка:
Code:
TOTALCMD#BAR#DATA
C:\ReadMe.vbs
%WF "%T" copy /r
C:\Windows\System32\WScript.exe,2
ReadMe


-1

Есть ярлык на файл/папку. Путь источника равен получателю. При копировании с ярлыка, после копирования файла/папки, переименовывается ярлык, тобишь добавляется к имени ярлыка
Code:
— копия
. Так вот, можно ли ярлык не переименовывать ибо смысла нет никакого.

Ещё нашёл баг с использованием имени ярлыка:
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

#28:  Author: FlasherLocation: Москва PostPosted: Fri Jan 26, 2018 13:46
    —
Lisabon wrote:
Так вот, можно ли ярлык не переименовывать ибо смысла нет никакого.
А зачем вообще пытаться копировать в ту же папку, если нет смысла? Тогда нужно вообще запрет на копирование при совпадении путей делать.
Lisabon wrote:
Ещё нашёл баг с использованием имени ярлыка:
Быстро же ты на эту ситуацию вышел. Тут дело в ";". Увы, но мелкомягкие выбрали разрешённый в именах делитель для масок. Что с них взять? Я могу заменять на ? и проверять, чтобы был только один такой файл в папке, а в случае нескольких отсяенные будут скопированны вне общей группы (без прогресса). Не сильно комильфо, но всё же. Question

#29:  Author: Lisabon PostPosted: Fri Jan 26, 2018 16:15
    —
Flasher
Quote:
А зачем вообще пытаться копировать в ту же папку, если нет смысла?

Не очень понял... В общем, есть ярлык, он в по одному пути, файл на который ссылается ярлык, не находятся рядом.
Я выбираю ярлык, с которого надо скопировать файл. В левой и правой файловой панелях, пути одинаковы и там находится только ярлык:


После обработки, получаем вот такой результат:


Зачем копировать в папку, где находится сам ярлык? Ну, например, для получения копии файла, где находится ярлык.

Quote:
Тогда нужно вообще запрет на копирование при совпадении путей делать.

Если используется кнопка
Code:
TOTALCMD#BAR#DATA
C:\ReadMe.vbs
%WF "%T" copy /r
C:\Windows\System32\WScript.exe,2
ReadMe


-1

, то зачем делать запрет.

#30:  Author: FlasherLocation: Москва PostPosted: Fri Jan 26, 2018 16:50
    —
Lisabon wrote:
После обработки, получаем вот такой результат:
А. Т. е. замена не происходит. Так бы и писал. Ладно, поправимо, хотя и через ...
Lisabon wrote:
Ну, например, для получения копии файла, где находится ярлык.
А смысл в копиях в том же каталоге какой? Это же не бэкапер или размножитель. Цель такая не ставилась, вроде.
Lisabon wrote:
, то зачем делать запрет.
Так суть автопереименования не в создании дублей, а в предотвращении перезаписи и необходимости содержать потенциально разные по содержимому файлы.



Total Commander -> Автоматизация Total Commander


output generated using printer-friendly topic mod. All times are GMT + 4 Hours

Goto page Previous  1, 2, 3, 4, 5, 6  Next  :| |:
Page 2 of 6

Powered by phpBB © 2001, 2005 phpBB Group