Flasher
|
 Posted: Wed Oct 11, 2017 15:27 Post subject: |
 |
|
| Hjkma wrote: | | Так что с этим можно вообще просто не заморачиваться |
Ну, ОК.
| Code: | '================================= VBS ================================
' Копирование/перемещение заданного числа файлов из выбранных каталогов
' в подкаталоги с именами <имя родительского каталога> - <счётчик>
' Параметры: %WL <делящее число> <copy/move>
' Пример: %WL 50 move
'======================================================================
Option Explicit
Const Rank = 0 ' Минимальное число цифр в создаваемых подкаталогах
'======================================================================
Dim Sort, FSO, A, Stream, Count, List, Fd,_
Files, Name, n, i, FP, x, F, Path, FN, All
Set Sort = CreateObject("System.Collections.Sortedlist")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set A = WSH.Arguments : If A.Count = 0 Then WSH.Quit
Set Stream = CreateObject("SAPI.SpFileStream")
Count = CSng(A(1))
Set List = FSO.OpenTextFile(A(0),,,-1)
Do : Fd = LPath(List.ReadLine)
If FSO.FolderExists(Fd) Then
Set Files = FSO.GetFolder("\\?\" & Replace(Fd, "\\?\", "")).Files
If Files.Count Then
n = 1 : i = Count
For Each F in Files
FP = F.Path : If Left(FP, 1) = "\" And _
Len(Mid(FP, 5)) < 260 Then FP = Mid(FP, 5)
Sort.Add F.Name, FP
Next
For x = Sort.Count - 1 To 0 Step -1
F = LPath(Sort.GetByIndex(x))
If i >= Count Then
Name = FSO.GetFileName(Fd)
If Len(n) < Rank Then
Path = FSO.BuildPath(Fd, Name & " - " & Right(String(Rank, "0") & n, Rank))
Else Path = FSO.BuildPath(Fd, Name & " - " & n) End If
Path = LPath(Path & "\") : i = 1 : n = n + 1
If Not FSO.FolderExists(Path) Then FSO.CreateFolder Path
Else i = i + 1 End If : FN = LPath(Path & Sort.GetKey(x))
If Not FSO.FileExists(FN) Then
If Left(FN, 1) = "\" Then
With Stream
.Format.Type = 1 : .Open F, 1 : .Read All, FSO.GetFile(F).Size
.Close : .Open FN, 3, True : .Write All : All = "" : .Close
End With : If LCase(A(2)) = "move" Then FSO.DeleteFile F
Else Execute "FSO." & A(2) & "File F, Path" End If
End If
Next : Sort.Clear
End If
End If
Loop Until List.AtEndOfStream : List.Close
Function LPath(Obj)
LPath = Obj : If Len(Obj) > 259 And Left(Obj, 1) <> "\" Then LPath = "\\?\" & Obj
End Function |
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Last edited by Flasher on Thu Oct 12, 2017 01:30; edited 4 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
