Lemur zaprasza
Czytanie tag'ów z MP3 Format MP3 jest najbardziej rozpowszechnionym standardem przechowywania muzyki na komputerze. Pisanie programu odtwarzającego MP3 jest trudne, ale można skorzystać z gotowych kontrolek. Gorzej z tag'ami MP3, czyli informacjami o ich tytule, autorze, pochodzeniu, z jakiego albumu pochodzą itp. Wykorzystywane są dwie wersje ID3Tag 1.1 i ID3Tag 2.3. Oto są funkcje (ściągnięte z internetu) czytające te tagi: Dla wersji 1.1: Private Sub GetID3Tag_11(ByVal strFileName As String) Dim lFile As Long, lFileLen As Long Dim b() As Byte, strTemp As String, lTemp As Long lFile = FreeFile Open strFileName For Binary As #lFile lFileLen = LOF(lFile) lTemp = lFileLen - 127 If lTemp > 0 Then strTemp = Space(3) Get #lFile, lTemp, strTemp If StrComp(strTemp, "TAG", vbBinaryCompare) = 0 Then Debug.Print "ID3v1 tag detected:" '-- Title ------------------- strTemp = Space$(30) Get #lFile, lTemp + 3, strTemp Debug.Print " Title : " & Trim$(strTemp) '-- Artist ------------------ strTemp = Space$(30) Get #lFile, , strTemp Debug.Print " Artist : " & Trim$(strTemp) '-- Album ------------------- strTemp = Space$(30) Get #lFile, , strTemp Debug.Print " Album : " & Trim$(strTemp) '-- Year -------------------- strTemp = Space$(4) Get #lFile, , strTemp Debug.Print " Year : " & Trim$(strTemp) '-- Comment ----------------- ReDim b(29) Get #lFile, , b() If ((b(28) = 0) And (b(29) <> 0)) Or ((b(28) = 32) And (b(29) <> 32) And (b(29) <> 0)) Then Debug.Print " Song no : " & b(29) ReDim Preserve b(28) End If strTemp = StrConv(b(), vbUnicode) Debug.Print " Comment : " & Trim$(strTemp) '-- Genre ------------------- ReDim b(0) Get #lFile, , b(0) Debug.Print " Genre : " & GetGenre(b(0)) End If End If Close #lFile End Sub Private Function GetGenre(ByVal lGenre As Byte) As String Select Case lGenre Case 0 GetGenre = "Blues" Case 1 GetGenre = "Classic Rock" 'Reszta pominieta ze wzgledu na wielkosc ... Case Else GetGenre = "" End Select End Function Dla wersji 2.3: Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Sub GetID3Tag_2(ByVal strFileName As String) Dim lFile As Long, lFileLen As Long Dim b() As Byte, strTemp As String, lTemp As Long Dim lFrameStart As Long, lFrameSize As Long Dim strFrameID As String, lHeaderEnd As Long Dim bFlags2 As Byte lFile = FreeFile Open strFileName For Binary As #lFile lFileLen = LOF(lFile) 'Let's check the Tag ReDim b(9) Get #lFile, 1, b() If (b(0) = &H49) And (b(1) = &H44) And (b(2) = &H33) And (b(3) < &HFF) And (b(4) < &HFF) And (b(6) < &H80) And (b(7) < &H80) And (b(8) < &H80) Then Debug.Print "ID3v2." & b(3) & "." & b(4) & " tag detected." Debug.Print "Flags : " & ReadFlags(b(5)) lTemp = GetTagSize(b(6), b(7), b(8), b(9)) Debug.Print "Size : " & lTemp lHeaderEnd = 10 + lTemp 'Ten przyklad nie uwzglednia ew. istnienia rozszerzonego naglowka lFrameStart = 10 Do While lFrameStart < lHeaderEnd ReDim b(9) Get #lFile, , b() strFrameID = Chr$(b(0)) & Chr$(b(1)) & Chr$(b(2)) & Chr$(b(3)) lFrameSize = GetFrameSize(b(7), b(6), b(5), b(4)) bFlags2 = b(9) 'Read frame data ReDim b(lFrameSize - 1) Get #lFile, , b() Debug.Print DisplayFrame(strFrameID, b(), bFlags2) lFrameStart = lFrameStart + 10 + lFrameSize Loop End If Close #lFile End Sub Private Function GetTagSize(ByVal b4 As Byte, ByVal b3 As Byte, ByVal b2 As Byte, ByVal b1 As Byte) As Long 'Funkcja dla skrocenia kodu nie uzywa shr Dim b(3) As Byte If (b2 And 1) > 0 Then b1 = (b1 Or (2 ^ 7)) b2 = b2 \ 2 If (b3 And 1) > 0 Then b2 = (b2 Or (2 ^ 6)) If (b3 And 2) > 0 Then b2 = (b2 Or (2 ^ 7)) b3 = b3 \ 4 If (b4 And 1) > 0 Then b3 = (b3 Or (2 ^ 5)) If (b4 And 2) > 0 Then b3 = (b3 Or (2 ^ 6)) If (b4 And 4) > 0 Then b3 = (b3 Or (2 ^ 7)) b4 = b4 \ 8 b(0) = b1 b(1) = b2 b(2) = b3 b(3) = b4 CopyMemory GetTagSize, b(0), 4 End Function Private Function ReadFlags(ByVal b As Byte) As String 'Funkcja zwraca flagi ID3 tag w skroconej formie tekstowej If (b And 255) > 0 Then ReadFlags = "U" Else ReadFlags = "-" End If If (b And 127) > 0 Then ReadFlags = ReadFlags & "X" Else ReadFlags = ReadFlags & "-" End If If (b And 63) > 0 Then ReadFlags = ReadFlags & "E" Else ReadFlags = ReadFlags & "-" End If End Function Private Function GetFrameSize(ByVal b1 As Byte, ByVal b2 As Byte, ByVal b3 As Byte, ByVal b4 As Byte) As Long Dim b(3) As Byte b(0) = b1 b(1) = b2 b(2) = b3 b(3) = b4 CopyMemory GetFrameSize, b(0), 4 End Function Private Function DisplayFrame(ByVal strID As String, ByRef btData() As Byte, ByVal btFlags2 As Byte) As String 'Funkcja zwraca informacje o ramce, dla uproszczenia tylko niektore 'Funkcja nie potrafi czytac informacji zaszyfrowanych i/lub skompresowanych Dim bCompressed As Boolean, bEncrypted As Boolean Dim strFlags As String strFlags = ReadFrameFlags(btFlags2, bCompressed, bEncrypted) If bCompressed Or bEncrypted Then DisplayFrame = "Frame " & strID & "(" & strFlags & ") is encrypted and/or compressed - cannot interpret." Else Select Case strID Case "TALB" DisplayFrame = "Album title: " & ReadFrameData(btData(), True) Case "TCOM" DisplayFrame = "Composer(s): " & ReadFrameData(btData(), True) Case "TCOP" DisplayFrame = "Copyright: Copyright (c) " & ReadFrameData(btData(), True) Case "TIT1" DisplayFrame = "Content group description: " & ReadFrameData(btData(), True) Case "TIT2" DisplayFrame = "Title: " & ReadFrameData(btData(), True) Case "TIT3" DisplayFrame = "Subtitle: " & ReadFrameData(btData(), True) Case "TPE1" DisplayFrame = "Lead artist: " & ReadFrameData(btData(), True) Case "WOAR" DisplayFrame = "Artist's web page: " & ReadFrameData(btData(), False) Case Else DisplayFrame = "Unrecognized frame : " & strID & " (" & strFlags & ")" End Select End If End Function Private Function ReadFrameFlags(ByVal btFlags2 As Byte, ByRef bCompressed As Boolean, ByRef bEncrypted As Boolean) As String If (btFlags2 And 255) > 0 Then ReadFrameFlags = "C" bCompressed = True Else ReadFrameFlags = "-" bCompressed = False End If If (btFlags2 And 127) > 0 Then ReadFrameFlags = ReadFrameFlags & "E" bEncrypted = True Else ReadFrameFlags = ReadFrameFlags & "-" bEncrypted = False End If End Function Private Function ReadFrameData(ByRef btData() As Byte, ByVal bHasEncoding As Boolean) As String 'Funkcja interpretuje dane w ramce Dim lDataSize As Long Dim lNextByte As Long Dim i As Long lDataSize = UBound(btData) If bHasEncoding Then 'Unicode? If btData(lNextByte) = 0 Then 'ISO-8859-1 ElseIf btData(lNextByte) = 1 Then 'Unicode - pominiety w tym przykladzie Exit Function Else Exit Function End If lNextByte = lNextByte + 1 End If 'Niektore ramki moga zawierac informacje o uzytym jezyku, ' wiecej niz jeden wiersz albo wiecej niz jeden napis; ' ta funkcja nie potrafi czytac zadnej z nich For i = lNextByte To lDataSize If btData(i) > 31 Then ReadFrameData = ReadFrameData & Chr$(btData(i)) ElseIf btData(i) = 0 Then Exit For End If Next i End Function Hmm, ktoś kto pisał te funkcje musiał być obeznany z MP3.... <-DoogiE-> |