VBS: Переименование mp3-файлов по tag-маске с перемещением

'•••••••••••••••••••••••••••••• VBS •••••••••••••••••••••••••••••••
' Переместить/переименовать MP3-файлы в рабочем каталоге по шаблону
'
' Ключи: /s:[<шаблон для перемещения/переименования>]
'        /d:[<разделитель между тегами в шаблоне, если есть>]
'        /c:<минимальное число mp3 для перемещения>  (1 по умолч.)
'
' В шаблоне могут участвовать следующие теги:
' TrackNumber, Year, Title, Album, Artist, Genre
'
' Примеры ключей:
' 1) /s:"TrackNumber. Title" /d:". "
' 2) /s:"Artist\Artist - Title" /d:" - " /c:2
' 3) /s:"Artist\Year - Album\TrackNumber. Title" /d:" - "
'••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher •••

Option Explicit
Dim Scheme, Delim, Count, WMP, ShA, FSO, R, S, Dir, Disk

With WScript.Arguments.Named
  If .Count < 2 Then Msg "Не задано ни одного ключа!", 4144
  If Not .Exists("s") Then Msg "Ключ /s: обязателен!", 4144
  Scheme = .Item("s")
  If .Exists("d") Then Delim  = .Item("d") : _
  If InStr(Scheme, Delim) = 0 Then _
  Msg "В шаблоне отсутствует разделитель '" & Delim & "'!", 4144
  If .Exists("c") Then Count  = .Item("c") Else Count = 0
End With

Sub Msg(Text, Num)
  MsgBox Text, Num, " Переименование (перемещение) MP3     " : WScript.Quit
End Sub

If InStrRev(Scheme, "\") Then
  Dim Test : Test = InStr(Mid(Scheme, InStrRev(Scheme, "\")), Delim)
Else Count = 0 End If
If Count > 1 Then Dim Dic : _
Set Dic = CreateObject("Scripting.Dictionary")
Set ShA = CreateObject("Shell.Application")
Set WMP = CreateObject("WMPlayer.OCX")
Set FSO = CreateObject("Scripting.FileSystemObject")
R = Array(-230,-225,-246,698,894)
S = Split(": ? * "" ;"): Dim oDir
Dir = FSO.GetAbsolutePathName("") : oDir = Dir
Set Disk = ShA.NameSpace(FSO.GetDriveName(Dir))
Set Dir  = ShA.NameSpace(Dir) : Dim Items
Set Items = Dir.Items : Items.Filter 90304, "*.mp3"
If Items.Count = 0 Then Msg "В каталоге нет MP3-файлов!", 4144

Dim F, Path, Song, rPath, i, Name
For Each F in Items
  Set Song = WMP.NewMedia(F.Path)
  For Each i in Split("WM/Year WM/TrackNumber Title Album Artist Genre")
    Execute "t" & Replace(i, "WM/", "") & "= Trim(Song.getItemInfo(i))"
  Next : rPath = LCase(Scheme)
  For Each i in Split(LCase("Year TrackNumber Title Album Artist Genre"))
    Execute "rPath = Replace(rPath, i, t" & i & ")"
  Next
  With New RegExp
    .Global = True
    For Each i in Array("[ \.\(\{-]+\\+", "\\+[ \.\)\}-]+", "\\{2,}")
      .Pattern = i : rPath = .Replace(rPath, "\")
    Next
    For i = 0 To 4 : rPath = Replace(rPath, S(i), ChrW(R(i))) : Next
  End With : Name = FSO.GetFileName(rPath)
  Path = FSO.BuildPath(oDir, Left(rPath, InStrRev(rPath, "\")))
  If Not Test Or (Test And InStr(Name, Delim) > 0) Then
  If Right(rPath, 1) <> "\" And Len(tTitle) And InStr(Name, tTitle) > 0 Then
    If Not FSO.FolderExists(Path) Then Disk.NewFolder(Mid(Path, 4))
    rPath = FSO.BuildPath(Path, Name & "." & FSO.GetExtensionName(F))
    If Len(rPath) > 259 Then rPath = "\\?\" & rPath
    If Not FSO.FileExists(rPath) Then FSO.MoveFile F.Path, rPath
    If Count > 1 Then If Not Dic.Exists(Path) Then Dic.Add Path, ""
  End If
  End If : Set Song = Nothing
Next
If Count > 1 Then
  For Each I in Dic.Keys
    Set Items = ShA.NameSpace(I).Items
    Items.Filter 90304, "*.mp3"
    If Items.Count < CLng(Count) Then _
    Dir.MoveHere Items, 20 : FSO.GetFolder(I).Delete
  Next : Dic.RemoveAll
End If : Msg "Файлы переименованы/перемещены!", 4160