Тема: 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 не найдены, скрипт выдаст визуальную форму для их отправки.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.