mp3 - daten auslesen | HERBERS Excel Forum

Hallo,
ich stehe vor einem Problem, wo ich nicht mehr weiter weiß:
ich möchte meine MP3-Dateien in Excel verwalten. Im Augenblick wandele ich meine CDs in mp3s um und sortiere sie mithilfe eines Makros alphabetisch in verschiedene worksheets (in Form von
A1 = Titel
B1 = Interpret
C1 = Größe in MB).
Das klappt so weit ganz gut.
Nun möchte ich aber folgende Informationen hinzufügen:
- Spieldauer
- Bitrate usw.
Unter WindowsXP bspw. bekommt man diese Daten angezeigt, wenn man die Maus über einem mp3-File positioniert.
Das müsste doch mit einer API oder einer dll gehen, oder täusche ich mich? Das geht zwar schon etwas aus Excel raus, sollte aber machbar sein.
Wäre schön, wenn es hinterher auch unter Excel 2000/97 laufen würde, obwohl ich unter 2003 entwickle.
Wer kann mir einen Tipp geben? Bin für jeden Hinweis dankbar...
DANKE schonmal!
Markus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
Das ist von "ActiveVB".
Bei VBA Gut kannst du das ja sicher anpassen

'--------------------------- Form1.frm --------------------------
Option Explicit
'Wurde in VB programmiert
'Die Dialoge müssen angepasst werden
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
'-------------------------- Module1.bas -------------------------
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 eingefügt mit Syntaxhighlighter 2.5

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

mp3 - daten auslesen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread