Серый форум — VBScript/WSH: Конвертация flac в mp3

Re: VBScript/WSH: Конвертация flac в mp3

null@example.com (alexii) — Mon, 04 Oct 2010 14:28:53 +0000

OFF:

Высокий пишет:

…теги не сможете перенести…

Да, ну, совсем не смогу : Функции?!

Re: VBScript/WSH: Конвертация flac в mp3

null@example.com (Высокий) — Mon, 04 Oct 2010 13:46:13 +0000

Как минимум, теги не сможете перенести и ручной работы многовато.

Re: VBScript/WSH: Конвертация flac в mp3

null@example.com (alexii) — Mon, 04 Oct 2010 12:46:42 +0000

OFF:

Высокий пишет:

Как вы предлагаете делать конвертацию Far'ом?

Не Far'ом, а с помощью Far'а; например: поиск *.flac, помещение результатов во временную панель, выделение, обработка файлов по Ctrl-G (на каждую команду) или, лучше, через подготовленный пункт UserMenu (так же, как Вы делаете посредством «WshShell.Run»). Естественно, без транслитерации; если она понадобиться — будет транслитерация, то надо будет уже писать макрос.

Re: VBScript/WSH: Конвертация flac в mp3

null@example.com (Высокий) — Mon, 04 Oct 2010 12:33:39 +0000

Обновил. Изменения:
* Учтён рабочий каталог скрипта. Протестирован SendTo.
* Учтён регистр тегов. Это нужно тестировать, мой metaflac 1.2.1 создает их в верхнем регистре. Возможно зависит от файла.
* Добавлено предварительное сканирование на наличие файлов flac.

'*********************************************************************************
'script        : flac_v_mp3.vbs
'description    : Recode flac to mp3  
'usage        : create a shortcut to this file in the "SendTo" folder or run with source path
'date        : 04.10.2010
'version    : 1.1
'req        : flac.exe metaflac.exe http://flac.sourceforge.net/ lame.exe http://lame.sourceforge.net
'author        : Ivan@Lapenkov.ru
'    Описание    
'    У вас есть папка вида    
'        "I:\Звук\Классика\_Сборники\Великие композиторы"
'    внутри которой папки и файлы, в том числе .flac :    
'        "I:\Звук\Классика\_Сборники\Великие композиторы\[01] Моцарт\01 - Маленькая ночная серенада соль мажор (KV 525) - Allegro.flac"
'    Запускаете     
'        flac_v_mp3.vbs "I:\Звук\Классика\_Сборники\Великие композиторы"
'    Создается папка    
'        "I:\Звук\Классика\_Сборники\Великие композиторы-mp3"
'    внутри которой:    
'        "I:\Звук\Классика\_Сборники\Великие композиторы-mp3\[01] Моцарт\01 - Маленькая ночная серенада соль мажор (KV 525) - Allegro.mp3"
'    или при запуске с настройкой RecodeRus=1 :    
'        "I:\Звук\Классика\_Сборники\Великие композиторы-mp3\[01] Mocart\01 - Malen'kaja nochnaja serenada sol' mazhor (KV 525) - Allegro.mp3"
'    Переносятся теги, высокое качество, VBR, стерео. Все настройки кодирования можно изменить. На посторонние файлы внимания не обращает.    
'    Скрипт создает временный файл в %Temp%, из тегов удаляются символы "?*\/|<>:
'    Скрипт можно запускать повторно, уже созданные файлы пропускаются.
'        
'    Скрипт требует следующие компоненты в своей папке:    
'    flac.exe metaflac.exe    
'    Версия     1.2.1
'    http://flac.sourceforge.net    
'        
'    lame.exe    
'    Версия    3.98.4
'    http://lame.sourceforge.net    
'        
'    Протестировано на WinXP Prof sp3 rus.    
'    Автор программы разрешает её свободное распространение и использование любых её фрагментов.
'*********************************************************************************

'***********************************
'Настройки
'***********************************
Option Explicit

' Настройки кодировщика LAME
Const LameKeys = "-V 0 --vbr-new -m s -q 2 --add-id3v2 --ignore-tag-errors --nohist --quiet" 

' 1 - перекодировать имена файлов в транслит, 0 - нет. Удобно для устройств не поддерживающих кириллицу.
Const RecodeRus=0

' Пауза на сообщениях о некритических ошибках, секунды
Const PauseSize = 5     

' 0 - окна кодировщиков скрыты, 1 - показываются
Const WindowState = 0    

' Будет добавлено к имени исходной папки при создании выходной папки
Const sPostfixFolder = "-mp3" 

' Расширения файлов
Const sExtToGet = "flac"
Const sExtToSet = "mp3"

' Название приложения
Const sAppName = "Конвертер FLAC в mp3"

' Таблицы конвертации символов
Const tr="а б в г д е ё  ж  з и й  к л м н о п р с т у ф х  ц ч  ш  щ   ъ  ы ь э  ю  я  А Б В Г Д Е Ё  Ж  З И Й  К Л М Н О П Р С Т У Ф Х  Ц Ч  Ш  Щ   Ъ  Ы Ь Э  Ю  Я  "
Const tl="аaбbвvгgдdеeёjoжzhзzиiйjjкkлlмmнnоoпpрrсsтtуuфfхkhцcчchшshщshhъ''ыyь'эehюjuяjaАAБBВVГGДDЕEЁJoЖZhЗZИIЙJjКKЛLМMНNОOПPРRСSТTУUФFХKhЦCЧChШShЩShhЪ''ЫYЬ'ЭEhЮJuЯJa"

'***********************************
'Начало основной программы
'***********************************
Dim fso, WshShell, Kav, cptTot, objArgs, arg, dicPath, TagKeys, ScriptPath
Dim sSourceFolder, sSavePath, sTempFolder
Dim FlacExeFile, MetaFlacExeFile, LameExeFile
Dim nTime

Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set dicPath = CreateObject("Scripting.Dictionary")
cptTot = 0 
nTime = Timer

sTempFolder = WshShell.ExpandEnvironmentStrings("%Temp%")

ScriptPath = FSO.GetParentFolderName(WScript.ScriptFullName)
FlacExeFile = FSO.BuildPath(ScriptPath, "flac.exe")
MetaFlacExeFile = FSO.BuildPath(ScriptPath, "metaflac.exe")
LameExeFile = FSO.BuildPath(ScriptPath, "lame.exe")

If Not fso.FileExists(FlacExeFile) Then
    WshShell.Popup "Не найден " & FlacExeFile, 0, sAppName, 48
    WScript.Quit
End If

If Not fso.FileExists(MetaFlacExeFile) Then
    WshShell.Popup "Не найден " & MetaFlacExeFile, 0, sAppName, 48
    WScript.Quit
End If

If Not fso.FileExists(LameExeFile) Then
    WshShell.Popup "Не найден " & LameExeFile, 0, sAppName, 48
    WScript.Quit
End If



Set objArgs = WScript.Arguments
if (objArgs.Count = 0) then
    WshShell.Popup "В командной строке должен быть путь к исходным файлам. Need source path in arguments.", 0, sAppName, 48
    WScript.Quit
End If

'-- Работа
Call startScanning()
Call endPopup()

'-- Очистка
Set fso = nothing
Set WshShell = nothing                    
Set dicPath = nothing
'***********************************
'Конец основной программы
'***********************************


'***********************************
'Функции
'***********************************

Sub startScanning()

    Dim arg, fold, sSourceFoldName

    ' перебирает пути из командой строки
    For each arg in objArgs
        If fso.FolderExists(arg) Then
            
            Set sSourceFolder = fso.Getfolder(arg)

            ' Определимся с папкой для сохранения
            sSourceFoldName = sSourceFolder.Path
            sSavePath = sSourceFoldName & sPostfixFolder
            dicPath.add sSavePath, sSavePath

            'Обойдем папки, проверяя нужность конвертации
            Call DoCheck(sSourceFolder)

            If cptTot=0 Then
                WshShell.Popup "Файлов для конвертации нет", PauseSize, sAppName, 48
                WScript.Quit
            Else
                'WshShell.Popup "Файлов для конвертации " & cptTot, PauseSize, sAppName, 64
            End If
            
            cptTot=0

            ' Создание папки для сохранения
            If Not fso.FolderExists(sSavePath) Then
                'WshShell.Popup "Создание папки " & sSavePath, PauseSize, sAppName, 64
                fso.CreateFolder(sSavePath)
            End If

            'Обойдем папки, конвертируя
            Call DoIt(sSourceFolder)
        End If
    Next
End Sub 
'*********************************************************************************

Sub DoIt(fold)
' Рекурсия
    Dim sfold, sfoo
    Call ProceedFiles(fold)        ' обработывает все файлы в текущей папке
    Set sfold = fold.subfolders 
    for each sfoo in sfold        ' работа с подпапками
        Call DoIt(sfoo)
    Next
End Sub  

'*********************************************************************************
' Основная процедура обработки

Sub ProceedFiles(fold)

    Dim RetCode, strExt, mpFiles, objFile, strName, strNameNew, foldPath, cpt, f, mp3filename, mp3filepath, tempfilename, flacfilename, RunFlacCommand, RunLameCommand
    Dim temptagfile, temptagfilename, TagsText, TextLine

    tempfilename = sTempFolder &"\"& FSO.GetTempName()
    temptagfilename = sTempFolder &"\"& FSO.GetTempName()
    If fso.FileExists(tempfilename) Then
                  fso.DeleteFile tempfilename, 1
    End If
    If fso.FileExists(temptagfilename) Then
                  fso.DeleteFile temptagfilename, 1
    End If

    cpt = 0
    foldPath = fold.Path
    mp3filepath = Replace(foldPath, sSourceFolder.Path, "")
    If RecodeRus = 1 Then
        mp3filepath=translit(mp3filepath)
    End If
    mp3filepath=sSavePath & mp3filepath

    ' ***** Создание конечной папки 
    If Not fso.FolderExists(mp3filepath) Then
        fso.CreateFolder(mp3filepath)
    End If

    ' ***** обработаем все файлы в папке
    Set mpfiles = fold.Files
    
    For each f in mpfiles

        strName = f.Name
        strExt = LCase(fso.GetExtensionName(strName)) ' Получим расширение

        If strExt = sExtToGet Then

            ' ***** Подготовка имен файлов
            flacfilename = foldPath &"\"& strName
            strNameNew = Replace(strName, sExtToGet, sExtToSet)
            If RecodeRus = 1 Then
                strNameNew=translit(strNameNew)
            End If
                   mp3filename = mp3filepath & "\" & strNameNew

            ' ***** Проверка нужности конвертации
            If Not fso.FileExists(mp3filename) Then

            ' ***** Раскодирование во временный файл
            RunFlacCommand = FlacExeFile &" -d -F -f """& flacfilename &""" -o """& tempfilename &""" "
            RetCode = WshShell.Run(RunFlacCommand, WindowState , true)
            If RetCode = 1 Then
                WshShell.Popup " Ошибка в "& RunFlacCommand, PauseSize, sAppName, 48
            End If
            ' если у файла назначения есть атрибут ReadOnly, снимаем его
            If fso.FileExists(tempfilename) Then
                    Set objFile = FSO.GetFile(tempfilename)
                If objFile.Attributes And 1 Then
                    objFile.Attributes = objFile.Attributes - 1
                End If
                set objFile = nothing
            End If

            ' ***** теги
            TagKeys="" ' главная переменная куда будут сохраняться ключи командной строки
            RunFlacCommand = MetaFlacExeFile &" --export-tags-to="& temptagfilename &" """& flacfilename &""" "
            RetCode = WshShell.Run(RunFlacCommand, WindowState , true)
            If fso.FileExists(temptagfilename) Then
                Set temptagfile = FSO.GetFile(temptagfilename)
                Set TagsText = temptagfile.OpenAsTextStream(1,0)
                Do While Not TagsText.AtEndOfStream
                    ParseTagToKeys(TagsText.ReadLine)
                Loop
                TagsText.Close
                set temptagfile = nothing
                fso.DeleteFile temptagfilename, 1
                TagKeys = TagKeys &" --tv ""TENC=FLAC->LAME"""
            End If

            ' ***** Кодирование в mp3
            RunLameCommand = LameExeFile &" "& LameKeys &" "& TagKeys &" """& tempfilename &"""  """& mp3filename &""" "
            RetCode = WshShell.Run(RunLameCommand, WindowState , true)
            If not RetCode = 0 Then
                WshShell.Popup " Ошибка в "& RunLameCommand, PauseSize, sAppName, 48
            End If


            ' ***** Удаление временного файла
            If fso.FileExists(tempfilename) Then
                            fso.DeleteFile tempfilename, 1
            End If

            cpt = cpt + 1
                          
            End If
        End If
    Next

    cptTot = cptTot + cpt    ' общий счетчик файлов
End Sub
'*********************************************************************************

Sub ParseTagToKeys(textline)

    ParseTag textline,"TITLE", "--tt"
    ParseTag textline,"DATE","--ty"
    ParseTag textline,"ARTIST","--ta"
    ParseTag textline,"ALBUM","--tl"
    ParseTag textline,"TRACKNUMBER","--tn"
    ParseTag textline,"ENSEMBLE","--tv ""TCOM="
    ParseTag textline,"ENSEMBLE","--tv ""TPE2="
    ParseTag textline,"COMMENT","--tc"

'    ParseTag textline,"YEAR","--ty"
    'ParseTag textline,"GENRE","--tg"     '"genre" нужно включать таблицу, но нет желания с ней возиться
    'ParseTag textline,"ENCODER",""     ' FLAC->LAME

End Sub
'*********************************************************************************

Sub ParseTag(textline,tag,cmdkey)
        Dim TagText, Pos, TagKey
    TagKey=""
    Pos=0
    textline=trim(textline)
    tag=tag&"="
    
    Pos=InStr(UCase(textline), UCase(tag))

        If Not Pos=0 Then
        TagText=Mid(textline, len(tag)+1)
        TagText=StrConvert(TagText, "windows-1251", "cp866")
        TagText = Replace(TagText, """", "'") 
        TagText = Replace(TagText, ":", " ")
        TagText = Replace(TagText, "<", "'")
        TagText = Replace(TagText, ">", "'")
        TagText = Replace(TagText, "|", " ")
        TagText = Replace(TagText, "?", " ")
        TagText = Replace(TagText, "*", "+")
        TagText = Replace(TagText, "/", " ")
        TagText = Replace(TagText, "\", " ")
        If RecodeRus = 1 Then
            TagText=translit(TagText)
        End If
        If InStr(cmdkey, """")=0 Then ' часть cmdkey идёт с открытыми кавычками
            TagKey=cmdkey & " """ & TagText & """"
        Else
            TagKey=cmdkey & TagText & """"
        End If
        TagKeys = TagKeys &" "& TagKey
    End If
End Sub
'*********************************************************************************

'=============================================================================
' HKEY_CLASSES_ROOT\MIME\Database\Charset
' cp866, windows-1251, koi8-r, unicode, utf-8, _autodetect
'=============================================================================
Function StrConvert(ByVal strText, ByVal strSourceCharset, ByVal strDestCharset)
    Const adTypeText      = 2
    Const adModeReadWrite = 3
    
    
    With WScript.CreateObject("ADODB.Stream")
        .Type      = adTypeText
        .Mode      = adModeReadWrite
        
        .Open
        
        .Charset   = strSourceCharset
        .WriteText strText
        
        .Position  = 0
        .Charset   = strDestCharset
        StrConvert = .ReadText
        
        .Close
    End With
End Function

Function showTime(nTime)
    showTime = "Затрачено времени : " & Round((Timer - nTime),2) &" секунд"
End Function
'*********************************************************************************

' функция транслитерации строки по ГОСТ 7.79 2000
Function translit(ByVal sIncoming)
    Dim pos, findpos, sSymbol
    
    translit=""

    For pos = 1 To len(sIncoming) Step 1

        sSymbol=mid(sIncoming,pos,1)
        findpos=InStr(1, tr, sSymbol)
        If findpos=0 or sSymbol=" " Then
            ' ***** В транслитерации не нуждается
            translit=translit+sSymbol
        Else
            ' ***** Первый символ
            translit=translit+mid(tl,findpos+1,1)
            ' ***** Второй символ
            If mid(tr,findpos+2,1)=" " Then
                translit=translit+mid(tl,findpos+2,1)
                ' ***** Третий символ
                If mid(tr,findpos+3,1)=" " Then
                    translit=translit+mid(tl,findpos+3,1)
                End If
            End If
        End If
    Next
End Function

'*********************************************************************************
' проверяет наличие файлов для конвертации
Sub DoCheck(fold)

    Dim sfold, sfoo
    Dim strExt, mpFiles, strName, strNameNew, foldPath, cpt, f, mp3filename, mp3filepath

    cpt = 0
    foldPath = fold.Path
    mp3filepath = Replace(foldPath, sSourceFolder.Path, "")
    If RecodeRus = 1 Then
        mp3filepath=translit(mp3filepath)
    End If
    mp3filepath=sSavePath & mp3filepath

    ' ***** обработаем все файлы в папке
    Set mpfiles = fold.Files
    
    For each f in mpfiles

        strName = f.Name
        strExt = LCase(fso.GetExtensionName(strName)) ' Получим расширение

        If strExt = sExtToGet Then

            strNameNew = Replace(strName, sExtToGet, sExtToSet)
            If RecodeRus = 1 Then
                strNameNew=translit(strNameNew)
            End If
                   mp3filename = mp3filepath & "\" & strNameNew

            ' ***** Проверка нужности конвертации
            If Not fso.FileExists(mp3filename) Then

                cpt = cpt + 1
    
            End If
                          
        End If
    Next

    cptTot = cptTot + cpt    ' общий счетчик файлов

    ' ***** обработаем все подпапки в папке
    Set sfold = fold.subfolders 
    for each sfoo in sfold
        Call DoCheck(sfoo) ' Рекурсия
    Next
End Sub  


Sub endPopup()
    WshShell.Popup "Завершено. "  & chr(13) & chr(13) & cptTot & _
                    " файлов обработано в " & chr(13) & _
                    Join(dicPath.items, vbCrLf) & Chr(13) & Chr(13) & _
                    showTime(nTime), 0, sAppName, 64    
End Sub
'*********************************************************************************

я не вижу необходимости пользовать подобное при наличии Far'а.

Как вы предлагаете делать конвертацию Far'ом?

Re: VBScript/WSH: Конвертация flac в mp3

null@example.com (alexii) — Mon, 04 Oct 2010 08:22:42 +0000

OFF: Мне не то, чтобы лень, а:
* у меня нет ни одного *.flac (так что, я даже толком не знаю, каково оно на вкус );
* я не вижу необходимости пользовать подобное при наличии Far'а.

Могу сказать лишь, что такие конструкции:

If Not fso.FileExists("lame.exe") Then
    WshShell.Popup "В папке со скриптом должен быть файл lame.exe", 0, sAppName, 48
…

красиво работают лишь до тех пор, пока рабочий каталог тождественен каталогу, содержащему скрипт. При попытке вызвать скрипт посредством ярлыка в SendTo или Drag-n-Drop на него:

'usage : create a shortcut to this file in the "SendTo" folder or drag-drop folders on it or…

або вызвать из иного каталога с указанием полного пути к скрипту — последний закономерно отваливается на данной конструкции. Так делать нельзя.

P.S. Есть ли необходимость создавать выходную папку при отсутствии хотя бы одного сконвертированного файла?

Re: VBScript/WSH: Конвертация flac в mp3

null@example.com (DnsIs) — Mon, 04 Oct 2010 06:43:24 +0000

Создал папку с хаотичной структурой с максимальной вложенностью 3 уровня. Все отлично сконвертилось. Получилось аналогичное зеркало mp3-шек.
НО! Теги не перенеслись.

Поковырял, оказалось что названия тегов во временном файле у меня получились строчными буквами.

artist=Ali Farka Toure
title=I Go Ka
album=The Source
date=1991
tracknumber=08
genre=World
comment=shared by pastafari cubensis

У вас же в скрипте

    ParseTag textline,"TITLE", "--tt"
    ParseTag textline,"YEAR","--ty"
    ParseTag textline,"ARTIST","--ta"
    ParseTag textline,"ALBUM","--tl"
    ParseTag textline,"TRACKNUMBER","--tn"
    ParseTag textline,"ENSEMBLE","--tv ""TCOM="
    ParseTag textline,"ENSEMBLE","--tv ""TPE2="
    ParseTag textline,"COMMENT","--tc"

Я так понимаю, либо не хватает функции toLowerCase() (или какая она там в VBS) либо metaflac.exe другой версии.
Хотя проверил только что. v1.2.1, свеже скачанная.

Re: VBScript/WSH: Конвертация flac в mp3

null@example.com (The gray Cardinal) — Mon, 04 Oct 2010 05:15:01 +0000

Прошу отписаться всех, кому не лень протестировать.

VBScript/WSH: Конвертация flac в mp3

null@example.com (Высокий) — Sun, 03 Oct 2010 20:51:05 +0000

Написал скрипт конвертация flac в mp3. Описание в шапке.

'*********************************************************************************
'script        : flac_v_mp3.vbs
'description    : Recode flac to mp3  
'usage        : create a shortcut to this file in the "SendTo" folder or drag-drop folders on it or run with source path
'date        : 01.10.2010
'version    : 1.0
'req        : flac.exe metaflac.exe http://flac.sourceforge.net/ lame.exe http://lame.sourceforge.net
'author        : Ivan@Lapenkov.ru
'    Описание    
'    У вас есть папка вида    
'        "I:\Звук\Классика\_Сборники\Великие композиторы"
'    внутри которой папки и файлы, в том числе .flac :    
'        "I:\Звук\Классика\_Сборники\Великие композиторы\[01] Моцарт\01 - Маленькая ночная серенада соль мажор (KV 525) - Allegro.flac"
'    Запускаете     
'        flac_v_mp3.vbs "I:\Звук\Классика\_Сборники\Великие композиторы"
'    Создается папка    
'        "I:\Звук\Классика\_Сборники\Великие композиторы-mp3"
'    внутри которой:    
'        "I:\Звук\Классика\_Сборники\Великие композиторы-mp3\[01] Моцарт\01 - Маленькая ночная серенада соль мажор (KV 525) - Allegro.mp3"
'    или при запуске с настройкой RecodeRus=1 :    
'        "I:\Звук\Классика\_Сборники\Великие композиторы-mp3\[01] Mocart\01 - Malen'kaja nochnaja serenada sol' mazhor (KV 525) - Allegro.mp3"
'    Переносятся теги, высокое качество, VBR, стерео. Все настройки кодирования можно изменить. На посторонние файлы внимания не обращает.    
'    Скрипт создает временный файл в %Temp%, из тегов удаляются символы "?*\/|<>:
'    Скрипт можно запускать повторно, уже созданные файлы пропускаются.
'        
'    Скрипт требует следующие компоненты в своей папке:    
'    flac.exe metaflac.exe    
'    Версия     1.2.1
'    http://flac.sourceforge.net    
'        
'    lame.exe    
'    Версия    3.98.4
'    http://lame.sourceforge.net    
'        
'    Протестировано на WinXP Prof sp3 rus.    
'    Автор программы разрешает её свободное распространение и использование любых её фрагментов.
'*********************************************************************************

'***********************************
'Настройки
'***********************************
Option Explicit

' Настройки кодировщика LAME
Const LameKeys = "-V 0 --vbr-new -m s -q 2 --add-id3v2 --ignore-tag-errors --nohist --quiet" 

' 1 - перекодировать имена файлов в транслит, 0 - нет. Удобно для устройств не поддерживающих кириллицу.
Const RecodeRus=0

' Пауза на сообщениях о некритических ошибках, секунды
Const PauseSize = 5     

' 0 - окна кодировщиков скрыты, 1 - показываются
Const WindowState = 0    

' Будет добавлено к имени исходной папки при создании выходной папки
Const sPostfixFolder = "-mp3" 

' Расширения файлов
Const sExtToGet = "flac"
Const sExtToSet = "mp3"

' Название приложения
Const sAppName = "Конвертер FLAC в mp3"

' Таблицы конвертации символов
Const tr="а б в г д е ё  ж  з и й  к л м н о п р с т у ф х  ц ч  ш  щ   ъ  ы ь э  ю  я  А Б В Г Д Е Ё  Ж  З И Й  К Л М Н О П Р С Т У Ф Х  Ц Ч  Ш  Щ   Ъ  Ы Ь Э  Ю  Я  "
Const tl="аaбbвvгgдdеeёjoжzhзzиiйjjкkлlмmнnоoпpрrсsтtуuфfхkhцcчchшshщshhъ''ыyь'эehюjuяjaАAБBВVГGДDЕEЁJoЖZhЗZИIЙJjКKЛLМMНNОOПPРRСSТTУUФFХKhЦCЧChШShЩShhЪ''ЫYЬ'ЭEhЮJuЯJa"

'***********************************
'Начало основной программы
'***********************************
Dim fso, WshShell, Kav, cptTot, objArgs, arg, dicPath, TagKeys
Dim sSourceFolder, sSavePath, sTempFolder
Dim nTime

Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set dicPath = CreateObject("Scripting.Dictionary")
cptTot = 0 
nTime = Timer

sTempFolder = WshShell.ExpandEnvironmentStrings("%Temp%")

If Not fso.FileExists("lame.exe") Then
    WshShell.Popup "В папке со скриптом должен быть файл lame.exe", 0, sAppName, 48
    WScript.Quit
End If

If Not fso.FileExists("flac.exe") Then
    WshShell.Popup "В папке со скриптом должен быть файл flac.exe", 0, sAppName, 48
    WScript.Quit
End If

If Not fso.FileExists("metaflac.exe") Then
    WshShell.Popup "В папке со скриптом должен быть файл metaflac.exe", 0, sAppName, 48
    WScript.Quit
End If


Set objArgs = WScript.Arguments
if (objArgs.Count = 0) then
    WshShell.Popup "В командной строке должен быть путь к исходным файлам. Need source path in arguments.", 0, sAppName, 48
    WScript.Quit
End If

'-- Работа
Call startScanning()
Call endPopup()

'-- Очистка
Set fso = nothing
Set WshShell = nothing                    
Set dicPath = nothing
'***********************************
'Конец основной программы
'***********************************


'***********************************
'Функции
'***********************************

Sub startScanning()

    Dim arg, fold, sSourceFoldName

    ' перебирает пути из командой строки
    For each arg in objArgs
        If fso.FolderExists(arg) Then
            
            Set sSourceFolder = fso.Getfolder(arg)

            ' Определимся с папкой для сохранения
            sSourceFoldName = sSourceFolder.Path
            sSavePath = sSourceFoldName & sPostfixFolder
            dicPath.add sSavePath, sSavePath

            ' Создание папки для сохранения
            If Not fso.FolderExists(sSavePath) Then
                'WshShell.Popup "Создание папки " & sSavePath, PauseSize, sAppName, 64
                fso.CreateFolder(sSavePath)
            End If

            'Обойдем папки, конвертируя
            Call DoIt(sSourceFolder)        
        End If
    Next
End Sub 
'*********************************************************************************

Sub DoIt(fold)
' Рекурсия
    Dim sfold, sfoo
    Call ProceedFiles(fold)        ' обработывает все файлы в текущей папке
    Set sfold = fold.subfolders 
    for each sfoo in sfold        ' работа с подпапками
        Call DoIt(sfoo)
    Next
End Sub  

'*********************************************************************************
' Основная процедура обработки

Sub ProceedFiles(fold)

    Dim RetCode, strExt, mpFiles, objFile, strName, strNameNew, foldPath, cpt, f, mp3filename, mp3filepath, tempfilename, flacfilename, RunFlacCommand, RunLameCommand
    Dim temptagfile, temptagfilename, TagsText, TextLine

    tempfilename = sTempFolder &"\"& FSO.GetTempName()
    temptagfilename = sTempFolder &"\"& FSO.GetTempName()
    If fso.FileExists(tempfilename) Then
                  fso.DeleteFile tempfilename, 1
    End If
    If fso.FileExists(temptagfilename) Then
                  fso.DeleteFile temptagfilename, 1
    End If

    cpt = 0
    foldPath = fold.Path
    mp3filepath = Replace(foldPath, sSourceFolder.Path, "")
    If RecodeRus = 1 Then
        mp3filepath=translit(mp3filepath)
    End If
    mp3filepath=sSavePath & mp3filepath

    ' ***** Создание конечной папки 
    If Not fso.FolderExists(mp3filepath) Then
        fso.CreateFolder(mp3filepath)
    End If

    ' ***** обработаем все файлы в папке
    Set mpfiles = fold.Files
    
    For each f in mpfiles

        strName = f.Name
        strExt = LCase(fso.GetExtensionName(strName)) ' Получим расширение

        If strExt = sExtToGet Then

            ' ***** Подготовка имен файлов
            flacfilename = foldPath &"\"& strName
            strNameNew = Replace(strName, sExtToGet, sExtToSet)
            If RecodeRus = 1 Then
                strNameNew=translit(strNameNew)
            End If
                   mp3filename = mp3filepath & "\" & strNameNew

            ' ***** Проверка нужности конвертации
            If Not fso.FileExists(mp3filename) Then

            ' ***** Раскодирование во временный файл
            RunFlacCommand = "flac -d -F -f """& flacfilename &""" -o """& tempfilename &""" "
            RetCode = WshShell.Run(RunFlacCommand, WindowState , true)
            If RetCode = 1 Then
                WshShell.Popup " Ошибка в "& RunFlacCommand, PauseSize, sAppName, 48
            End If
            ' если у файла назначения есть атрибут ReadOnly, снимаем его
            If fso.FileExists(tempfilename) Then
                    Set objFile = FSO.GetFile(tempfilename)
                If objFile.Attributes And 1 Then
                    objFile.Attributes = objFile.Attributes - 1
                End If
                set objFile = nothing
            End If

            ' ***** теги
            TagKeys="" ' главная переменная куда будут сохраняться ключи командной строки
            RunFlacCommand = "metaflac.exe --export-tags-to="& temptagfilename &" """& flacfilename &""" "
            RetCode = WshShell.Run(RunFlacCommand, WindowState , true)
            If fso.FileExists(temptagfilename) Then
                Set temptagfile = FSO.GetFile(temptagfilename)
                Set TagsText = temptagfile.OpenAsTextStream(1,0)
                Do While Not TagsText.AtEndOfStream
                    ParseTagToKeys(TagsText.ReadLine)
                Loop
                TagsText.Close
                set temptagfile = nothing
                fso.DeleteFile temptagfilename, 1
                TagKeys = TagKeys &" --tv ""TENC=FLAC->LAME"""
            End If

            ' ***** Кодирование в mp3
            RunLameCommand = "lame "& LameKeys &" "& TagKeys &" """& tempfilename &"""  """& mp3filename &""" "
            RetCode = WshShell.Run(RunLameCommand, WindowState , true)
            If not RetCode = 0 Then
                WshShell.Popup " Ошибка в "& RunLameCommand, PauseSize, sAppName, 48
            End If


            ' ***** Удаление временного файла
            If fso.FileExists(tempfilename) Then
                            fso.DeleteFile tempfilename, 1
            End If

            cpt = cpt + 1
                          
            End If
        End If
    Next

    cptTot = cptTot + cpt    ' общий счетчик файлов
End Sub
'*********************************************************************************

Sub ParseTagToKeys(textline)

    ParseTag textline,"TITLE", "--tt"
    ParseTag textline,"YEAR","--ty"
    ParseTag textline,"ARTIST","--ta"
    ParseTag textline,"ALBUM","--tl"
    ParseTag textline,"TRACKNUMBER","--tn"
    ParseTag textline,"ENSEMBLE","--tv ""TCOM="
    ParseTag textline,"ENSEMBLE","--tv ""TPE2="
    ParseTag textline,"COMMENT","--tc"

    'ParseTag textline,"GENRE","--tg"     '"genre" нужно включать таблицу, но нет желания с ней возиться
    'ParseTag textline,"ENCODER",""     ' FLAC->LAME

End Sub
'*********************************************************************************

Sub ParseTag(textline,tag,cmdkey)
        Dim TagText, Pos, TagKey
    TagKey=""
    tag=tag&"="
    Pos=InStr(textline, tag)
        If Not Pos=0 Then
        TagText=Mid(textline, len(tag)+1)
        TagText=StrConvert(TagText, "windows-1251", "cp866")
        TagText = Replace(TagText, """", "'") 
        TagText = Replace(TagText, ":", " ")
        TagText = Replace(TagText, "<", "'")
        TagText = Replace(TagText, ">", "'")
        TagText = Replace(TagText, "|", " ")
        TagText = Replace(TagText, "?", " ")
        TagText = Replace(TagText, "*", "+")
        TagText = Replace(TagText, "/", " ")
        TagText = Replace(TagText, "\", " ")
        If RecodeRus = 1 Then
            TagText=translit(TagText)
        End If
        If InStr(cmdkey, """")=0 Then ' часть cmdkey идёт с открытыми кавычками
            TagKey=cmdkey & " """ & TagText & """"
        Else
            TagKey=cmdkey & TagText & """"
        End If
        TagKeys = TagKeys &" "& TagKey
    End If
End Sub
'*********************************************************************************

'=============================================================================
' HKEY_CLASSES_ROOT\MIME\Database\Charset
' cp866, windows-1251, koi8-r, unicode, utf-8, _autodetect
'=============================================================================
Function StrConvert(ByVal strText, ByVal strSourceCharset, ByVal strDestCharset)
    Const adTypeText      = 2
    Const adModeReadWrite = 3
    
    
    With WScript.CreateObject("ADODB.Stream")
        .Type      = adTypeText
        .Mode      = adModeReadWrite
        
        .Open
        
        .Charset   = strSourceCharset
        .WriteText strText
        
        .Position  = 0
        .Charset   = strDestCharset
        StrConvert = .ReadText
        
        .Close
    End With
End Function

Function showTime(nTime)
    showTime = "Затрачено времени : " & Round((Timer - nTime),2) &" секунд"
End Function
'*********************************************************************************

' функция транслитерации строки по ГОСТ 7.79 2000
Function translit(ByVal sIncoming)
    Dim pos, findpos, sSymbol
    
    translit=""

    For pos = 1 To len(sIncoming) Step 1

        sSymbol=mid(sIncoming,pos,1)
        findpos=InStr(1, tr, sSymbol)
        If findpos=0 or sSymbol=" " Then
            ' ***** В транслитерации не нуждается
            translit=translit+sSymbol
        Else
            ' ***** Первый символ
            translit=translit+mid(tl,findpos+1,1)
            ' ***** Второй символ
            If mid(tr,findpos+2,1)=" " Then
                translit=translit+mid(tl,findpos+2,1)
                ' ***** Третий символ
                If mid(tr,findpos+3,1)=" " Then
                    translit=translit+mid(tl,findpos+3,1)
                End If
            End If
        End If
    Next
End Function

Sub endPopup()
    WshShell.Popup "Завершено. "  & chr(13) & chr(13) & cptTot & _
                    " файлов обработано в " & chr(13) & _
                    Join(dicPath.items, vbCrLf) & Chr(13) & Chr(13) & _
                    showTime(nTime), 0, sAppName, 64    
End Sub
'*********************************************************************************

Если качество устраивает, то можете добавить в коллекцию.