Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0487: MP3 Header Daten auslesen

 von 

Beschreibung 

Mit diesem Beispiel kann man alle im Header einer MP3 angegebenen Daten auslesen. Dies sind z.B.
Bitrate, Länge, ...

Die Klasse wurde von Jörg Ohligschläger noch einmal komplett überarbeitet.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [5,43 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------ Anfang Projektdatei trMP3info.vbp  ------------
'--- Anfang Klasse "HeaderInfos" alias clsHeaderInfos.cls ---


'------------ Anfang Projektdatei trMP3info.vbp  ------------
'--- Anfang Klasse "HeaderInfos" alias clsHeaderInfos.cls ---
Option Explicit

Private anBitrateLookup(7, 15) As Integer
Private alFreqLookup(3, 7) As Long
Private avFrameRates(3)

'#####################################################################

Private m_sFilePath As String
Private m_lFileSize As Long
Private m_bytVersion As Byte
Private m_bytLayer As Byte
Private m_bCRCProtected As Boolean
Private m_lBitrate As Long
Private m_lFrequency As Long
Private m_bPadding As Boolean
Private m_bPrivateBit As Boolean
Private m_bytChannelMode As Byte
Private m_bytChannelModeExtention As Byte
Private m_bCopyright As Boolean
Private m_bOriginal As Boolean
Private m_bytEmphasis As Byte
Private m_sVersionText As String
Private m_sLayerText As String
Private m_sChannelModeText As String
Private m_sEmphasisText As String
Private m_lFrameSize As Long
Private m_lFrames As Long
Private m_lSeconds As Long
Private m_ID3V2 As Boolean
Private m_ID3V1 As Boolean
Private m_HeaderPosition As Long

'#####################################################################

Public Property Get FilePath() As String
  FilePath = m_sFilePath
End Property

Public Property Let FilePath(sValue As String)
  Call ZeroValues
  m_sFilePath = sValue
End Property

Public Property Get FileSize() As String
  FileSize = m_lFileSize
End Property

Public Property Get Version() As Byte
  Version = m_bytVersion
End Property

Public Property Get Layer() As Byte
  Layer = m_bytLayer
End Property

Public Property Get CRCProtected() As Boolean
  CRCProtected = m_bCRCProtected
End Property

Public Property Get Bitrate() As Long
  Bitrate = m_lBitrate
End Property

Public Property Get Frequency() As Long
  Frequency = m_lFrequency
End Property

Public Property Get Padding() As Boolean
  Padding = m_bPadding
End Property

Public Property Get PrivateBit() As Boolean
  PrivateBit = m_bPrivateBit
End Property

Public Property Get ChannelMode() As Byte
  ChannelMode = m_bytChannelMode
End Property

Public Property Get ChannelModeExtention() As Byte
  ChannelModeExtention = m_bytChannelModeExtention
End Property

Public Property Get Copyright() As Boolean
  Copyright = m_bCopyright
End Property

Public Property Get Original() As Boolean
  Original = m_bOriginal
End Property

Public Property Get Emphasis() As Byte
  Emphasis = m_bytEmphasis
End Property

Public Property Get VersionText() As String
  VersionText = m_sVersionText
End Property

Public Property Get LayerText() As String
  LayerText = m_sLayerText
End Property

Public Property Get ChannelModeText() As String
  ChannelModeText = m_sChannelModeText
End Property

Public Property Get EmphasisText() As String
  EmphasisText = m_sEmphasisText
End Property

Public Property Get FrameSize() As Long
  FrameSize = m_lFrameSize
End Property

Public Property Get Frames() As Long
  Frames = m_lFrames
End Property

Public Property Get Seconds() As Long
  Seconds = m_lSeconds
End Property

Public Property Get HeaderPosition() As Long
  HeaderPosition = m_HeaderPosition
End Property

Public Property Get ID3V1() As Boolean
  ID3V1 = m_ID3V1
End Property

Public Property Get ID3V2() As Boolean
  ID3V2 = m_ID3V2
End Property

'#####################################################################

Private Sub Class_Initialize()
  Dim asBitrateCore() As String, asFreqCore() As String
  Dim sBitrateData As String, sFreqData As String
  Dim nBitRate As Integer, nVerLayer As Integer, nFreq As Integer

  sBitrateData = "999,999,999,999,999,999," & _
                 "032,032,032,032,008,008," & _
                 "064,048,040,048,016,016," & _
                 "096,056,048,056,024,024," & _
                 "128,064,056,064,032,032," & _
                 "160,080,064,080,040,040," & _
                 "192,096,080,096,048,048," & _
                 "224,112,096,112,056,056," & _
                 "256,128,112,128,064,064," & _
                 "288,160,128,144,080,080," & _
                 "320,192,160,160,096,096," & _
                 "352,224,192,176,112,112," & _
                 "384,256,224,192,128,128," & _
                 "416,320,256,224,144,144," & _
                 "448,384,320,256,160,160," & _
                 "999,999,999,999,999,999"

  asBitrateCore = Split(sBitrateData, ",")

  For nBitRate = 1 To 14
    For nVerLayer = 0 To 2
      anBitrateLookup(7 - nVerLayer, nBitRate) = _
      Val(asBitrateCore((nBitRate * 6) + nVerLayer))
    Next
    For nVerLayer = 0 To 2
      anBitrateLookup(3 - nVerLayer, nBitRate) = _
      Val(asBitrateCore((nBitRate * 6) + 3 + nVerLayer))
    Next
  Next

  sFreqData = "44100,22050,11025," & _
              "48000,24000,12000," & _
              "32000,16000,08000," & _
              "99999,99999,99999"

  asFreqCore = Split(sFreqData, ",")

  For nFreq = 0 To 3
    alFreqLookup(3, nFreq) = Val(asFreqCore((nFreq * 3)))
    alFreqLookup(2, nFreq) = Val(asFreqCore((nFreq * 3) + 1))
    alFreqLookup(0, nFreq) = Val(asFreqCore((nFreq * 3) + 2))
  Next

  avFrameRates(0) = 38.5
  avFrameRates(1) = 32.5
  avFrameRates(2) = 27.8
  avFrameRates(3) = 0
End Sub

'#####################################################################

Private Sub ZeroValues()
  m_lFileSize = 0
  m_bytVersion = 0
  m_bytLayer = 0
  m_bCRCProtected = False
  m_lBitrate = 0
  m_lFrequency = 0
  m_bPadding = False
  m_bPrivateBit = False
  m_bytChannelMode = 0
  m_bytChannelModeExtention = 0
  m_bCopyright = False
  m_bOriginal = False
  m_bytEmphasis = 0
  m_sVersionText = ""
  m_sLayerText = ""
  m_sChannelModeText = ""
  m_sEmphasisText = ""
  m_lFrameSize = 0
  m_lFrames = 0
  m_lSeconds = 0
End Sub

Public Function GetFileInfos()
  Dim nFile As Integer
  Dim i As Long, z As Integer
  Dim sInput As String, sMP3bitsString As String
  Dim nBit1 As Integer, nBit2 As Integer
  Dim nBitD1 As Integer, nBitD2 As Integer
  Dim dSHIFT, LayerType, FrameSize
  Dim mp3_ID1, mp3_bitrate, mp3_protection, mp3_frequency
  Dim aBytes(3) As Byte
  Dim ID3V2Len As Long
  Dim sID3Len As String
  Dim ID3Position As Long
  Dim HDPos As Long
  
  m_ID3V2 = False
  GetFileInfos = -1
  If Not FileExists(m_sFilePath) Then Exit Function
  GetFileInfos = 0
  nFile = FreeFile
  Open m_sFilePath For Binary As #nFile
    Seek #nFile, LOF(nFile) - 127
    sInput = Input(128, #nFile)
    If Left(sInput, 3) = "TAG" Then
      m_ID3V1 = True
    End If
    Seek #nFile, 1
    
    'Einlesen der ersten vier Kilobytes um
    'den Header der Datei zu finden
    sInput = Input(8192, #nFile)
    
    'Wird für die Berechnung der Trackduration benötigt
    m_lFileSize = LOF(nFile)
    
    ' Ist ein ID3V2-Tag vorhanden?
    If Left$(sInput, 3) = "ID3" Then
      ID3Position = 1
      m_ID3V2 = True
    End If
    
    If ID3Position Then
      
      ' Bytes mit Längen-Info des Tags lesen
      sID3Len = Mid$(sInput, ID3Position + 6, 4)
      
      ' länge des Tags berechnen
      ID3V2Len = &H200000 * Asc(Left$(sID3Len, 1)) + _
        &H4000 * Asc(Mid$(sID3Len, 2, 1)) + _
        &H80 * Asc(Mid$(sID3Len, 3, 1)) + _
        Asc(Mid$(sID3Len, 4, 1))
      
      ' Tag überspringen
      Seek #nFile, ID3Position + ID3V2Len + 10
      
      'wird benötigt zur Berechnung der Headerposition
      HDPos = ID3Position + ID3V2Len + 10
      m_lFileSize = m_lFileSize - (ID3Position + ID3V2Len + 10)
      
      ' neuen Einlesen
      sInput = Input(8192, #nFile)
    End If
  Close #nFile
  

  i = 0
  Do Until i = 8191
ReEnter:
    i = i + 1
    nBit1 = Asc(Mid(sInput, i, 1))
    nBit2 = Asc(Mid(sInput, i + 1, 1))
    If nBit1 = &HFF And (nBit2 And &HE0) = &HE0 Then
      
      '20 HeadersBits auslesen - es sind die
      'letzen 20 Bits der nexten 3 Bytes
      sMP3bitsString = Mid(sInput, i + 1, 3)
      m_HeaderPosition = HDPos + i - 1
      Exit Do
    End If
    
    'Wir haben die Sync nicht gefunden, deshalb
    'verschieben wir das ganze um 4Bits nach links
    dSHIFT = ShiftBits(Mid(sInput, i, 3))
    nBitD1 = Asc(Left(dSHIFT, 1))
    nBitD2 = Asc(Right(dSHIFT, 1))
    
    If nBitD1 = &HFF And (nBitD2 And &HE0) = &HE0 Then
      '20 HeaderBits auslesen - es sind die
      'ersten 20 Bits der nexten 3 Bytes
      sMP3bitsString = Mid(sInput, i + 2, 3)
      m_HeaderPosition = HDPos + i - 1
      Exit Do
    End If
  Loop

  If i = 8191 Then Exit Function 'Header wurde nicht gefunden!
                                 ' -> beenden der Routine

  For z = 1 To 3
    aBytes(z) = Asc(Mid(sMP3bitsString, z))
  Next

  'Die ersten 20 Bits von sMP3bitsString sind die
  'Headerinformationen für diesen Frame
  '1te Bit: ID | 0 = MPEG-2 | 1 = MPEG-1
  m_bytVersion = (&H18 And aBytes(1)) / 8
  mp3_ID1 = (m_bytVersion And 1)
  
  'folgende 2 Bits sind der Layer
  m_bytLayer = (&H6 And aBytes(1)) / 2
  
  'folgendes Bit ist Protection
  mp3_protection = &H1 And aBytes(1)
  m_bCRCProtected = mp3_protection <> 0
  
  'folgende 4 Bits sind die Bitrate
  mp3_bitrate = (&HF0 And aBytes(2)) / 16
  LayerType = (mp3_ID1 * 4) Or m_bytLayer
  m_lBitrate = 1000 * CLng((anBitrateLookup(LayerType, mp3_bitrate)))
  
  'folgende 2 Bits sind die Frequenz
  mp3_frequency = (&HC And aBytes(2)) / 4
  m_lFrequency = alFreqLookup(m_bytVersion, mp3_frequency)
  If m_lFrequency = 99999 Or m_lFrequency = 0 Or m_lBitrate = 0 Then
    i = i + 4
    Goto ReEnter
  End If
  
  'folgendes Bit ist das Padding Bit
  m_bPadding = ((&H2 And aBytes(2)) / 2) = 1
  
  'folgendes Bit ist das Private Bit
  m_bPrivateBit = ((&H10 And aBytes(3)) / 2) = 1
  
  'folgende 2 Bit sind der Channel mode
  m_bytChannelMode = (&HC0 And aBytes(3)) / 64
  
  'folgende 2 Bits sind die Channel Mode Extention
  m_bytChannelModeExtention = (&H30 And aBytes(3)) / 16
  
  'folgendes Bit ist der Copyright Flag
  m_bCopyright = ((&H8 And aBytes(3)) / 8) = 1
  
  'folgendes Bit ist das Original Flag
  m_bOriginal = ((&H4 And aBytes(3)) / 4) = 1
  
  'folgendes Bit ist das Emphasis Flag
  m_bytEmphasis = &H3 And aBytes(3)

  Select Case m_bytVersion
    Case 0
      m_sVersionText = "MPEG-2.5"
    Case 1
    Case 2
      m_sVersionText = "MPEG-2.0"
    Case 3
      m_sVersionText = "MPEG-1.0"
  End Select

  Select Case m_bytLayer
    Case 1
      m_sLayerText = "Layer III"
      FrameSize = (144 * (m_lBitrate / m_lFrequency))
    Case 2
      m_sLayerText = "Layer II"
      FrameSize = (144 * (m_lBitrate / m_lFrequency))
    Case 3
      m_sLayerText = "Layer I"
      FrameSize = ((12 * (m_lBitrate / m_lFrequency) + _
      Abs(m_bPadding))) * 4
  End Select

  Select Case m_bytChannelMode
    Case 0
      m_sChannelModeText = "Stereo"
    Case 1
      m_sChannelModeText = "Joint Stereo (Stereo)"
      If m_bytVersion < 3 Then FrameSize = Fix(FrameSize) / 2
      If m_bytVersion = 0 Then FrameSize = Fix(FrameSize) / 2
    Case 2
      m_sChannelModeText = "Dual Channel (Stereo)"
    Case 3
      m_sChannelModeText = "Single Channel (Mono)"
      If m_bytVersion < 3 Then FrameSize = Fix(FrameSize) / 2
  End Select

  Select Case m_bytEmphasis
    Case 0
      m_sEmphasisText = "None"
    Case 1
      m_sEmphasisText = "50/15 ms"
    Case 2
      m_sEmphasisText = "reserved"
    Case 3
      m_sEmphasisText = "CIT J.17"
  End Select

  'Ausrechnen der Frameanzahl und der Spieldauer
  m_lFrameSize = Fix(FrameSize)
  m_lFrames = m_lFileSize / Fix(FrameSize)
  m_lSeconds = m_lFrames / avFrameRates(mp3_frequency)
End Function

Private Function ShiftBits(sInput As String) As String
  Dim nSD1, nSD2, nSD3, nDO1, nDO2 As Integer
  
  nSD1 = Asc(Left(sInput, 1))
  nSD2 = Asc(Mid(sInput, 2, 1))
  nSD3 = Asc(Right(sInput, 1))

  nDO1 = ((nSD1 And &HF) * 16) Or ((nSD2 And &HF0) / 16)
  nDO2 = ((nSD2 And &HF) * 16) Or ((nSD3 And &HF0) / 16)
  ShiftBits = Chr(nDO1) + Chr(nDO2)
End Function

Private Function FileExists(ByVal FileName As String) As Boolean
  On Error Resume Next
  FileExists = (GetAttr(FileName) >= vbNormal)
End Function




'---- Ende Klasse "HeaderInfos" alias clsHeaderInfos.cls ----
'------- Anfang Formular "frmMain" alias frmMain.frm  -------
' Steuerelement: Listen-Steuerelement "lstHeaderInfos"
' Steuerelement: Beschriftungsfeld "lblHeaderInfos"
Option Explicit

Private Sub Form_Load()
  Dim Header As New HeaderInfos
  
  Header.FilePath = "G:\Sound\Bon Jovi - It's My Life.mp3"
  Call Header.GetFileInfos

  Me.lstHeaderInfos.Clear
  Me.lstHeaderInfos.AddItem "FilePath: " & vbTab & vbTab & vbTab & Header.FilePath
  Me.lstHeaderInfos.AddItem "FileSize: " & vbTab & vbTab & vbTab & Header.FileSize
  Me.lstHeaderInfos.AddItem "Bitrate: " & vbTab & vbTab & vbTab & Header.Bitrate
  Me.lstHeaderInfos.AddItem "ChannelMode: " & vbTab & vbTab & Header.ChannelMode
  Me.lstHeaderInfos.AddItem "ChannelModeExtention: " & vbTab & Header.ChannelModeExtention
  Me.lstHeaderInfos.AddItem "ChannelModeText: " & vbTab & vbTab & Header.ChannelModeText
  Me.lstHeaderInfos.AddItem "Copyright: " & vbTab & vbTab & Header.Copyright
  Me.lstHeaderInfos.AddItem "CRCProtected: " & vbTab & vbTab & Header.CRCProtected
  Me.lstHeaderInfos.AddItem "Emphasis: " & vbTab & vbTab & Header.Emphasis
  Me.lstHeaderInfos.AddItem "EmphasisText: " & vbTab & vbTab & Header.EmphasisText
  Me.lstHeaderInfos.AddItem "Frames: " & vbTab & vbTab & vbTab & Header.Frames
  Me.lstHeaderInfos.AddItem "FrameSize: " & vbTab & vbTab & Header.FrameSize
  Me.lstHeaderInfos.AddItem "Frequency: " & vbTab & vbTab & Header.Frequency
  Me.lstHeaderInfos.AddItem "Layer: " & vbTab & vbTab & vbTab & Header.Layer
  Me.lstHeaderInfos.AddItem "LayerText: " & vbTab & vbTab & Header.LayerText
  Me.lstHeaderInfos.AddItem "Original: " & vbTab & vbTab & vbTab & Header.Original
  Me.lstHeaderInfos.AddItem "Padding: " & vbTab & vbTab & vbTab & Header.Padding
  Me.lstHeaderInfos.AddItem "PrivateBit: " & vbTab & vbTab & Header.PrivateBit
  Me.lstHeaderInfos.AddItem "Seconds: " & vbTab & vbTab & Header.Seconds
  Me.lstHeaderInfos.AddItem "Version: " & vbTab & vbTab & vbTab & Header.Version
  Me.lstHeaderInfos.AddItem "VersionText: " & vbTab & vbTab & Header.VersionText
End Sub

'-------- Ende Formular "frmMain" alias frmMain.frm  --------
'------------- Ende Projektdatei trMP3info.vbp  -------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 9 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Erich am 13.05.2009 um 10:47

Hm... Aktuell hab ich ein Problem, dass mir direcX sound, bei mp3 files die mit Lamedrop erzeugt wurden, eine völlig falsche Gesamtzeit (dS_GetDuration) sowie eine falsche Position (ds_GetPosition) zurück gibt.
Daher hab ich mal die mp3 Datei mit diesem Tool hier angeguckt.
Leider ist es auch hier so, dass die Gesamtzeit "Seconds: " & vbTab & vbTab & Header.Seconds... falsch ist. Das ganze hängt wohl irgendwie mit der kbs Rate zusammen, denn je nach rate, ergeben sich unterschiedliche zeiten.

Kann mir da vielleicht jemand weiter helfen, das währe sehr schön!
Ironischerweise zeigen Mediaplayer und CO die richtige gesamtzeit an.

Viele Grüße
Erich

Kommentar von Daniel Kreft am 06.10.2007 um 13:53

Der Grund für Abweichungen bei Bitrate, Framegröße, Spieldauer usw ist, das die Mp3-Dateien VBR (Variable Bit Rate) Komprimiert sind. Das heisst jedes Frame der Mp3 hat eine andere Bitrate. Bei Konstanten Bitraten stimmen die Daten.

Suche einen Code der genau das berücksichtigt. Also der jedes Frame der Mp3 nach der Bitrate untersucht. Hat jemand eine Idee oder ein Link für VB bzw. VB.Net?

Kommentar von Jörn Kretschmer am 20.10.2004 um 16:16

Hallo, ich bin jetzt nicht der Kenner von MP3-Headern, aber wozu ist die Verschiebung um 4 Bits nach links irgendwo in der Mitte des Codes da? Meines Wissens beginnt der Frame Sync immer am Anfang eines Bytes??? Kann da jemand Licht ins Dunkel bringen?

Vielen Dank.

Kommentar von ULTRA am 11.05.2003 um 15:43

Den split-Befehl gibt es erst ab VB 6.0
Enterprise edition. Also nicht bei der
Einsteigerversion.

Booh das Teil ist genial, genau so etwas
habe ich schon lange gesucht! Thumbs up!!

Kommentar von Tokoloshy am 14.12.2002 um 08:45

Hat jemand diesen Code auch für Java...?

Danke, Tokoloshy

Kommentar von Luckys am 20.11.2002 um 23:29

waarum die fehlermeldung mit "split"
fehlermeldung:"kan sub nicht finden??"
was mach ich nicht richtig???
Greatings aus Belgium

Kommentar von Ricardo am 25.10.2002 um 23:02

Das Beispiel funktioniert auch unter VBA für ACCESS 2000, was nicht immer der Fall ist. Allerdings konnte ich in Einzellfälle große Abweichungen bei bestimmten Channel-Modi bei der Bitrate und der Framegröße feststellen, was sich auch auf die davon abgeleiteten Größen auswirkt. Als Referenz habe ich die Anzeige von Winamp verwendet, die ich für ziemlich zuverläßig halte. Wenn ich Dir damit helfen kann, schicke ich Dir einen Beispiel-MP3, bei dem die Abweichungen auftretten. Hängt es vielleicht doch mit der Puffergröße zusammen (s. Mail vom 16.08.2002)
Viele Grüße, Ricardo

Kommentar von lastrebel am 02.08.2002 um 16:26

In diesem Beispiel wird nur der Header mit den Informationen der Datei ausgelesen. Die ID-Tags haben damit nichts zu tun, und werden auch nicht berücksichtigt. Sprich: Egal ob IDv1 oder IDv2 benutzt wird, es hat keine Auswirkung.
ciao, lastrebel.

Kommentar von Daxi am 26.06.2002 um 08:42

Hi!
Geht das nur mit den IDTags 1.0 oder auch mit den 2.0?
Bin an der Schule und kann so das Teil leider nicht ausprobieren.
Bitte um Antwort. Danke.
Daxi
http://daxis.de
info@daxis.de