Tipp 0106 MP3-Tags lesen und schreiben
Autor/Einsender:
Datum:
  Detlev Schubert
27.07.2001
Entwicklungsumgebung:   VB 6
Was in vielen Foren für unmöglich gehalten wird, ist hier Realität. Mit diesem sehr ausführlichen Tipp lässt sich nicht nur der komplette ID3-Tag einer MP3-Datei auslesen, sondern auch neu beschreiben, bzw. ändern. Weiterhin ist es auch möglich, alle wichtigen Informationen der MP3 Datei zu lesen. 
Hinweis
Da in diesem Beispiel einige Funktionen wie z.B. Split verwendet werden, die erst mit VB6 zur Verfügung stehen, ist der Code sowie das Download-Projekt auch erst ab VB 6 lauffähig.
Code im Codebereich des Moduls
 
Global filename As String
Public actual_bitrate As Long

Public Type Id3
  Title As String * 30
  Artist As String * 30
  Album As String * 30
  sYear As String * 4
  Comments As String * 30
  Genre As Byte
End Type

Type MP3Info
  Bitrate As Integer
  Frequency As Long
  Mode As String
  Emphasis As String
  MpegVersion As Integer
  MpegLayer As Integer
  Padding As String
  CRC As String
  Duration As Long
  CopyRight As String
  Original As String
  PrivateBit As String
  VBR As Boolean
  Frames As Integer
End Type

Public GetMP3Info As MP3Info
Public id3Info As Id3
Public GenreArray() As String

Public Const sGenreMatrix = "Blues|Classic Rock|Country|" + _
"Dance|Disco|Funk|Grunge|Hip-Hop|Jazz|Metal|New Age|Oldies|" + _
"Other|Pop|R&B|Rap|Reggae|Rock|Techno|Industrial|" + _
"Alternative|Ska|Death Metal|Pranks|Soundtrack|Euro-Techno|" + _
"Ambient|Trip Hop|Vocal|Jazz+Funk|Fusion|Trance|Classical|" + _
"Instrumental|Acid|House|Game|Sound Clip|Gospel|Noise|" + _
"Alt. Rock|Bass|Soul|Punk|Space|Meditative|Instrumental Pop|" + _
"Instrumental Rock|Ethnic|Gothic|Darkwave|Techno-Industrial|" + _
"Electronic|Pop-Folk|Eurodance|Dream|Southern Rock|Comedy|" + _
"Cult|Gangsta Rap|Top 40|Christian Rap|Pop/Punk|Jungle|" + _
"Native American|Cabaret|New Wave|Phychedelic|Rave|Showtunes|" + _
"Trailer|Lo-Fi|Tribal|Acid Punk|Acid Jazz|Polka|Retro|" + _
"Musical|Rock & Roll|Hard Rock|Folk|Folk/Rock|National Folk|" + _
"Swing|Fast-Fusion|Bebob|Latin|Revival|Celtic|Blue Grass|" + _
"Avantegarde|Gothic Rock|Progressive Rock|Psychedelic Rock|" + _
"Symphonic Rock|Slow Rock|Big Band|Chorus|Easy Listening|" + _
"Acoustic|Humour|Speech|Chanson|Opera|Chamber Music|Sonata|" + _
"Symphony|Booty Bass|Primus|Porn Groove|Satire|Slow Jam|" + _
"Club|Tango|Samba|Folklore|Ballad|power Ballad|Rhythmic Soul|" + _
"Freestyle|Duet|Punk Rock|Drum Solo|A Capella|Euro-House|" + _
"Dance Hall|Goa|Drum & Bass|Club-House|Hardcore|Terror|indie|" + _
"Brit Pop|Negerpunk|Polsk Punk|Beat|Christian Gangsta Rap|" + _
"Heavy Metal|Black Metal|Crossover|Comteporary Christian|" + _
"Christian Rock|Merengue|Salsa|Trash Metal|Anime|JPop|Synth Pop"

Public Function GetId3(filename As String)
  Dim Tag As String * 3

  If filename = "" Then Exit Function
  If filename = "*.mp3" Then Exit Function
  Open filename For Binary As #1
  Get #1, FileLen(filename) - 127, Tag
  If Tag = "TAG" Then
    Get #1, FileLen(filename) - 124, id3Info
  Else
    MsgBox "Diese MP3-Datei besitzt keinen ID3-Tag", _
        vbInformation, "MP3-Info"
  End If
  Close #1
End Function

Public Function SaveId3(filename As String, MP3Info As Id3)
  Dim Tag As String * 3

  If filename = "" Then Exit Function
  On Error GoTo ErrHandle

  Open filename For Binary As #1
  Get #1, FileLen(filename) - 127, Tag

  If Tag = "TAG" Then
    Put #1, FileLen(filename) - 124, MP3Info
  Else
    Put #1, FileLen(filename) - 127, "TAG"
    Close #1
    SaveId3 filename, MP3Info
  End If
  Close #1

ErrHandle:
  If Err.Number = 75 Then
    MsgBox "Datei ist schreibgeschützt.", vbExclamation, _
        "MP3-Info"
    Close #1
  Else
    If Err.Description = "" Then
      Close #1
    Else
      MsgBox "Fehler: " & Err.Description, vbCritical, "MP3-Info"
      Close #1
    End If
  End If
End Function

Public Function BinToDec(BinValue As String) As Long
  Dim i As Integer
  BinToDec = 0

  For i = 1 To Len(BinValue)
    If Mid(BinValue, i, 1) = 1 Then
      BinToDec = BinToDec + 2 ^ (Len(BinValue) - i)
    End If
  Next i
End Function

Public Function ByteToBit(ByteArray) As String
  Dim i As Integer, z As Integer
  ByteToBit = ""

  For z = 1 To 4
    For i = 7 To 0 Step -1
      If Int(ByteArray(z) / (2 ^ i)) = 1 Then
        ByteToBit = ByteToBit & "1"
        ByteArray(z) = ByteArray(z) - (2 ^ i)
      Else
        If ByteToBit <> "" Then
          ByteToBit = ByteToBit & "0"
        End If
      End If
    Next i
  Next z
End Function

Public Function BinaryHeader(filename As String) As String
  Dim ByteArray(4) As Byte
  Dim XingH As String * 4
  Dim FIO As Integer, n As Long
  Dim i As Integer, x As Byte
  Dim z As Integer

  If filename = "" Then Exit Function
  FIO% = FreeFile
  Open filename For Binary Access Read As FIO%
  n& = LOF(FIO%): If n& < 256 Then Close FIO%: Return

  For i = 1 To 5000
    Get #FIO%, i, x
    If x = 255 Then
      Get #FIO%, i + 1, x
      If x > 249 And x < 252 Then
        Headstart = i
        Exit For
      End If
    End If
  Next i

  Get #1, Headstart + 36, XingH
  If XingH = "Xing" Then
    GetMP3Info.VBR = True
    For z = 1 To 4 '
      Get #1, Headstart + 43 + z, ByteArray(z)
    Next z
    Frames = BinToDec(ByteToBit(ByteArray))
    GetMP3Info.Frames = Frames
  Else
    GetMP3Info.VBR = False
  End If

  For z = 1 To 4
    Get #1, Headstart + z - 1, ByteArray(z)
  Next z
  Close FIO%
  BinaryHeader = ByteToBit(ByteArray)
End Function

Public Function ReadMP3(filename As String) As MP3Info

  If filename = "" Then Exit Function
  bin = BinaryHeader(filename)
  Version = Array(25, 0, 2, 1)
  MpegVersion = Version(BinToDec(Mid(bin, 12, 2)))
  Layer = Array(0, 3, 2, 1)
  MpegLayer = Layer(BinToDec(Mid(bin, 14, 2)))
  SMode = Array("Stereo", "Joint stereo", "Zwei-Kanal", _
                "Ein-Kanal")
  Mode = SMode(BinToDec(Mid(bin, 25, 2)))
  Emph = Array("no", "50/15", "reserviert", "CCITT J 17")
  Emphasis = Emph(BinToDec(Mid(bin, 31, 2)))

  Select Case MpegVersion
    Case 1
      Freq = Array(44100, 48000, 32000)
    Case 2 Or 25
      Freq = Array(22050, 24000, 16000)
    Case Else
      Frequency = 0
      Exit Function
  End Select

  Frequency = Freq(BinToDec(Mid(bin, 21, 2)))
  If GetMP3Info.VBR = True Then
    Temp = Array(, 12, 144, 144)
    Bitrate = (FileLen(filename) * Frequency) / _
              (Int(GetMP3Info.Frames)) / 1000 / Temp(MpegLayer)
  Else

    Dim LayerVersion As String
    LayerVersion = MpegVersion & MpegLayer

    Select Case Val(LayerVersion)
      Case 11
        Brate = Array(0, 32, 64, 96, 128, 160, 192, 224, 256, _
                      288, 320, 352, 384, 416, 448)
      Case 12
        Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 160, _
                      192, 224, 256, 320, 384)
      Case 13
        Brate = Array(0, 32, 40, 48, 56, 64, 80, 96, 112, 128, _
                      160, 192, 224, 256, 320)
      Case 21 Or 251
        Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 144, _
                      160, 176, 192, 224, 256)
      Case 22 Or 252 Or 23 Or 253
        Brate = Array(0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, _
                      112, 128, 144, 160)
      Case Else
        Bitrate = 1
        Exit Function
    End Select

    Bitrate = Brate(BinToDec(Mid(bin, 17, 4)))
  End If

  NoYes = Array("Nein", "Ja")
  Original = NoYes(Mid(bin, 30, 1))
  CopyRight = NoYes(Mid(bin, 29, 1))
  Padding = NoYes(Mid(bin, 23, 1))
  PrivateBit = NoYes(Mid(bin, 24, 1))
  YesNo = Array("yes", "no")
  CRC = YesNo(Mid(bin, 16, 1))
  ms = (FileLen(filename) * 8) / Bitrate
  Duration = Int(ms / 1000)

  With GetMP3Info
    .Bitrate = Bitrate
    .CRC = CRC
    .Duration = Duration
    .Emphasis = Emphasis
    .Frequency = Frequency
    .Mode = Mode
    .MpegLayer = MpegLayer
    .MpegVersion = MpegVersion
    .Padding = Padding
    .Original = Original
    .CopyRight = CopyRight
    .PrivateBit = PrivateBit
  End With
End Function

Public Function CheckTag(filename As String)
  Dim Tag As String * 3

  If filename = "" Then Exit Function
  Open filename For Binary As #1
  Get #1, FileLen(filename) - 127, Tag
  If Tag = "TAG" Then
     CheckTag = True
  Else
     CheckTag = False
  End If
  Close #1
End Function
 
Code im Codebereich der Form
 
Option Explicit

Private Sub Command1_Click(Index As Integer)
  Dim i As Integer
  Dim mp3msginfo As String
  On Error GoTo Fehler

  Select Case Index
    Case 1
      CommonDialog1.ShowOpen
      If CommonDialog1.filename = "" Then Exit Sub
      filename = CommonDialog1.filename
      Label2.Caption = filename

      GenreArray = Split(sGenreMatrix, "|")
      For i = LBound(GenreArray) To UBound(GenreArray)
          Combo1.AddItem GenreArray(i)
      Next

      GetId3 filename

      Text1(0).Text = RTrim(id3Info.Title)
      Text1(1).Text = RTrim(id3Info.Artist)
      Text1(2).Text = RTrim(id3Info.Album)
      Text1(3).Text = RTrim(id3Info.sYear)
      Text1(4).Text = RTrim(id3Info.Comments)

      Combo1.ListIndex = id3Info.Genre
      ReadMP3 filename
      Command1(2).Enabled = True
      Command1(3).Enabled = True
      Exit Sub

    Case 2
      If MsgBox("Wollen Sie die Daten wirklich ändern ?", _
               vbYesNo, "Daten ändern") = vbYes Then
        id3Info.Title = RTrim(Text1(0).Text)
        id3Info.Artist = RTrim(Text1(1).Text)
        id3Info.Album = RTrim(Text1(2).Text)
        id3Info.sYear = RTrim(Text1(3).Text)
        id3Info.Genre = Combo1.ListIndex
        id3Info.Comments = RTrim(Text1(4).Text)
        SaveId3 Label2.Caption, id3Info
      End If

    Case 3
      mp3msginfo = "Dateigrösse: " & _
          Format$(FileLen(Label2.Caption) / 1024, "#,###") & _
          " kB" & vbNewLine & "Länge: " & GetMP3Info.Duration & _
          " sec." & vbNewLine & vbNewLine
      mp3msginfo = mp3msginfo & "MPEG " & GetMP3Info.MpegVersion _
          & ".0" & " Layer " & GetMP3Info.MpegLayer & vbNewLine _
          & "Bitrate: " & GetMP3Info.Bitrate & " kbps" & _
          vbNewLine & "Frequenz: " & GetMP3Info.Frequency & _
          " Hz" & vbNewLine & "Modus: " & GetMP3Info.Mode & _
          vbNewLine & "Copyright: " & GetMP3Info.CopyRight & _
          vbNewLine & "Original: " & GetMP3Info.Original
      MsgBox mp3msginfo, vbOKOnly, "MP3-Info"

    Case Else
      Unload Me
      End
  End Select

  Exit Sub

Fehler:

End Sub
 
Weitere Links zum Thema
AudioGenie
MP3 Encoder
MP3Reader

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (6 kB) Downloads bisher: [ 5675 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Donnerstag, 11. August 2011