Total Commander

Код: Выделить всё

'••••••••••••••••••••••••••••••••••••••••••• VBS ••••••••••••••••••••••••••••••••••••••••••
' Cоздать указанное число копий/пустышек для каждого выбранного элемента
' с добавлением счётчика после базового имени, начиная с последнего номера

' Параметры: %WL "<путь назначения>" <число копий> <вставка до №> <расширение нового файла>
' Если указан 5-й параметр, то создаваться будут пустые элементы
' Ключ для смены начала счётчика с единицы на двойку: /2

' Примеры:   %WL "%P" /2   |   %WL "%T" 3   |   %WL "%P" 5 _v   |   %WL "%T" 1 "" txt
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••

Option Explicit : Dim C, Two, List, Cn, Path, Count, Px, Ext, ShA, FSO, Rgx
Dim F, FN, Test, Ex, BN, Max, i, n, M, Items, FF, Exist, FP, Cnt, Num, Check

With WSH.Arguments
  C = .UnNamed.Count : Two = .Named.Exists("2") : If C = 0 Then WSH.Quit
  If C = 1 Then MsgBox "Должно быть указано не менее 2-х параметров!", 48 : WSH.Quit
  List = .Item(0) : Path = .Item(1) : If C > 2 Then Count = .Item(2)
  If Count = "" Then Count = Trim(InputBox(String(4, vbLf) & "Введите число создаваемых копий"&_
  vbLf & "для каждого выбранного элемента:", Space(13) & "Создание копий выбранных элементов"))
  If Not IsNumeric(Count) Then WSH.Quit : End If : If C > 3 Then Px = .Item(3)
  If C = 5 Then If .Item(4) <> "" Then Ext = "." & .Item(4) End If
End With : Set Rgx = New RegExp : Rgx.Pattern = "^(.*\D)?((0*)\d+)$"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ShA = CreateObject("Shell.Application")
Set List = FSO.OpenTextFile(List,,,-1)

Do : F = Trim(List.ReadLine)
  FN = FSO.GetFileName(F)
  If FSO.FolderExists(F) Then
    Test = 1 : BN = FN
  ElseIf FSO.FileExists(F) Then
    Test = 0 : BN = FSO.GetBaseName(FN)
    Ex = FSO.GetExtensionName(F) : If C < 5 And Len(Ex) Then Ext = "." & Ex
  End If : Max = 0 : If C = 5 Then FN = FSO.GetBaseName(F) & Ext
  FP = FSO.BuildPath(Path, FN) : Exist = (FSO.FolderExists(FP) Or FSO.FileExists(FP))
  If Rgx.Test(BN) Then
    M = Rgx.Execute(BN)(0).SubMatches(1) : Max = M : BN = Left(BN, Len(BN) - Len(M))
  ElseIf Right(BN, Len(Px)) <> Px Then
    n = 1
    For i = 1 To Len(Px)
      If Left(Px, i) = Right(BN, i) Then n = i
    Next : BN = BN & Mid(Px, n)
  End If : Set Items = ShA.NameSpace(Path).Items
  Items.Filter 73952, BN & "*" & Ext
  For Each i in Items
    If Test = 0 Then FF = FSO.GetBaseName(i.Path) Else FF = FSO.GetFileName(i.Path)
    If Replace(Ext, ".", "") = FSO.GetExtensionName(i.Path) Then _
    If Rgx.Test(FF) Then Set FN = Rgx.Execute(FF)(0) : M = FN.SubMatches(1) :_
    If CLng(M) > CLng(Max) And FN.SubMatches(0) = Left(FN.SubMatches(0), Len(BN & Px)) Then Max = M
  Next : Cnt = Count
  If Not Exist Then Create Test, F, FP, Ext : Cnt = Count - 1
  If Cnt Then
  For i = 1 To Cnt
    If Rgx.Execute(Max)(0).SubMatches(2) = "" Then
      Max = Max + 1
    Else
      If Len(Max + 1) >= Len(Max) Then Max = Max + 1 Else _
      Max = String(Len(Max) - Len(Max + 1), "0") & Max + 1
    End If : If Two And Max < 2 Then Max = 2
    FP = FSO.BuildPath(Path, BN & Max) & Ext
    Create Test, F, FP, Ext
  Next
  End If
Loop Until List.AtEndOfStream : CreateObject("WScript.Shell").SendKeys "^r"

Sub Create(T, Fl, PF, E)
  If T Then
    If C = 5 Then FSO.CreateFolder   PF Else FSO.GetFolder(Fl).Copy PF, 0
  Else
    If C = 5 Then FSO.CreateTextFile PF Else FSO.CopyFile Fl, PF, 0
  End if
End Sub

Код: Выделить всё

Set Items = CreateObject("Shell.Application").NameSpace(36).Items
Items.Filter 73920, "explorer.exe"
For Each i In Items: MsgBox i :Next