Estrarre informazioni e TAG da un file MP3 con le sole funzioni di Gambas

Da Gambas-it.org - Wikipedia.

E' possibile estrarre informazioni generali e TAG da un file MP3 con le sole funzioni di Gambas.

Un esempio:

Private initium As Short


Public Sub Main()

 Dim fl, s, ver_mp3, layer, prot, medio, circa As String
 Dim j, frequenza, num_frame, brVar, totBR, durata1, durata2, durata As Integer
 Dim vB, lB, pB, brB, frB As Byte
 Dim secundum, tertium, bitrate, cpf As Short

 fl = "/percorso/del/file.mp3"
 
 Print "File audio mp3: '"; File.Name(fl)

 s = File.Load(fl)
 Print "\nDimensione: "; Len(s); " byte"
 Write "\e[5m\e[1mAttendere !\e[0m"
 Flush
 
 initium = 1
 
 For j = initium To Len(s) - 1

   If (Asc(s, j) = 255) And (Asc(s, j + 1) > 241) And (Asc(s, j + 2) > 15) Then

   secundum = Asc(s, j + 1)
   tertium = Asc(s, j + 2)

' Individua 2° byte dell'header per estrarre le seguenti informazioni generali sul file mp3:
' - vesione MPEG;
' - layer;
' - protezione.
' I primi 3 bit più significativi (tutti posti a 1) appartengono con quelli del 1° byte all'identificazione dell'header.
 
' Viene individuata la versione del file mp3:
   vB = Asc(s, j + 1) And 24
   Select Case vB
     Case 0
       ver_mp3 = "2.5"
     Case 16
       ver_mp3 = "2"
     Case 24
       ver_mp3 = "1"
   End Select


' Viene individuato il "Layer" del file mp3:
   lB = Asc(s, j + 1) And 6
   Select Case lB
     Case 2
       layer = "III"
     Case 4
       layer = "II"
     Case 6
       layer = "I"
   End Select
   

' Viene verificata la Protezione:
   pB = Asc(s, j + 1) And 1
   Select Case pB
     Case 0
       prot = "Non protetto"
     Case 1
       prot = "Protetto"
   End Select
   
   Write "\rVersione MPEG = " & ver_mp3 & "   Layer = " & layer & "   Protezione CRC = " & prot


' Si analizza, quindi, il terzo byte per estrarre le seguenti informazioni generali sul file mp3:
' - bitrate;
' - frequenza di campionamento;
' Tali informazioni sono condizionate dalla versione e dal layer del file MPEG.
   brB = Asc(s, j + 2) And 240
   bitrate = EstraeBitRate(ver_mp3, layer, brB)

   frB = Asc(s, j + 2) And 12
   frequenza = EstraeFrequenza(ver_mp3, frB)

     Exit

   Endif

 Next


   For j = 1 To Len(s) - 2
     If (Asc(s, j) = 255) And (Asc(s, j + 1) = secundum) Then Inc num_frame
     If (Asc(s, j) = 255) And (Asc(s, j + 1) = secundum) And (Asc(s, j + 2) <> tertium) Then
       Inc brVar
       brB = Asc(s, j + 2) And 240
       totBR += EstraeBitRate(ver_mp3, layer, brB)
     Endif
   Next


   If brVar > num_frame * 0.1 Then

     Select Case layer
       Case "I"
         cpf = 384
       Case "II"
         cpf = 1152
       Case "III"
         If ver_mp3 = "1" Then
           cpf = 1152
         Else
           cpf = 576
         Endif
     End Select
     durata1 = Fix((num_frame * cpf / frequenza) * 1000)
     bitrate = totBR / brVar
     durata2 = Fix((Len(s) / bitrate) * 8)
     durata = (durata1 + durata2) / 2
     medio = "variabile medio "
     circa = "circa "
   Else
     durata = Fix((Len(s) / bitrate) * 8)

   Endif

   Print "\nBitRate " & medio & "= "; bitrate
   Print "Frequenza = hz "; frequenza
   Print "Durata " & circa & "= "; Time(0, 0, 0, durata)
 
   Print "\n== T A G =="
   EstraeTag(s)

End



Private Function EstraeBitRate(Vmpeg As String, layB As String, bitB As Byte) As Short
 
   Dim velCamp As Short
 
   If Vmpeg = "1" Then   ' Nel caso di Mpeg vers. 1
   
     Select Case layB   ' Verifica il Layer
       Case "I"
         Select Case bitB
           Case 16
             velCamp = 32
           Case 32
             velCamp = 64
           Case 48
             velCamp = 96
           Case 64
             velCamp = 128
           Case 80
             velCamp = 160
           Case 96
             velCamp = 192
           Case 112
             velCamp = 224
           Case 128
             velCamp = 256
           Case 144
             velCamp = 288
           Case 160
             velCamp = 320
           Case 176
             velCamp = 352
           Case 192
             velCamp = 384
           Case 208
             velCamp = 416
           Case 224
             velCamp = 448
         End Select
       Case "II"
         Select Case bitB
           Case 16
             velCamp = 32
           Case 32
             velCamp = 48
           Case 48
             velCamp = 56
           Case 64
             velCamp = 64
           Case 80
             velCamp = 80
           Case 96
             velCamp = 96
           Case 112
             velCamp = 112
           Case 128
             velCamp = 128
           Case 144
             velCamp = 160
           Case 160
             velCamp = 192
           Case 176
             velCamp = 224
           Case 192
             velCamp = 256
           Case 208
             velCamp = 320
           Case 224
             velCamp = 384
         End Select
       Case "III"
         Select Case bitB
           Case 16
             velCamp = 32
           Case 32
             velCamp = 40
           Case 48
             velCamp = 48
           Case 64
             velCamp = 56
           Case 80
             velCamp = 64
           Case 96
             velCamp = 80
           Case 112
             velCamp = 96
           Case 128
             velCamp = 112
           Case 144
             velCamp = 128
           Case 160
             velCamp = 160
           Case 176
             velCamp = 192
           Case 192
             velCamp = 224
           Case 208
             velCamp = 256
           Case 224
             velCamp = 320
         End Select
     End Select
     
   Else
     
     Select Case layB    ' Verifica il Layer
       Case "I"
         Select Case bitB
           Case 16
             velCamp = 32
           Case 32
             velCamp = 48
           Case 48
             velCamp = 56
           Case 64
             velCamp = 64
           Case 80
             velCamp = 80
           Case 96
             velCamp = 96
           Case 112
             velCamp = 112
           Case 128
             velCamp = 128
           Case 144
             velCamp = 144
           Case 160
             velCamp = 160
           Case 176
             velCamp = 176
           Case 192
             velCamp = 192
           Case 208
             velCamp = 224
           Case 224
             velCamp = 256
         End Select
       Case "II" To "III"
         Select Case bitB
           Case 16
             velCamp = 8
           Case 32
             velCamp = 16
           Case 48
             velCamp = 24
           Case 64
             velCamp = 32
           Case 80
             velCamp = 40
           Case 96
             velCamp = 48
           Case 112
             velCamp = 56
           Case 128
             velCamp = 64
           Case 144
             velCamp = 80
           Case 160
             velCamp = 96
           Case 176
             velCamp = 112
           Case 192
             velCamp = 128
           Case 208
             velCamp = 144
           Case 224
             velCamp = 320
         End Select
     End Select
     
   Endif
   
   Return velCamp
 
End


Private Function EstraeFrequenza(Vmpeg As String, fre As Byte) As Integer
 
 Dim frq As Integer
 
 
   Select Case Vmpeg
     Case "1"         '  Nel caso di Mpeg vers. 1
       Select Case fre
         Case 0
           frq = 44100
         Case 4
           frq = 48000
         Case 8
           frq = 32000
       End Select
     Case "2"         ' Nel caso di Mpeg vers. 2
       Select Case fre
         Case 0
           frq = 22050
         Case 4
           frq = 24000
         Case 8
           frq = 16000
       End Select
     Case "2.5"       ' Nel caso di Mpeg vers. 2.5
       Select Case fre
         Case 0
           frq = 11025
         Case 4
           frq = 12000
         Case 8
           frq = 8000
       End Select
   End Select

   Return frq
   
End


Private Procedure EstraeTag(s As String)

' Sono impostati alcuni TAG (ovviamente alla seguente lista possono essere aggiunti altri di quelli previsti):
 Dim tag As String[] = ["TALB", "TCOM", "TCOP", "TDAT", "TDEN", "TDLY", "TDRC", "TENC", "TFLP", "TIT1", 
                        "TIT2", "TIT3", "TKEY", "TLAN", "TLEN", "TMCL", "TMED", "TOAL", "TOFN", "TOLY",
                        "TOPE", "TORY", "TOWN", "TPE1", "TPE2", "TPE3", "TPE4", "TPUB", "TCON", "TDRC",
                        "TRCK", "TRDA", "TRSN", "TRSO", "TSRC", "TSSE", "TYER", "COMM", "WXXX", "TXXX",
                        "PRIV"]
 Dim t As String
 Dim d, i As Integer
 
' Cerca i TAG nel file mp3:
 d = Len(s)
 For Each t In tag
   i = InStr(s, t)
   If i > 0 Then d = Min(i, d)
 Next
 
 While tag.Find(Mid(s, d, 4)) > -1
' Evita di prendere in considerazione eventuali falsi TAG:
   If Asc(Mid(s, d + 4, 1)) > 0 Then 
     d += 4
     Continue 
   Endif
' Memorizza i 4 caratteri-byte dopo il nome del TAG che indicano la lunghezza del testo:
   t = Mid(s, d + 4, 4)
' Ottiene il valore numerico di tipo Intero, tenendo conto che il valore è rappresentato in "Big-Endian":
   i = Asc(t, 1) * 16777216   ' &01000000
   i += Asc(t, 2) * 65536      ' &010000
   i += Asc(t, 3) * 256        ' &0100
   i += Asc(t, 4) 
   Print "\e[1m"; s[d - 1, 4]; "\e[0m", Replace(Mid(s, d + 11, i - 1), Chr(&00), Chr(&20))
   d += 10 + i
 Wend 
 
 If InStr(s, "APIC") Then Print "\e[1m"; "APIC\e[0m  \e[31m(Il file contiene anche anche dati immagine)\e[0m"
 If i == 0 Then Print "TAG assenti !"

End


Riferimenti