View previous topic :: View next topic |
Author |
Message |
pavmazay
Joined: 18 Dec 2020 Posts: 6
|
(Separately) Posted: Mon Dec 21, 2020 15:34 Post subject: |
|
|
Flasher
Добрый день! Есть ли возможность изменить скрипт, чтобы вместо файлов перемещались символьные NTFS-ссылки на папки? |
|
Back to top |
|
|
Avada
Joined: 01 Aug 2008 Posts: 10275 Location: Россия, Саратов
|
(Separately) Posted: Tue Dec 22, 2020 06:47 Post subject: |
|
|
pavmazay
Это, насколько понимаю, другая задача, не вполне сводимая к лёгкой модификации исходного скрипта (хотя, возможно, я неправ). Но в любом случае автор скрипта, к сожалению, на этом форуме больше не присутствует. Возможно, вам поможет здесь кто-то ещё. Особенно если вы задачу сформулируете как следует: симлинки могут (по крайней мере, стандартными средствами TC) перемещаться и как обычные каталоги, и просто как ссылки — либо вообще исключаться из операции (см. источники информации здесь). Вам что надо? _________________ Даже самая богатая фантазия
Не представит себе наши безобразия. |
|
Back to top |
|
|
pavmazay
Joined: 18 Dec 2020 Posts: 6
|
(Separately) Posted: Tue Dec 22, 2020 11:40 Post subject: |
|
|
Avada
Мне нужен скрипт, подобный вышеизложенному. Этот скрипт прекрасно перемещает файлы по папкам по указанному количеству начальных символов, совпадающих у перемещаемого файла и папки, в которую нужно переместить. Мне нужен скрипт, который делал бы ровно тоже самое, только вместо перемещения выбранных файлов перемещал бы выбранные папки также по совпадению заданного количества начальных символов (или ссылки, потому что как заставить ТС видеть ссылку как файл простым действием я не нашел, ключи IgnoreLinks и CopyLinks, судя по описанию, ссылку файлом не делают, проба изменения ключа CopyLinks тоже результата не дала). С точки зрения непрограммиста требуется изменить строку 59 с FSO.MoveFile на FSO.MoveFolder, но этого явно недостаточно, строки выше тоже надо изменить, но я не знаю как, метод тыка ничего не дал. |
|
Back to top |
|
|
Avada
Joined: 01 Aug 2008 Posts: 10275 Location: Россия, Саратов
|
(Separately) Posted: Tue Dec 22, 2020 13:08 Post subject: |
|
|
pavmazay
Таким образом, вам нужно, чтобы, помимо всего прочего, ссылки обрабатывались как каталоги, перемещаясь со всем содержимым оригинальных каталогов. Как выше уже сказано, ждите ответа. _________________ Даже самая богатая фантазия
Не представит себе наши безобразия. |
|
Back to top |
|
|
pavmazay
Joined: 18 Dec 2020 Posts: 6
|
(Separately) Posted: Tue Dec 22, 2020 18:12 Post subject: |
|
|
Версия для папок и символьных ссылок, может кому-то пригодится
Code: | '•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Перемещение выделенных папок и символьных ссылок в папки с тем же началом
' в имени, если под этот критерий подходит только одна папка в получателе
' Параметры:
' 1) %WL
' 2) "<путь назначения>"
' 3) <число первых совпавших символов> (при отсутствии вводим в окне)
' 4) <максимальное число символов> (0 - отключить; при отсутствии - в окне)
' Примеры:
' 1) %WL C:\Тест
' 2) %WL "%T" 3 0
' 3) %WL "%T" "" 6
' 4) %WL "%T" 5 20
'
' Автор - Flasher © (с дополнением pavmazay)
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
With WScript.Arguments
C = .Count : If C = 0 Then WScript.Quit
On Error Resume Next
List = .Item(0) : Path = .Item(1)
If C < 3 Then
Num = "" : Chek Num, ""
Else
Num = .Item(2) : If Len(.Item(2)) = 0 Then Chek Num, ""
End If
If C < 4 Then
Max = "" : Chek Max, "МАКСИМАЛЬНОЕ "
Else
Max = .Item(3) : If Max = 0 Then Max = Num
End If
On Error Goto 0
If C < 2 Then : MsgBox "Укажите не менее 2-ух параметров!", 4144, _
"Рассортировка файлов по папкам" : WScript.Quit : End if
End With : If Right(Path, 1) <> "\" Then Path = Path & "\"
Sub Chek(Count, Word)
L = vbNewline
Do Until IsNumeric(Count)
Count = InputBox(L&L&L&L&L& "Введите " & Word & "число первых" & _
" символов в именах:", "Рассортировка файлов по папкам", 3)
If Trim(Count) = "" Then WScript.Quit
Loop
End Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SbF = FSO.GetFolder(Path).SubFolders
Set NSp = CreateObject("Shell.Application").NameSpace(Path)
For Each F in Split(FSO.GetFile(List).OpenAsTextStream(1, -1).ReadAll, vbNewline)
If F > vbNullString Then
If FSO.FolderExists(F) Then
For i = Num to Max
Start = Left(FSO.GetBaseName(F), i) : Set Items = NSP.Items
Items.Filter 32+64, Start & "*"
If Items.Count = 1 Then
For Each FF in SbF
If StrComp(Start, Left(FSO.GetFileName(FF), i), 1) = 0 Then
Fnew = Left(F, Len(F)-1)
FSO.MoveFolder Fnew, FF & "\" : Exit For
End If
Next
End If : Set Items = Nothing
Next
End If
End If
Next : Set FSO = Nothing : Set NSP = Nothing : Set SbF = Nothing : WScript.Quit |
|
|
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
|