1

Тема: VBScript: работа с базой данных freedb.org, информация по аудио CD

Freedb — это база данных для поиска информации об аудио компакт-дисках с использованием Интернет, обновляющаяся несколько раз в день, всё содержимое которой опубликовано под лицензией GNU. Freedb-клиент вычисляет (почти) уникальный ID диска в CD ROM и делает запрос к базе данных. В результате клиент отображает исполнителя, заголовок компакт-диска, перечень треков и некоторую дополнительную информацию. Вся информация создаётся пользователями сервиса. Freedb основана на ныне коммерческой CDDB. Вот (неполный) список приложений, работающих с freedb (freedb, в основном, используется медиа плейерами, каталогерами, аудио теггерами и CD-рипперами). Можно запустить собственный freedb-сервер (под Linux), скачав соответствующее программное обеспечение с официального сайта freedb. На официальном сайте имеется интерактивный поиск.

Бесплатный ActiveX компонент uFREEDB для работы с freedb можно скачать здесь (чуть более 600 Кб). Пример работы можно найти здесь. Пример с переводом комментариев:

Option Explicit

If WScript.Arguments.Count > 0 Then Syntax

Dim arrCDROMs, i, j, k, objFreeDB, strMsg
i = 0

Const CDDB_MODE_TEST   = 0
Const CDDB_MODE_SUBMIT = 1

Set objFreeDB = CreateObject( "FREEDBControl.uFREEDB" )

With objFreeDB
    ' Задание свойств. Похоже, freedb.freedb.org не принимает значения по умолчанию.
    .AppName      = "QueryCD"
    .AppVersion   = "1.01"
    .EmailAddress = "test@scripting.eu"
    .CDDBServer   = "freedb.freedb.org"
    .CDDBMode     = CDDB_MODE_TEST
    ' Используйте CDDB_MODE_SUBMIT, если вы хотите отослать новые или поправочные данные на freedb.org

    ' Получение массива со всеми буквами дисков компакт-дисков
    arrCDROMs = Split(.GetCdRoms, "|")

    ' Обход устройств CDROM
    For j = 0 To UBound( arrCDROMs )
        ' Если информация получена
        If .GetMediaInfo( arrCDROMs(j) ) <> "" Then
            ' Счётчик CD
            i = i + 1
            ' Запрос к базе данных freedb.org о CD, по его TOC
            .LookupMediaByToc .GetMediaTOC( arrCDROMs(j) )
            ' Получение свойств альбома
            strMsg = "CD в устройстве " & UCase(arrCDROMs(j)) _
                   & " - это """ & .GetAlbumName & """, исполнитель: " _
                   & .GetArtistName & " (" & .GetAlbumYear & ", " _
                   & .GetAlbumGenre & ", " _
                   & .SecondsToTimeString( .GetAlbumLength ) & ")" & vbCrLf & vbCrLf
            ' Обход списка треков
            For k = 1 To .GetAlbumTracks
                ' Свойства трека
                strMsg = strMsg & "Track " & Right( " " & k, 2 ) & ":  " _
                       & .GetTrackName( CInt(k) ) _
                       & " (" & .SecondsToTimeString( .GetTrackTime( CInt(k) ) ) & ")" _
                       & vbCrLf
            Next
        End If
    Next
    If i = 0 Then
        strMsg = "CD не найдены."
    End If
End With

' Вывод результата
WScript.Echo strMsg

Set objFreeDB = Nothing

Sub Syntax
    strMsg = "QueryCD.vbs,  Version 1.01" & vbCrLf _
           & "Display album and track properties for all CDs in all CDROM drives" _
           & vbCrLf & vbCrLf _
           & "Usage:  QUERYCD.VBS" & vbCrLf & vbCrLf _
           & "Note:   This script requires ufreedb.ocx" & vbCrLf _
           & "        by Jon F. Zahornacky and Peter Schmiedseder" & vbCrLf _
           & "        http://www.robvanderwoude.com/vbstech_multimedia_freedb.html" _
           & vbCrLf & vbCrLf _
           & "Written by Rob van der Woude" & vbCrLf _
           & "http://www.robvanderwoude.com" & vbCrLf
    WScript.Echo strMsg
    WScript.Quit 1
End Sub

Если данные по CD не найдены, скрипт выдаст визуальную форму для их отправки.

Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.