Flasher
|
 Posted: Mon May 16, 2016 12:01 Post subject: |
 |
|
Lisabon
Сделал с тем же принципом, только от последнего номера:
| Code: | '•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Cоздать копии с добавочным расширением для выбранных элементов
' с добавлением счётчика в скобках, начиная с последнего номера
' Параметры: %WL "<путь назначения>" <расширение копии>
' Примеры: %WL "%P" | %WL "%T" old
'••••••••••••••••••••••••••••••••••••••••• Автор - Flasher © •••
Option Explicit: Dim C, List, Reg, Path, Ext, ShA,_
FSO, F, Test, Filt, M, Items, Cnt, Max, T, x, i, FN
With WScript.Arguments
C = .Count : Ext = ".bak" : If C = 0 Then WScript.Quit
If C = 1 Then MsgBox "Должно быть указано " & vbCr & _
"не менее 2-х параметров!",48, " BackUp": WScript.Quit
List = .Item(0) : Path = .Item(1)
If C = 3 Then Ext = "." & .Item(2)
End With: Set ShA = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set List = FSO.OpenTextFile(List,,,-1)
Set Reg = New Regexp
Reg.Pattern = "(.*" & Ext & ") \((\d+)\)$"
Path = FSO.BuildPath(Path, "\")
Do : F = Trim(List.ReadLine)
If F <> "" Then
FN = FSO.GetFileName(F) : Max = 0
If Right(FN, Len(Ext)) = Ext Then T = 1
If Reg.Test(FN) Then
With Reg.Execute(FN)(0) FN = .Submatches(0):_
Max = CLng(.Submatches(1)) End With : T = 1
End If
If T <> 1 Then
FN = FN & Ext : If FSO.FileExists(Path & FN) Or _
FSO.FolderExists(Path & FN) Then T = 1
End If
If FSO.FolderExists(F) Then
Test = 1 : Filt = 73888
Else Test = 0 : Filt = 73920 End If
If T = 1 Then
Set Items = ShA.NameSpace(Path).Items
Items.Filter Filt, FN & " (*)"
Cnt = Items.Count
If Cnt Then
For x = 0 To Cnt - 1
M = Items.Item(x) : If Reg.Test(M) Then _
M = CLng(Reg.Execute(M)(0).Submatches(1)):_
If M > Max Then Max = M
Next : FN = FN & " (" & Max + 1 & ")"
Else FN = FN & " (1)" End If
End If : FN = FSO.BuildPath(Path, FN)
If Test Then FSO.GetFolder(F).Copy FN, 0 Else FSO.CopyFile F, FN, 0
End If
Loop Until List.AtEndOfStream |
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Last edited by Flasher on Mon May 16, 2016 14:18; edited 1 time in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
