[VB6] Rilevare bitrate mp3

**MdE2005** · 03-03-2006, 10:31

Ciao..ti posto un codice che ti mostra molte altre proprietà di un mp3: specifico che l'esempio lo scaricai molto tempo fa e l'autore è Matteo Freddi.
Inserisci in un modulo questo:

codice:

'Autore: Matteo Freddi
'per informazioni, contattatemi a mattytr@tiscalinet.it
'se usate questo codice nei vostri programmi, gradirei essere ricordato.
'
'Le informazioni che ho utilizzato sono dipsonibili a questi indirizzi
'http://www.dv.co.yu/mpgscript/mpeghdr.htm
'http://www.mp3-tech.org/


Type Mp3Header
   MpegVer As Byte
   Layer As Byte
   CRC As Byte '0=presente
   BitRate As Integer
   Frames As Long
   Sample As Long
   ChannelMode As String
   CopyRight As Byte
   Original As Byte
   ByteLen As Long
End Type

Type Mp3Info
   FileLength As Long
   MpegVer As Byte
   Layer As Byte
   CRC As Byte '0=presente
   BitRate As Integer
   Frames As Long
   CBR As Boolean
   Sample As Long
   ChannelMode As Byte 'per informazioni testuali, richiamare la funzione ChannelMode
   CopyRight As Byte
   Original As Byte
   Sec As Integer
   ID3 As Boolean
   Titolo As String '* 30
   Autore As String '* 30
   Album As String '* 30
   Anno As String '* 4
   Commento As String '* 29
   Traccia As Byte
   Genere As Byte
End Type

Const BitSum As Byte = 2 ^ 7 + 2 ^ 6 + 2 ^ 5 + 2 ^ 4
Dim FFile As Byte

Sub ReadID3(Mp3 As Mp3Info)
Dim lf As Long
Dim TAG As String * 3
Dim TmpS As String

' Prendo la lunghezza del file e ci sottraggo 127 per potermi posizionare al punto giusto del file
If Mp3.FileLength < 128 Then Exit Sub

' controllo che esistano le info ID3
lf = Mp3.FileLength - 127
Seek #FFile, lf
Get #FFile, , TAG
If TAG <> "TAG" Then Exit Sub

' Il tag ID3 esiste e quindi carico i dati
TmpS = Space(30)
Get #FFile, , TmpS
Mp3.Titolo = DeleteZero(TmpS)

TmpS = Space(30)
Get #FFile, , TmpS
Mp3.Autore = DeleteZero(TmpS)

TmpS = Space(30)
Get #FFile, , TmpS
Mp3.Album = DeleteZero(TmpS)

TmpS = Space(4)
Get #FFile, , TmpS
Mp3.Anno = DeleteZero(TmpS)

TmpS = Space(29)
Get #FFile, , TmpS
Mp3.Commento = DeleteZero(TmpS)

Get #FFile, , Mp3.Traccia

Get #FFile, , Mp3.Genere

Mp3.ID3 = True
End Sub
Function DeleteZero(S As String) As String
Dim k As Integer

k = InStr(1, S, Chr(0))
If k <> 0 Then
   DeleteZero = Left(S, k - 1)
Else
   DeleteZero = S
End If
DeleteZero = Trim(DeleteZero)
End Function

Function AnalyzeMp3(Filename As String, Mp3 As Mp3Info) As Byte
Dim TmpS As String * 4096 'buffer di 4 KB
Dim StartHeader As Long 'inizio relativo del primo frame
Dim ReadPos As Long 'posizione di lettura del buffer
Dim FrameStart As Long 'posizione di inizio del frame corrente
Dim FileStart As Long 'posizione assoluta di inzio del primo frame
Dim TmpB(3) As Byte 'lettura 4 byte header mp3
Dim Mp3Frame(9) As Mp3Header 'i primi 10 frame
Dim j As Integer

If Dir(Filename) = "" Or Trim(Filename) = "" Then Exit Function
FFile = FreeFile
Open Filename For Binary Access Read As #FFile

StartHeader = 0
ReadPos = 1
Mp3.FileLength = LOF(FFile)
Do While StartHeader = 0 And ReadPos + 4096 < Mp3.FileLength
   Get #FFile, ReadPos, TmpS
   
   StartHeader = 0
   Do While True
      StartHeader = InStr(StartHeader + 1, TmpS, Chr(255))
      DoEvents
      
      If StartHeader <> 0 Then
         FrameStart = ReadPos + StartHeader - 1
         For j = 0 To 9
            Get #FFile, FrameStart, TmpB
            If AnFrame(TmpB, Mp3Frame(j)) = 0 Then Exit For
            FrameStart = FrameStart + Mp3Frame(j).ByteLen
         Next j
         If j = 10 Then Exit Do
      Else
         Exit Do
      End If
   Loop
   ReadPos = ReadPos + 4096
Loop
FileStart = ReadPos - 4097 + StartHeader

If StartHeader = 0 Then
   'errore
   Close #FFile
   Exit Function
End If

'il file è valido! (o perlomeno si spera lo sia, dopo 10 frame validi!)
'queste informazioni sono uguali per tutti i frame.
Mp3.ChannelMode = Mp3Frame(0).ChannelMode
Mp3.Layer = Mp3Frame(0).Layer
Mp3.MpegVer = Mp3Frame(0).MpegVer
Mp3.CopyRight = Mp3Frame(0).CopyRight
Mp3.Sample = Mp3Frame(0).Sample
Mp3.Original = Mp3Frame(0).Original
Mp3.CBR = False

'ricerca info VBR
If FindXing(FileStart, Mp3) = 0 Then
   'se non ci sono controllo che il file sia CBR
   For j = 1 To 9
      If Mp3Frame(j).BitRate <> Mp3Frame(j - 1).BitRate Then Exit For
   Next j
   If j <> 10 Then
      'nonostante non ci siano le info, il file è VBR e quindi calcolo il bitrate frame per frame
      ScanFile FileStart, Mp3
   Else
      'il file è CBR
      Mp3.BitRate = Mp3Frame(0).BitRate
      Mp3.Sec = ((Mp3.FileLength - (FileStart - 1)) / 1000) / (Mp3.BitRate / 8)
      Mp3.CBR = True
      If Mp3.Layer = 1 Then
         Mp3.Frames = Mp3.Sec / 384 * Mp3.Sample 'stimato
      Else
         Mp3.Frames = Mp3.Sec / 1152 * Mp3.Sample 'stimato
      End If
   End If
End If

'ricerca id3
ReadID3 Mp3
Close #FFile

'la funzione ritorna correttamente
AnalyzeMp3 = 1
End Function

Function AnFrame(Tmp() As Byte, Mp3 As Mp3Header) As Byte
Dim Padding As Byte

If Tmp(0) And 255 <> 255 Then Exit Function
If Tmp(1) And BitSum <> BitSum Then Exit Function

If (Tmp(1) And 8) = 8 Then
   Mp3.MpegVer = 1
Else
   Mp3.MpegVer = 2
End If

Mp3.Layer = 4 - (Tmp(1) And (2 ^ 2 + 2)) / 2
If Mp3.Layer = 4 Then Exit Function
Mp3.CRC = Tmp(1) And 1
Mp3.BitRate = BitRate(Tmp(2) And BitSum, Mp3.Layer, Mp3.MpegVer)
If Mp3.BitRate = 0 Then Exit Function
Mp3.Sample = Sample(Tmp(2) And (2 ^ 3 + 2 ^ 2), Mp3.MpegVer)
If Mp3.Sample = 0 Then Exit Function
Padding = (Tmp(2) And 2) / 2
Mp3.ChannelMode = (Tmp(3) And (2 ^ 7 + 2 ^ 6)) / 2 ^ 6
Mp3.CopyRight = (Tmp(3) And 2 ^ 3) / 2 ^ 3
Mp3.Original = (Tmp(3) And 2 ^ 2) / 2 ^ 2

If Mp3.Layer = 1 Then
   Mp3.ByteLen = ((12 * CLng(Mp3.BitRate) * 1000) \ Mp3.Sample + Padding) * 4 '+ Mp3.CRC * 2
Else
   Mp3.ByteLen = (144 * CLng(Mp3.BitRate) * 1000) \ Mp3.Sample + Padding '+ Mp3.CRC * 2
End If

AnFrame = 1
End Function

Function BitRate(Num As Byte, Layer As Byte, Mpeg As Byte) As Integer
Dim CF As Variant

If Mpeg = 1 And Layer = 1 Then
   CF = Array(0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448, 0)
ElseIf Mpeg = 1 And Layer = 2 Then
   CF = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384, 0)
ElseIf Mpeg = 1 And Layer = 3 Then
   CF = Array(0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 0)
ElseIf Mpeg = 2 And Layer = 1 Then
   CF = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256, 0)
ElseIf Mpeg = 2 And (Layer = 2 Or Layer = 3) Then
   CF = Array(0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160, 0)
End If

BitRate = CF(Num / 16)
End Function

Function Sample(Num As Byte, Mpeg As Byte) As Long
Dim CF As Variant

CF = Array(44100, 48000, 32000, 0)
Sample = (CF(Num / 4)) / Mpeg
End Function

Function ChannelMode(Num As Byte) As String
Dim CF As Variant

CF = Array("Stereo", "Joint Stereo", "Dual channel", "Mono")
ChannelMode = CF(Num)
End Function

Function FindXing(ByVal Start As Long, Mp3 As Mp3Info) As Byte
Dim TmpS As String * 4
Dim Flags As Byte
Dim Frames As Integer
Dim Filelenght As Long
Dim Tmp(3) As Byte

If Mp3.MpegVer = 1 Then
   Start = Start + 36
Else
   Start = Start + 21
End If

Get #FFile, Start, TmpS
If TmpS <> "Xing" Then Exit Function
Get #FFile, Start + 7, Flags

If Flags And 1 = 0 Or Flags And 2 = 0 Then Exit Function

Get #FFile, Start + 8, Tmp
Mp3.Frames = ComposeLong(Tmp)
Get #FFile, Start + 12, Tmp
Filelenght = ComposeLong(Tmp)

If Mp3.Layer = 1 Then
   Mp3.Sec = Mp3.Frames * 384 / Mp3.Sample
Else
   Mp3.Sec = Mp3.Frames * 1152 / Mp3.Sample
End If
Mp3.BitRate = (Filelenght * 8 / 1000) / Mp3.Sec

FindXing = 1
End Function

Function ComposeLong(Tmp() As Byte) As Long
    ComposeLong = CLng(Tmp(3)) + CLng(Tmp(2)) * 255 + CLng(Tmp(1)) * 65535 + CLng(Tmp(0)) * 16777215
End Function

Sub ScanFile(ByVal Start As Long, Mp3 As Mp3Info)
Dim Mp3Head As Mp3Header
Dim Pos As Long
Dim Tmp(3) As Byte
Dim TempBitrate As Long

Do While Start + 4 < Mp3.FileLength
   Get #FFile, Start, Tmp
   If AnFrame(Tmp, Mp3Head) = 0 Then Exit Do
   
   Start = Start + Mp3Head.ByteLen
   
   Mp3.Frames = Mp3.Frames + 1
   TempBitrate = TempBitrate + Mp3Head.BitRate
Loop

If Mp3.Layer = 1 Then
   Mp3.Sec = Mp3.Frames * 384 / Mp3.Sample
Else
   Mp3.Sec = Mp3.Frames * 1152 / Mp3.Sample
End If

Mp3.BitRate = TempBitrate / Mp3.Frames

End Sub

Inserisci in un form una textbox dove inserisci il percorso e il nome del file mp3 da analizzare chiamata "txtfile" e una textbox denominata "txtinfo" con proprietà multiline = true e un commandbutton chiamato "cmdAnalyze":

codice:

Option Explicit
Dim ACapo As String

Private Sub ShowInfo(Mp3 As Mp3Info)
Dim S As String

S = "Versione Mpeg: " & Mp3.MpegVer & ACapo
S = S & "Layer: " & Mp3.Layer & ACapo
S = S & "CRC: " & CStr(1 - Mp3.CRC) & ACapo
S = S & "BitRate: " & Mp3.BitRate & ACapo
S = S & "CBR: " & Mp3.CBR & ACapo
S = S & "Frames: " & Mp3.Frames & ACapo
S = S & "Sample: " & Mp3.Sample & ACapo
S = S & "ChannelMode: " & Mp3.ChannelMode & ACapo
S = S & "CopyRight: " & Mp3.CopyRight & ACapo
S = S & "Original: " & Mp3.Original & ACapo
S = S & "Durata: " & Mp3.Sec '& ACapo

If Mp3.ID3 = True Then
   S = S & ACapo & "Titolo: " & Mp3.Titolo & ACapo
   S = S & "Autore: " & Mp3.Autore & ACapo
   S = S & "Album: " & Mp3.Album & ACapo
   S = S & "Anno: " & Mp3.Anno & ACapo
   S = S & "Commento: " & Mp3.Commento & ACapo
   S = S & "Traccia: " & Mp3.Traccia & ACapo
   S = S & "Genere: " & Mp3.Genere
End If

txtInfo.Text = S
End Sub

Private Sub cmdAnalyze_Click()
Dim Mp3 As Mp3Info
Dim Filename As String

Filename = txtFile.Text
If Dir(Filename) = "" Or Trim(Filename) = "" Then
   txtInfo.Text = "File non esistente"
   Exit Sub
End If

If AnalyzeMp3(txtFile.Text, Mp3) = 1 Then
   ShowInfo Mp3
Else
   txtInfo.Text = "File non valido"
End If

End Sub


Private Sub Form_Load()
ACapo = Chr(13) & Chr(10)
End Sub

Private Sub txtFile_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 13 Then cmdAnalyze_Click

End Sub

Ciao

Discussione: [VB6] Rilevare bitrate mp3

Strumenti discussione

Ricerca discussione

Visualizza

Visualizzazione discussione

Permessi di invio