VBScript: пакетное переименование и индексирование файлов

'RSeries v1
'----------------------------------------------------------------------------
'Скрипт предназначен для переименования группы однотипных файлов на 
'основе заданного шаблона-маски.
'----------------------------------------------------------------------------
'Сначала просто запустите скрипт,чтобы файл скрипта скопировался
'в папку SendTo.
'
'Выделите группу файлов в Проводнике,щелкните правой кнопкой мыши
'по первому файлу последовательности.В контекстном меню,выберите 
'"Отправить"-"Переименование_группы_файлов" Задайте маску и 
'переименуйте группу.
'
'Сервис SendTo должен быть включен.Dword параметр flags
'раздела HKСR\CLSID\{7BA4C740-9E81-11CF-99D3-00AA004AE837}
'должен быть установлен в 1.
'----------------------------------------------------------------------------
'Lang.:VBScript
'Windows Script Host 5.6 
'OС:WinMe 4.90.3000
'----------------------------------------------------------------------------

    Set SCRRUN=CreateObject("Scripting.FileSystemObject")

    If WScript.Arguments.Length=0 Then
        SetTargetScript()
    Else
        RenameSeries(WScript.Arguments)
    End If
    
    WScript.Quit()

'[Копирование в папку SendTo]
'----------------------------------------------------------------------------
Function SetTargetScript()
    Set wShell=CreateObject("WScript.Shell")
    SCRRUN.CopyFile _
        WScript.ScriptFullName, _
        wShell.SpecialFolders("SendTo") & "\Переименование_группы_файлов.vbs"

    MsgBox     "Файл скрипта скопирован в каталог SendTo", _
        vbInformation+vbSystemModal, _
        "Первый запуск"
End Function


'[Переименование последовательности файлов]
'----------------------------------------------------------------------------
Function RenameSeries(argArr)
'-----------------------------------------------------------------------------
    iAnsw=MsgBox(    "Переименовать группу из " & argArr.Length & " файлов?", _
            vbInformation+vbYesNo+vbSystemModal,"Переименование группы")
    If iAnsw=vbNo Then Exit Function
    '------------------------------------------------------------
    Name    =SCRRUN.GetBaseName(argArr.Item(0))
    Ext    =SCRRUN.GetExtensionName(argArr.Item(0))
    '------------------------------------------------------------

    '[]
    '------------------------------------------------------------
    iAnsw=InputBox(    "Укажите маску переименования:" & vbCRLF & _
            "[Имя ##...#.Расширение]" & vbCRLF & _
            "где ##..# шаблон формата номера", _
            "Маска переименования", _
            Name & "#." & Ext)

    If iAnsw="" Then Exit Function
    iAnsw=CStr(iAnsw)

    Count    =CInt(Len(iAnsw))-CInt(Len(Replace(iAnsw,"#","")))

    If InStr(1,iAnsw,String(Count,"#"))=0 Or InStr(1,iAnsw,"#")=0 Then
        MsgBox "Неправильно задана маска.", _
            vbExclamation+vbSystemModal,"Error"
        Exit Function
    End If


    '[]
    '------------------------------------------------------------
    iIndex=InputBox("Начальный индекс", _
            "Начальный индекс", _
            1)

    If iIndex="" Or IsNumeric(iIndex)=False Then Exit Function
    iIndex=CInt(iIndex)
    '------------------------------------------------------------

    '------------[Переименование файлов]------------------------
    '------------------------------------------------------------

    '[Генерация случайной маски]
    '------------------------------------------------------------
    Randomize
    d=0
    Do
        d=Rnd()
    Loop Until  d>10^-1
    RandomName="file" & Left(CStr(d*1000),3)

    '[Присвоение временных имен заданных случайной маской]
    '[с целью исключения ошибки присвоения имени существующего файла]
    '------------------------------------------------------------
    ParentFolder=SCRRUN.GetParentFolderName(argArr.Item(0))

    i=0
    For Each file In argArr
    If SCRRUN.FileExists(file) Then
            SCRRUN.MoveFile _
            file, _
            ParentFolder & "\" & RandomName & i
    i=i+1
    End If
    Next  
    
    WScript.Sleep(300)

    '[Окончательное переименование группы файлов]
    '------------------------------------------------------------
    For j=0 To argArr.Length-1

        '[Префикс из нулей.Упраздняется в случае превышения]
        '[длиной индекса количества символов маски]

        If Count-Len(CStr(j+iIndex))<=0 Then 
            pref=""
        Else
            pref=String(Count-Len(CStr(j+iIndex)),"0")
        End If

        On Error Resume Next

        '[Указание начального и конечного файла]

        RandomLocation    =ParentFolder & "\" & RandomName & j
        NewLocation    =ParentFolder & "\" & Replace(iAnsw,String(Count,"#"),pref & j+iIndex)
        
        SCRRUN.MoveFile _
            RandomLocation, _
            NewLocation
        If Err.Number<>0 Then     MsgBox _
                    Err.Description, _
                    vbExclamation+vbSystemModal,"Error"
        Err.Clear
    Next 

    WScript.Sleep(300)

    '------------------------------------------------------------
    MsgBox _
        "Готово.", _
        vbInformation+vbSystemModal,"Переименование группы"
    '------------------------------------------------------------
End Function
'----------------------------------------------------------------------------
'Последний раз исправлено 20.10.2008

'ISeries v1
'----------------------------------------------------------------------------
'Скрипт предназначен для индексирования группы однотипных файлов.
'----------------------------------------------------------------------------
'Сначала просто запустите скрипт,чтобы файл скрипта скопировался
'в папку SendTo.
'
'Выделите группу файлов в Проводнике,щелкните правой кнопкой мыши
'по первому файлу последовательности.В контекстном меню,выберите 
'"Отправить"-"Индексирование_группы_файлов" Задайте маску и 
'индексируйте группу.
'
'Сервис SendTo должен быть включен.Dword параметр flags
'раздела HKСR\CLSID\{7BA4C740-9E81-11CF-99D3-00AA004AE837}
'должен быть установлен в 1.
'
'Имя индексированного файла берется на основе имени старого файла - 
'от крайнего правого символа "_"(если таковой существует) и до конца,
'после чего приписывается индекс.
'----------------------------------------------------------------------------
'Lang.:VBScript
'Windows Script Host 5.6 
'OС:WinMe 4.90.3000
'----------------------------------------------------------------------------

    Set SCRRUN=CreateObject("Scripting.FileSystemObject")

    If WScript.Arguments.Length=0 Then
        SetTargetScript()
    Else
        RenameSeries(WScript.Arguments)
    End If
    
    WScript.Quit()

'[Копирование в папку SendTo]
'----------------------------------------------------------------------------
Function SetTargetScript()
    Set wShell=CreateObject("WScript.Shell")
    SCRRUN.CopyFile _
        WScript.ScriptFullName, _
        wShell.SpecialFolders("SendTo") & "\Индексирование_группы_файлов.vbs"

    MsgBox     "Файл скрипта скопирован в каталог SendTo", _
        vbInformation+vbSystemModal, _
        "Первый запуск"
End Function


'[Индексирование последовательности файлов на основе собственного имени]
'----------------------------------------------------------------------------
Function RenameSeries(argArr)
'-----------------------------------------------------------------------------
    iAnsw=MsgBox(    "Индексировать группу из " & argArr.Length & " файлов?", _
            vbInformation+vbYesNo+vbSystemModal,"Индексирование группы")
    If iAnsw=vbNo Then Exit Function

    '[]
    '------------------------------------------------------------
    iAnsw=InputBox(    "Укажите маску индексирования:", _
                "Маска индексирования", _
                "##")
    If iAnsw="" Then Exit Function
    If Len(Replace(iAnsw,"#",""))>0 Then
        MsgBox "Допустимы только символы #", _
            vbExclamation+vbSystemModal,"Error"
        Exit Function
    End If
    
    '[]
    '------------------------------------------------------------
    iIndex=InputBox("Начальный индекс", _
            "Начальный индекс", _
            1)
    If iIndex="" Or IsNumeric(iIndex)=False Then Exit Function

    iIndex=CInt(iIndex)
    '------------------------------------------------------------

    iAnsw    =CStr(iAnsw)
    Count    =CInt(Len(iAnsw))

    ParentFolder=SCRRUN.GetParentFolderName(argArr.Item(0))
    

    '[]
    '------------------------------------------------------------
    Set RegExp=CreateObject("VBScript.RegExp")
    RegExp.Global        =True
    RegExp.IgnoreCase    =True

    '////////////////////////////////////////////////////////////
    '[Можно Изменить регулярное выражение для удаляемой части строки имени файла]
    '////////////////////////////////////////////////////////////
    RegExp.Pattern        =".+_+"

    '------------------------------------------------------------
    

    '------------[Переименование файлов]------------------------
    '------------------------------------------------------------

    '[Генерация случайного имени]
    '------------------------------------------------------------
    Randomize
    d=0
    Do
        d=Rnd()
    Loop Until  d>10^-1
    RandomName="file" & Left(CStr(d*1000),3)

    '[Присвоение временных имен заданных случайным именем]
    '[с целью исключения ошибки присвоения имени существующего файла]
    '------------------------------------------------------------
    ParentFolder=SCRRUN.GetParentFolderName(argArr.Item(0))

    i=0
    For Each file In argArr
    If SCRRUN.FileExists(file) Then
            SCRRUN.MoveFile _
            file, _
            ParentFolder & "\" & RandomName & i
    i=i+1
    End If
    Next  

    WScript.Sleep(300)

    '----------[Индексирование группы файлов]--------------------
    '------------------------------------------------------------
    For j=0 To argArr.Length-1

        If Count-Len(CStr(j+iIndex))<=0 Then 
            pref=""
        Else
            pref=String(Count-Len(CStr(j+iIndex)),"0")
        End If

    On Error Resume Next

    Name    =SCRRUN.GetBaseName(argArr.Item(j))
    Ext    =SCRRUN.GetExtensionName(argArr.Item(j))
    
    SCRRUN.MoveFile _
        ParentFolder & "\" & RandomName & j, _
        ParentFolder & "\" & pref & j+iIndex & "_" & RegExp.Replace(Name,"") & "." & Ext
    
    If Err.Number<>0 Then     MsgBox _
                Err.Description, _
                vbExclamation+vbSystemModal,"Error"
    Err.Clear
    Next 

    WScript.Sleep(300)

    '------------------------------------------------------------
    MsgBox _
        "Готово.", _
        vbInformation+vbSystemModal,"Индексирование группы"
    '------------------------------------------------------------
End Function
'----------------------------------------------------------------------------
'Последний раз исправлено 20.10.2008