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, 5, 6  Next
 
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander printer-friendly view
View previous topic :: View next topic  
Author Message
Yura48745



Joined: 24 Jan 2018
Posts: 1

Post (Separately) Posted: Wed Jan 24, 2018 16:50    Post subject: Reply with quote

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
View user's profile Send private message
Lisabon



Joined: 18 Feb 2011
Posts: 145

Post (Separately) Posted: Wed Jan 24, 2018 22:29    Post subject: Reply with quote

Было бы хорошо, ещё добавить поддержку юникод.
Back to top
View user's profile Send private message
Flasher



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

Post (Separately) Posted: Thu Jan 25, 2018 10:37    Post subject: Reply with quote

Lisabon
Не проблема. Но не лучше в контексте какого-то из скриптов со счётиком? В т. ч. нужно определиться, оставлять ли имена папок прежними при наличии одноимённых.
Что касаемо рекурсии, то я бы копировал папки как есть (с .lnk), а уже после производил бы замену в получателях.
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Back to top
View user's profile Send private message
Lisabon



Joined: 18 Feb 2011
Posts: 145

Post (Separately) Posted: Thu Jan 25, 2018 12:37    Post subject: Reply with quote

Flasher
Quote:
я бы копировал папки как есть (с .lnk), а уже после производил бы замену в получателях.

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

Можно ещё добавить дополнительно параметр. Если надо, со счётчиком, то добавляем параметр. Если не надо, со счётчиком, то не добавляем параметр и перезаписываются файлы.
Было бы неплохо, если возможно, добавить индикацию процесса копирования или просто показать диалог при копировании, мол, идёт копирование ожидайте. Это будет полезно, когда копируется большой файл или папка.
Back to top
View user's profile Send private message
Flasher



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

Post (Separately) Posted: Thu Jan 25, 2018 13:32    Post subject: Reply with quote

Lisabon
Опцию перезаписи/счётчика сделать можно. Но я писал о папках, а не файлах. Т.е. имена папок при совпадении трогать или как?
Lisabon wrote:
Было бы неплохо, если возможно, добавить индикацию процесса копирования или просто показать диалог при копировании, мол, идёт копирование ожидайте.
ОК. Можно сделать прогресс без lnk, а потом всплыв. окошко.
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Back to top
View user's profile Send private message
Lisabon



Joined: 18 Feb 2011
Posts: 145

Post (Separately) Posted: Thu Jan 25, 2018 14:11    Post subject: Reply with quote

Flasher
Quote:
имена папок при совпадении трогать или как?

Если со счётчиком, то трогать имена, если без счётчика, то не трогать имена.
Back to top
View user's profile Send private message
Flasher



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

Post (Separately) Posted: Thu Jan 25, 2018 14:47    Post subject: Reply with quote

Lisabon
В ТС по умолчанию структура папок сохраняется, а заданное автопереименование работает только в отношении файлов. Т. е. получается, что вместо переименования одноимённых файлов будут переименованы только корневые папки. Это разве хорошо?
И если трогать имена папок, то системный прогресс (напомню скрипт) не получится. Придётся отдельный рисовать.
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Back to top
View user's profile Send private message
Lisabon



Joined: 18 Feb 2011
Posts: 145

Post (Separately) Posted: Thu Jan 25, 2018 15:40    Post subject: Reply with quote

Flasher
Сделай, как посчитаешь лучше, правильнее...
Back to top
View user's profile Send private message
Flasher



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

Post (Separately) Posted: Fri Jan 26, 2018 00:39    Post subject: Reply with quote

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
View user's profile Send private message
Lisabon



Joined: 18 Feb 2011
Posts: 145

Post (Separately) Posted: Fri Jan 26, 2018 01:51    Post subject: Reply with quote

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
View user's profile Send private message
Flasher



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

Post (Separately) Posted: Fri Jan 26, 2018 02:17    Post subject: Reply with quote

Lisabon
1. Вряд ли это с размером связано. Я тестировал с большими файлами без бага, так что-то другое. Позже буду смотреть.
2. Поправил 31 строку.
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Back to top
View user's profile Send private message
Lisabon



Joined: 18 Feb 2011
Posts: 145

Post (Separately) Posted: Fri Jan 26, 2018 11:57    Post subject: Reply with quote

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
Back to top
View user's profile Send private message
Flasher



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

Post (Separately) Posted: Fri Jan 26, 2018 13:46    Post subject: Reply with quote

Lisabon wrote:
Так вот, можно ли ярлык не переименовывать ибо смысла нет никакого.
А зачем вообще пытаться копировать в ту же папку, если нет смысла? Тогда нужно вообще запрет на копирование при совпадении путей делать.
Lisabon wrote:
Ещё нашёл баг с использованием имени ярлыка:
Быстро же ты на эту ситуацию вышел. Тут дело в ";". Увы, но мелкомягкие выбрали разрешённый в именах делитель для масок. Что с них взять? Я могу заменять на ? и проверять, чтобы был только один такой файл в папке, а в случае нескольких отсяенные будут скопированны вне общей группы (без прогресса). Не сильно комильфо, но всё же. Question
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Back to top
View user's profile Send private message
Lisabon



Joined: 18 Feb 2011
Posts: 145

Post (Separately) Posted: Fri Jan 26, 2018 16:15    Post subject: Reply with quote

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
View user's profile Send private message
Flasher



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

Post (Separately) Posted: Fri Jan 26, 2018 16:50    Post subject: Reply with quote

Lisabon wrote:
После обработки, получаем вот такой результат:
А. Т. е. замена не происходит. Так бы и писал. Ладно, поправимо, хотя и через ...
Lisabon wrote:
Ну, например, для получения копии файла, где находится ярлык.
А смысл в копиях в том же каталоге какой? Это же не бэкапер или размножитель. Цель такая не ставилась, вроде.
Lisabon wrote:
, то зачем делать запрет.
Так суть автопереименования не в создании дублей, а в предотвращении перезаписи и необходимости содержать потенциально разные по содержимому файлы.
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
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, 5, 6  Next
Page 2 of 6

 
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