Zurück zur Homepage

MP3 #2

Irgendwann hatte ich einmal eine Arbeitsmappe zur Verfügung gestellt, welche die Metadaten einer MP3-Datei ausliest. Diese Metadaten, im Allgemeinen spricht man dabei auch von Tags, können sich an verschiedenen Stellen der Datei befinden.

Die Standardtags befinden sich dabei, sofern vorhanden, in den letzten 128 Bytes der Datei. Damit man erkennt, dass es sich bei diesen Bytes um Metadaten handelt, enthalten die ersten drei Bytes die Zeichenfolge "TAG". Die zugrundeliegende Struktur ist wie folgt spezifiziert:

Private Type MP3Tag
   Tag As String * 3
   Titel As String * 30
   Artist As String * 30
   Album As String * 30
   Jahr As String * 4
   Kommentar As String * 29
   Track As Byte
   Genre As Byte
End Type

Man sieht, dass man doch sehr eingeschränkt ist, was die Art und die Länge der Informationen betrifft. Deshalb hat man einen anderen Standard etabliert, momentan sind das die ID3 Versionen 2 bis 4. Diese Informationen befinden sich am Anfang der Datei, gekennzeichnet werden diese durch die Zeichenfolge "ID3" in den ersten drei Bytes der Datei. Nähere Informationen über diesen Standard findet man unter http://www.id3.org/Home.

In den ersten paar Bytes findet man auch Informationen über die Länge der Metadaten in Bytes und über die verwendete ID3-Version. Jeder Tag, der darauf folgt, wird durch eine Zeichenfolge, bestehend aus drei (Version 2), bzw. vier Zeichen (Version 3, 4) gekennzeichnet, aus der man die Art der Information erkennen kann. Darauf folgt die Angabe der Länge des Tags, bestehend aus drei (Version2), bzw. vier Zeichen (Version 3, 4). Außerdem existiert noch ein Byte, welches Auskunft darüber gibt, wie der folgende Text kodiert ist (ASCII, Unicode).

In diesem Beispiel werden die Informationen aller ID3-Versionen ausgelesen, auf einem Tabellenblatt ausgegeben und können schließlich auch geändert werden. Bei meiner letzten Version zum Auslesen der Informationen hatte ich die ersten Bytes eines einzelnen Datenframes ausgelesen, um unter anderem an die Infos über Bitrate zu kommen, welche auch wichtig für die Berechnung der Spielzeit ist. Nun werden aber immer häufiger Dateien erzeugt, bei der jeder Frame eine gesonderte Bitrate erhalten kann. Das schafft Platz, denn nicht jeder Frame benötigt eine hohe Auflösung. Der Nachteil ist, dass man nun theoretisch alle Frames anpacken muss um auf die gesamte Spielzeit zu kommen.

Das ist natürlich sehr zeitaufwendig, deshalb wird die Windows-Shell benutzt. Mit deren Hilfe kommt man an alle Daten, die auch im Explorer angezeigt werden können. Apropos zeitaufwendig, VBA ist ja prinzipiell nicht die schnellste Programmiersprache, deshalb dauert das Auslesen auch eine gewisse Zeit, die abhängig vom eingesetzten System ist. Bei mir, Athlon XP 2500+, dauert das Auswerten einer Datei ca. 800 Millisekunden, bei 7000 Dateien kann das dann insgesamt schon mal eine Stunde dauern. Sicherlich kann man den Code noch etwas optimieren, der Zeitgewinn wird aber nicht besonders groß sein, da das Einlesen der Dateien in Variablen einen großen Teil der Zeit in Anspruch nimmt. Ohne ein Umkrempeln, bei der man auf Kollektionen generell verzichtet und ohne einen Verzicht auf eine zusätzliche Stringvariable, welche den Dateiinhalt aufnimmt, wird man nicht viel Zeit einsparen können.

WMA (Vorschau)

In einem anderen Beispiel wird gezeigt, wie man die Metadaten von WMA-Dateien ausliest und auch ändern kann. Da MP3 und WMA irgendwie zusammengehören, sind beide Beispiele in einer Excel Arbeitsmappe zusammengefasst. Beides ist aber recht aufwändig und erfordert eine umfangreiche Erklärung. Damit man den Überblick nicht verliert, wird Bearbeiten von WMA-Dateien in einem separaten Dokument beschrieben.

Auch bei diesem Beispiel gilt, dass man den Code frei benutzen kann. Eine Veröffentlichung des Codes oder Teilen davon, womöglich noch unter anderem Namen, sollte aber unterbleiben.

Excel-Dateien zum Download ca. 400 KB: MP3_WMA.xlsm oder MP3_WMA.xls

Die Userform ufMp3

Mit Hilfe dieser Userform und der Klasse clsMP3 können MP3-Tags ausgelesen, verändert und zurückgeschrieben werden. Die folgende Abbildung zeigt mehrere Ansichten der gleichen Userform.

WMA

Abbildung 1

Option Explicit
Private mstrFile     As String
Private mvarGenre    As Variant
Private mobjMP3      As clsMP3
Private Sub cmdFile_Click()
   Dim varFile As Variant
   ' Dateiname- und Pfad holen
   varFile = Application.GetOpenFilename( _
      "MP3 Files (*.mp3), *.mp3")
   ' Verlassen, wenn nichts gewählt
   If varFile = False Then Exit Sub
   ' Pfad+Name speichern und ausgeben
   mstrFile = varFile: lblFile = mstrFile
   ' Informationen auslesen
   ReadAll
End Sub

Private Sub ReadAll()
   Dim astrTags()       As String
   Dim x                As Long
   Dim k                As Long
   lsbResult.Clear
   Set mobjMP3 = New clsMP3
   
   ' Textfelder löschen
   txtTitel.Text = ""
   txtAutor.Text = ""
   txtAlbum.Text = ""
   txtKommentar.Text = ""
   txtJahr.Text = ""
   txtTrack.Text = ""
   txtGenre.Text = ""
   txtGenreNum.Text = ""
   txtTitle1.Text = ""
   txtComments.Text = ""
   txtContentType.Text = ""
   txtLinkedInformation.Text = ""
   txtEncodedBy.Text = ""
   txtLyricist.Text = ""
   txtLyricistTextWriter.Text = ""
   txtOrigLyricsTextWriter.Text = ""
   txtConductor.Text = ""
   txtTrackNumber1.Text = ""
   txtPublisher.Text = ""
   txtPopularimeter.Text = ""
   txtAlbumTitle.Text = ""
   txtCopyrightMessage.Text = ""
   txtLeadPerformer.Text = ""
   txtBandOrchestra.Text = ""
   txtRecordingDates.Text = ""
   txtYearPublishing.Text = ""
   txtModifiedBy.Text = ""
   txtPublishersWebpage.Text = ""
   txtArtistWebpage.Text = ""
   txtAudioSourceWebpage.Text = ""
   txtBuyCDWebpage.Text = ""
   txtAudioFileWebpage.Text = ""
   txtTextInformation.Text = ""
   
   ' Spaltenbreite Listenfeld 'Alle Infos' festlegen
   lsbResult.ColumnWidths = "7 cm;20 cm"
   
   With mobjMP3
   
      ' Dateiname- und Pfad übergeben
      .Filename = mstrFile
      
      ' Dateiinformationen holen
      astrTags = .Tags
      
      For k = LBound(astrTags, 2) To UBound(astrTags, 2)
      ' Alle Tags durchlaufen
         
         ' Infos in das Listenfeld eintragen
         lsbResult.AddItem
         x = lsbResult.ListCount - 1
         lsbResult.List(x, 0) = astrTags(1, k)
         lsbResult.List(x, 1) = astrTags(2, k)
      
         Select Case astrTags(1, k)
            ' Standard-Informationen in die Textfelder schreiben
            Case "Titel"
               If astrTags(3, k) = "Standard" Then _
                  txtTitel.Text = astrTags(2, k)
            Case "Autor"
               If astrTags(3, k) = "Standard" Then _
               txtAutor.Text = astrTags(2, k)
            Case "Album"
               If astrTags(3, k) = "Standard" Then _
               txtAlbum.Text = astrTags(2, k)
            Case "Kommentar"
               If astrTags(3, k) = "Standard" Then _
               txtKommentar.Text = astrTags(2, k)
            Case "Track"
               If astrTags(3, k) = "Standard" Then _
               txtTrack.Text = astrTags(2, k)
            Case "Jahr"
               If astrTags(3, k) = "Standard" Then _
               txtJahr.Text = a
strTags(2, k)
            Case "Genre"
               If astrTags(3, k) = "Standard" Then _
               txtGenre.Text = astrTags(2, k)
            Case "Genrenummer"
               If astrTags(3, k) = "Standard" Then
                  txtGenreNum.Text = astrTags(2, k)
                  If IsNumeric(astrTags(2, k)) Then
                     lsbGenre.ListIndex = CByte(astrTags(2, k))
                  End If
               End If
            ' ID3- Informationen in die Textfelder schreiben
            Case "Title/songname/content description"
               txtTitle1.Text = astrTags(2, k)
            Case "Comments"
               txtComments.Text = astrTags(2, k)
            Case "Content type"
               txtContentType.Text = astrTags(2, k)
            Case "Linked information"
               txtLinkedInformation.Text = astrTags(2, k)
            Case "Composer"
               txtComposer.Text = astrTags(2, k)
            Case "Encoded by"
               txtEncodedBy.Text = astrTags(2, k)
            Case "Unsychronized lyric/text transcription"
               txtLyricist.Text = astrTags(2, k)
            Case "Lyricist/Text writer"
               txtLyricistTextWriter.Text = astrTags(2, k)
            Case "Original lyricist(s)/text writer(s)"
               txtOrigLyricsTextWriter.Text = astrTags(2, k)
            Case "Conductor/performer refinement"
               txtConductor.Text = astrTags(2, k)
            Case "Track number/Position in set"
               txtTrackNumber1.Text = astrTags(2, k)
            Case "Publisher"
               txtPublisher.Text = astrTags(2, k)
            Case "Involved people list"
               txtInvolvedPeople.Text = astrTags(2, k)
            Case "Popularimeter"
               txtPopularimeter.Text = astrTags(2, k)
            Case "Album/Movie/Show title"
               txtAlbumTitle.Text = astrTags(2, k)
            Case "Copyright message"
               txtCopyrightMessage.Text = astrTags(2, k)
            Case "Lead performer(s)/Soloist(s)"
               txtLeadPerformer.Text = astrTags(2, k)
            Case "Band/orchestra/accompaniment"
               txtBandOrchestra.Text = astrTags(2, k)
            Case "Recording dates"
               txtRecordingDates.Text = astrTags(2, k)
            Case "Year"
               txtYearPublishing.Text = astrTags(2, k)
            Case "Interpreted, remixed, or otherwise modified by"
               txtModifiedBy.Text = astrTags(2, k)
            Case "Publishers official webpage"
               txtPublishersWebpage.Text = astrTags(2, k)
            Case "Official artist/performer webpage"
               txtArtistWebpage.Text = astrTags(2, k)
            Case "Official audio source webpage"
               txtAudioSourceWebpage.Text = astrTags(2, k)
            Case "Commercial information"
               txtBuyCDWebpage.Text = astrTags(2, k)
            Case "Official audio file webpage"
               txtAudioFileWebpage.Text = astrTags(2, k)
            Case "User defined text information frame"
               txtTextInformation.Text = astrTags(2, k)
         End Select
      
      Next
      
   End With
   
End Sub

Private Sub cmdWrite_Click()

   If mobjMP3 Is Nothing Then Exit Sub
   
   If MsgBox("Sind Sie sicher, dass Sie die Datei:" & vbCrLf & _
      mstrFile & vbCrLf & "überschreiben wollen?" _
      , vbYesNo, "Tags speichern") <> vbYes Then Exit Sub
      
      If chkStandard Then
         ' Standardtags schreiben
         mobjMP3.WriteStandardTags _
            txtTitel.Text, _
            txtAutor.Text, _
            txtAlbum.Text, _
            txtKommentar.Text, _
            txtTrack.Text, _
            txtJahr.Text, _
            txtGenreNum.Text
      End If
      ' ID3 Tags zurückschreiben
      If mobjMP3.WriteID3Tags( _
         Title:=txtTitle1, Comments:=txtComments, _
         ContentType:=txtContentType, _
         LinkedInformation:=txtLinkedInformation, _
         Composer:=txtComposer, EncodedBy:=txtEncodedBy, _
         Lyricist:=txtLyricist, LyricistTextWriter:=txtLyricistTextWriter, _
         OrigLyricsTextWriter:=txtOrigLyricsTextWriter, Conductor:=txtConductor, _
         TrackNumber:=txtTrackNumber1, Publisher:=txtPublisher, _
         InvolvedPeople:=txtInvolvedPeople, Popularimeter:=txtPopularimeter, _
         AlbumTitle:=txtAlbumTitle, CopyrightMessage:=txtCopyrightMessage, _
         LeadPerformer:=txtLeadPerformer, BandOrchestra:=txtBandOrchestra, _
         RecordingDates:=txtRecordingDates, YearPublishing:=txtYearPublishing, _
         ModifiedBy:=txtModifiedBy, PublishersWebpage:=txtPublishersWebpage, _
         ArtistWebpage:=txtArtistWebpage, AudioSourceWebpage:=txtAudioSourceWebpage, _
         BuyCDWebpage:=txtBuyCDWebpage, AudioFileWebpage:=txtAudioFileWebpage, _
         TextInformation:=txtTextInformation) Then
      
         MsgBox "Tags erfolgreich in Datei" & vbCrLf & _
            mstrFile & vbCrLf & _
            "geschrieben!"
         
      End If
   
End Sub

Private Sub lsbGenre_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   With lsbGenre
      txtGenreNum = .ListIndex
      txtGenre = Split(.List(.ListIndex), ":  ")(1)
   End With
End Sub

Private Sub txtJahr_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtTrack_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub txtYearPublishing_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub UserForm_Initialize()
   Dim i             As Long
   Set mobjMP3 = New clsMP3
   mvarGenre = mobjMP3.GetGenre
   For i = 0 To UBound(mvarGenre)
      lsbGenre.AddItem Format(i, "000") & "  :  " & mvarGenre(i)
   Next
   lsbGenre.ListIndex = 0
End Sub

Listing 1.1

Auf der Userform befinden sich zwei Schaltflächen und ein Registersteuerelement. Nachdem mit der Schaltfläche "Datei öffnen" über einen Dialog eine Mp3-Datei ausgewählt wurde, werden die Inhalte der Tags auf den Registern "Standard Tags" und den beiden mit der Beschriftung "Extended Tags" ausgegeben. Die Registerkarte "Alle Informationen" enthält ein Listensteuerelement, welches darin alle Informationen über die Datei in Listenform zusammenfasst.

Standardtags werden auf der Registerkarte "Standard Tags" in Textfeldern und einem Listenfeld angezeigt. Das Listenfeld enthält Informationen über das Genre der Musikdatei, ein Doppelklick auf einen Eintrag ändert das aktuelle Genre. Ist das Kontrollkästchen auf dieser Registerkarte gesetzt, werden beim Speichern über die Schaltfläche "Datei Speichern" auch die geänderten Standardtags zurückgeschrieben, existieren diese noch nicht, werden diese neu angelegt.

Auf den Registerkarten "Extended Tags" und "Lyrics" werden in verschiedenen Textfeldern die ausgelesenen ID3-Informationen ausgegeben, wo sie auch geändert werden können. Beim Speichern werden die Tags der nichtleeren Felder in der Datei geändert, bzw. neu angelegt.

Die Prozedur ReadAll

Diese Prozedur wird durch einen Klick auf die Schaltfläche "Datei Öffnen" aufgerufen. In dieser wird zuvor noch über den internen Dialog GetOpenFilename eine MP3-Datei ausgewählt.

Anschließend werden die Textfelder und das Listenfeld, welche alle Informationen aufnimmt, zurückgesetzt. Der komplette Pfad zur ausgewählten Datei wird dann an die Eigenschaft Filename der Objektklasse clsMP3 übergeben. Die Eigenschaft Tags liefert anschließend die Informationen in Form eines zweidimensionalen Arrays zurück. Das erste Element der ersten Dimension liefert den Tagnamen, das zweite den Wert und das Dritte die Herkunft des aktuellen Elements. Mit Hilfe der Herkunft kann man beispielsweise unterscheiden, ob der Titel aus den Standardtags, den ID3-Tags oder über die Shell ausgelesen wurde.

Alle Informationen werden im Listenfeld gespeichert und auch in die entsprechenden Textfelder geschrieben. Die ausgelesene Genrenummer der Standardtags aktiviert auch den entsprechenden Listeneintrag auf der Registerkarte “Standard Tags“.

Das Klickereignis cmdWrite_Click

Diese Prozedur liest zu Beginn die Standardtags aus den entsprechenden Textfeldern der Registerkarte “Standard Tags“ und übergibt sie, falls das Kontrollkästchen gesetzt ist, an die Methode WriteStandardTags der Objektklasse clsMP3. Anschließend werden die Inhalte der Textfelder auf den Registerkarten “Extended Tags“ und “Lyrics“ an die Methode WriteID3Tags der Objektklasse clsMP3 übergeben.

Das Modul mdlFolder

In diesem Modul befindet sich Code zur Auswahl eines Verzeichnisses und zum Auslesen eines kompletten Verzeichnisbaums.

Option Explicit
Private Const BIF_RETURNONLYFSDIRS     As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN    As Long = &H2
Private Const BIF_STATUSTEXT           As Long = &H4
Private Const BIF_RETURNFSANCESTORS    As Long = &H8
Private Const BIF_EDITBOX              As Long = &H10
Private Const BIF_VALIDATE             As Long = &H20
Private Const BIF_NEWDIALOGSTYLE       As Long = &H40
Private Const BIF_BROWSEINCLUDEURLS    As Long = &H80
Private Const BIF_BROWSEFORCOMPUTER    As Long = &H1000
Private Const BIF_BROWSEFORPRINTER     As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES   As Long = &H4000
Private Const BIF_SHAREABLE            As Long = &H8000
Private Const BIF_SHOWALLOBJECTS       As Long = &H8
'Desktop
Private Const ssfDESKTOP                As Long = &H0
'Programme Startmenü (alle Benutzer)
Private Const ssfPROGRAMS               As Long = &H2
'Systemsteuerung
Private Const ssfCONTROLS               As Long = &H3
'Drucker
Private Const ssfPRINTERS               As Long = &H4
'Eigene Dateien (aktueller Benutzer)
Private Const ssfPERSONAL               As Long = &H5
'Favoriten (aktueller Benutzer)
Private Const ssfFAVORITES              As Long = &H6
'Autostart
Private Const ssfSTARTUP                As Long = &H7
'Zuletzt verwendete Dokumente
Private Const ssfRECENT                 As Long = &H8
'Senden an - Ordner
Private Const ssfSENDTO                 As Long = &H9
'Recycled (Papierkorb)
Private Const ssfBITBUCKET              As Long = &HA
'Startmenü (aktueller Benutzer)
Private Const ssfSTARTMENU              As Long = &HB
'Desktop - Ordner (aktueller Benutzer)
Private Const ssfDESKTOPDIRECTORY       As Long = &H10
'Arbeitsplatz
Private Const ssfDRIVES                 As Long = &H11
'Netzwerkumgebung
Private Const ssfNETWORK                As Long = &H12
'Netzwerkumgebung - Ordner
Private Const ssfNETHOOD                As Long = &H13
'Schriftarten - Ordner
Private Const ssfFONTS                  As Long = &H14
'Vorlagen - Ordner
Private Const ssfTEMPLATES              As Long = &H15
'Startmenü (alle Benutzer)
Private Const ssfCOMMONSTARTMENU        As Long = &H16
'Programme Startmenü (alle Benutzer)
Private Const ssfCOMMONPROGRAMS         As Long = &H17
'Autostart (alle Benutzer)
Private Const ssfCOMMONSTARTUP          As Long = &H18
'Desktop - Ordner (alle Benutzer)
Private Const ssfCOMMONDESKTOPDIR       As Long = &H18
'Anwendungsdaten (aktueller Benutzer)
Private Const ssfAPPDATA                As Long = &H1A
Private Const ssfLOCALAPPDATA           As Long = &H1C
'Druckumgebung - Ordner
Private Const ssfPRINTHOOD              As Long = &H1B
'Altern.
Autostart - Ordner (aktueller Benutzer)
Private Const ssfALTSTARTUP             As Long = &H1D
'Altern.
Autostart - Ordner (alle Benutzer)
Private Const ssfCOMMONALTSTARTUP       As Long = &H1E
'Favoriten (alle Benutzer)
Private Const ssfCOMMONFAVORITES        As Long = &H1F
'Temporäre Internetdateien
Private Const ssfINTERNETCACHE          As Long = &H20
'Internet Cookies - Ordner
Private Const ssfCOOKIES                As Long = &H21
'Internet Verlauf - Ordner
Private Const ssfHISTORY                As Long = &H22
'Anwendungsdaten
Private Const ssfCOMMONAPPDATA          As Long = &H23
'Windows-Ordner
Private Const ssfWINDOWS                As Long = &H24
'System-Ordner
Private Const ssfSYSTEM                 As Long = &H25
'Programme
Private Const ssfPROGRAMFILES           As Long = &H26
'Eigene Bilder
Private Const ssfMYPICTURES             As Long = &H27
'Dokumente und Einstellungen
Private Const ssfPROFILE                As Long = &H28
'Gemeinsame Dateien
Private Const ssfPROGRAMFILESCOMMON     As Long = &H2B
'Vorlagen - Ordner (alle Benutzer)
Private Const ssfCOMMONTEMPLATES        As Long = &H2D
'Dokumente (alle Benutzer)
Private Const ssfCOMMONDOCUMENTS        As Long = &H2E
'Startmenü "Verwaltung" (alle Benutzer)
Private Const ssfCOMMONADMINTOOLS       As Long = &H2F
'Startmenü "Verwaltung" (aktueller Benutzer)
Private Const ssfADMINTOOLS             As Long = &H30
'Netzwerk- und DFÜ-Verbindungen
Private Const ssfCONNECTIONS            As Long = &H31

Public Function ShellGetFolder( _
   Optional start As Variant = ssfDRIVES, _
   Optional Caption As String = "Browse Folder" _
   ) As String
   On Error Resume Next
   
   Dim objShell      As Object
   Dim objBrowse     As Object
   Dim lngOptions    As Long
   
   ' Eigenschaften des Dialoges setzen
   lngOptions = BIF_RETURNONLYFSDIRS Or _
                BIF_EDITBOX Or _
                BIF_VALIDATE Or _
                BIF_SHOWALLOBJECTS Or _
                BIF_NEWDIALOGSTYLE Or _
                BIF_STATUSTEXT Or _
                BIF_SHOWALLOBJECTS
   
   Set objShell = CreateObject("Shell.Application")
   
   If IsNumeric(start) Then
      ' Anfangspfad als Konstante
      Set objBrowse = objShell.BrowseForFolder( _
         &H0, Caption, lngOptions, CLng(start))
   Else
      ' Anfangspfad als String
      Set objBrowse = objShell.BrowseForFolder( _
         &H0, Caption, lngOptions, start & Chr(0))
   End If
   
   ' Dialog starten und Pfad zurückgeben
   objBrowse.ParentFolder.ParseName objBrowse.Title
   ShellGetFolder = objBrowse.self.Path
   If ShellGetFolder = "" Then ShellGetFolder = "Nichts ausgewählt"

End Function

Public Function SearchFiles( _
   ByVal strStart As String, _
   Optional strFilter As String = "*", _
   Optional avarResult As Variant, _
   Optional lngCount As Long _
   ) As Variant
   
   Dim astrFolder()  As String
   Dim strFolder     As String
   Dim strFile       As String
   Dim i             As Long
   
   On Error Resume Next
   If lngCount = 0 Then ReDim avarResult(1 To 1)
   ' Erst einmal 100 Unterverzeichnisse annehmen
   ReDim astrFolder(1 To 100)
   
   If Left(strFilter, 1) <> "*" Then strFilter = "*" & strFilter
   
   If Right$(strStart, 1) <> "\" Then
       ' Nachschauen, ob übergebener Pfad auch einen
       ' Backslash enthält.
Wenn nicht, dann anhängen
       strStart = strStart & "\"
   End If
   
   strFolder = strStart
   
   ' Alle Dateien liefern
   strStart = strStart & "*"
   
   ' Suche mit Dir() initialisieren
   strFile = Dir(strStart, vbSystem Or _
      vbHidden Or vbDirectory Or vbNormal)
      
   Do While strFile <> ""
   ' So lange durchlaufen, wie
   ' durch Dir() etwas geliefert wird
      If GetAttr(strFolder & strFile) And vbDirectory Then
      ' wenn Datei ein Verzeichnis ist
         If Right$(strFile, 1) <> "." Then
            ' und zwar ein untergeordnetes,
            ' (Punkte sind Übergeordnete Verzeichnisse)
            i = i + 1
            If i > UBound(astrFolder) Then
               ' Wenn Array zu klein ist, anpassen
                ReDim Preserve astrFolder(1 To i + 1)
            End If
            ' dann ein Array mit Verzeichnissen füllen.
            astrFolder(i) = strFile
         End If
      Else
      ' Handelt es sich um eine Datei,
         If LCase(strFile) Like LCase(strFilter) Then
         ' und entspricht sie noch den Filterbedingungen,
            lngCount = lngCount + 1
            ReDim Preserve avarResult(1 To lngCount)
            avarResult(lngCount) = strFolder & strFile
         End If
      End If
      strFile = Dir$()
   Loop
   
   If i <> 0 Then
      ' Array anpassen
      ReDim Preserve astrFolder(1 To i)
      ' Jetzt erst werden die Unterverzeichnisse abgearbeitet,
      ' weil Dir$ mit Rekursionen nicht klarkommt.
      For i = 1 To UBound(astrFolder)
         ' Jetzt ruft sich diese Prozedur noch einmal auf.
         
SearchFiles strFolder & astrFolder(i), strFilter, avarResult, lngCount
      Next
   End If
   
   SearchFiles = avarResult
   
End Function

Listing 1.2

Die Funktion ShellGetFolder

Diese Funktion liefert über einen Dialog ein ausgewähltes Verzeichnis.

Dabei ist es möglich, einen Anfangspfad vorzugeben, leider kann man dann nur noch unterhalb des vorgegebenen Pfades suchen, zu den übergeordneten Ordnern kann man dann nicht mehr wechseln. Zum Festlegen eines Pfades kann man einen vordefinierten oder einen benutzerdefinierten verwenden. Die vorgegebenen Pfade werden als numerische Werte übergeben und stecken in den Konstanten mit dem Präfix (Vorsilbe) ssf. Benutzerdefinierte Pfade werden einfach als String übergeben.

Die Funktion SearchFiles

Diese Funktion liefert eine Liste von Dateien in Form eines Arrays, welche dem übergebenen Suchkriterium entsprechen. Unterverzeichnisse und deren Unterverzeichnisse werden dabei auch mit berücksichtigt.

Die Funktion Dir wird eingesetzt, um zu überprüfen, ob eine Datei, die einem bestimmten Suchkriterium entspricht, in einem Verzeichnis vorhanden ist. Beim nochmaligen Aufruf ohne ein Argument wird der nächste Dateiname zurückgeliefert, der dem aktuellen Suchkriterium entspricht. Mit Dir kann man aber keine neue Suche beginnen, ohne die alten Einstellungen zu überschreiben.

Ein rekursives Durchlaufen von Unterverzeichnissen ist also nicht ohne weiteres möglich. Man kann dem aber abhelfen, indem man die Unterverzeichnisse zwischenspeichert, bis die komplette Suche auf einer Verzeichnisebene abgeschlossen ist. Danach kann man dann mit der gleichen Prozedur die Unterverzeichnisse abarbeiten.

In dieser Funktion werden nacheinander alle Dateien eines übergebenen Verzeichnisses durchlaufen. Zu den Dateien gehören, wenn das entsprechende Flag gesetzt ist, auch Verzeichnisse. Die Datei mit dem Namen "." (Punkt) steht für das gleiche- und die mit ".." (Doppelpunkt) für das übergeordnete Verzeichnis, diese beiden werden aber ignoriert.

Unterverzeichnisse werden in einem Array zwischen gespeichert, Dateien, die dem Suchkriterium entsprechen, werden in einem anderen Array gespeichert. Das Array, welches die gefundenen Dateien speichert, wird jeweils als Referenz an die rekursiv aufgerufene Funktion übergeben, es wird also in jeder Ebene das Originalarray bearbeitet.

Nachdem die Suche in einer Verzeichnisebene beendet ist, wird für jedes Unterverzeichnis die gleiche Prozedur noch einmal aufgerufen, aber mit dem um das Unterverzeichnis erweiterten Suchpfad. Es werden jeweils auch das Suchkriterium und ein Zähler als Referenz übergeben. Die aufgerufene Prozedur wird erst dann beendet, wenn alle ihre Unterverzeichnisse abgearbeitet sind.

Als Funktionsergebnis wird jeweils das Ergebnisarray zurückgegeben, notwendig ist es aber lediglich in der ersten Ebene.

Das Klassenmodul des Tabellenblattes MP3

In diesem Modul befindet sich Code, der dazu dient, die Daten, die von der Klasse clsMp3 geliefert werden, auf dem Tabellenblatt auszugeben. Beim Klick auf die Schaltfläche mit der Beschriftung "Datei Editieren" wird die Userform ufMP3 angezeigt, mit der man die Tags einer Datei ändern kann.

Option Explicit
Private mblnStop     As Boolean

Private Sub cmdEdit_Click()
   ufMP3.Show vbModeless
End Sub

Private Sub cmdLesen_Click()
   Dim MyMP3         As New clsMP3
   Dim strTags()     As String
   Dim strFile       As String
   Dim strPath       As String
   Dim i             As Long
   Dim k             As Long
   Dim m             As Long
   Dim n             As Long
   Dim colCaption    As New Collection
   Dim colTemp       As Collection
   Dim varTemp       As Variant
   Dim varFiles      As Variant
   Dim varFile       As Variant
   Dim dteBegin      As Date
   
   On Error Resume Next
   
   mblnStop = False
   
   ' Dialog zum Erfragen eines Ordners starten
   strPath = ShellGetFolder()
   
   ' Verlassen, wenn nichts gewählt
   If strPath = "" Then Exit Sub
   
   ' Backslash anhängen
   If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
   
   ' Fortschritt anzeigen
   Application.StatusBar = "Suche .mp3 Dateien"
   
   Application.ScreenUpdating = False
   
   ' Dateiliste erstellen
   varFiles = SearchFiles(strPath, "*.mp3")
   
   dteBegin = Now
   
   ' Zielbereich löschen
   Me.Cells.ClearContents
   
   With MyMP3
   
      ' 1.
Datei mit bestimmten Muster suchen
      
      i = 1
      
      ' Shellinformationen nicht holen
      .ShowShell = False
      
      For Each varFile In varFiles
      
         ' Fortschritt anzeigen
         Application.StatusBar = "Lese Datei Nr. " & i - 1 & " : " & varFile
         
         ' Dateipfad- und Name an die Klasse übergeben
         .Filename = varFile
         
         ' Informationen auslesen
         strTags = .Tags
         
         For k = LBound(strTags, 2) To UBound(strTags, 2)
            ' Spalten für Überschriften festlegen. Jede
            ' Überschrift bekommt eine eigene Spalte zugewiesen.
            ' Diese gilt bis zum Ende der Programmausführung, nur
            ' so wird sichergestellt, dass gleiche Infos auch
            ' nachher untereinander stehen
            Set colTemp = New Collection
            colTemp.Add strTags(1, k), "Name"
            colTemp.Add colCaption.Count + 1, "Spalte"
            colCaption.Add colTemp, strTags(1, k)
         Next
         
         Application.ScreenUpdating = False
         
         m = 0: i = i + 1
         
         
         For k = LBound(strTags, 2) To UBound(strTags, 2)
            ' Alle Infos in die zugehörige Spalte eintragen
            m = colCaption(strTags(1, k))("Spalte")
            Me.Cells(i, m).Value = strTags(2, k)
         Next
         
         'Hyperlink auf die Datei erzeugen
         Me.Hyperlinks.Add Anchor:=Me.Cells(i, 1), _
            Address:=strTags(2, 2) & "\" & strTags(2, 1)
         
      Next
      
   End With
   
   Application.ScreenUpdating = False
   
   For Each varTemp In colCaption
      ' Überschriften eintragen
      Me.Cells(1, CLng(varTemp("Spalte"))).Value = varTemp("Name")
   Next
   
   ' Zellen formatieren
   Me.Cells.Font.Name = "Calibri"
   Me.Cells.Font.Size = 11
   For i = 1 To 5
      Me.Cells.Columns.AutoFit
      Me.Cells.Rows.AutoFit
   Next
   Me.Rows(1).RowHeight = 80

   ' Statusbar zurücksetzen und Bildschirmaktualisierung einschalten
   Application.StatusBar = False
   Application.ScreenUpdating = True
   MsgBox Format(Now - dteBegin, "h:mm:ss")
End Sub

Listing 1.3

Das Klickereignis cmdLesen_Click

In dieser Ereignisprozedur wird mit dem Aufruf der Funktion ShellGetFolder ein Dialog zur Verzeichnisauswahl angezeigt. Das zurückgelieferte Verzeichnis wird an die Funktion SearchFiles übergeben, zusammen mit dem Suchmuster *.mp3 werden alle Dateien inklusive Pfad zurückgegeben, welche dem Muster entsprechen. Das zurückgegebene Array enthält anschließend die Dateipfade aller MP3-Dateien, welche in dem übergebenen Verzeichnis und all dessen Unterverzeichnissen stecken.

Diese Pfade werden nacheinander an die Eigenschaft Filename der Objektklasse clsMP3 übergeben. In der Statusbar der Excel-Anwendung wird die gerade bearbeitete Datei angezeigt. Die Eigenschaft Tags liefert anschließend die Informationen in Form eines zweidimensionalen Arrays zurück. Das erste Element der ersten Dimension liefert den Tagnamen, das zweite den Wert und das Dritte die Herkunft des aktuellen Elements. Mit Hilfe der Herkunft kann man beispielsweise unterscheiden, ob der Titel aus den Standardtags, den ID3-Tags oder über die Shell ausgelesen wurde.

Jede Information sollte nun in eine eigene Spalte geschrieben werden, wobei gleiche Informationen auch in die gleiche Spalte kommen sollen. Dazu werden in einer Kollektion der Tagname und die zugehörige Spalte gespeichert. Als Schlüssel werden der Tagname und die Herkunft benutzt, um auch gleiche Namen unterschiedlicher Herkunft zuzulassen. Bevor man die Informationen nun ins Tabellenblatt schreibt, wird in dieser Kollektion nachgeschaut, ob bereits eine Spalte für die entsprechende Information festgelegt ist. Wenn ja, benutzt man diese Spalte, wenn nein, wird eine neue Spalte verwendet, der Tagname und diese Spalte wiederum in der Kollektion gespeichert.

Nachdem alle Informationen ins Tabellenblatt geschrieben wurden, entnimmt man der Kollektion die Überschriften und schreibt diese in die erste Zeile. Nun kommt die Formatierung an die Reihe. Das Ausführen von Autofit für die Zeilenhöhe und Spaltenbreite wird mehrmals durchgeführt, ein einmaliges Ausführen bringt meistens nicht den gewünschten Erfolg.

Das Klassenmodul clsMp3

Diese Klasse kapselt das Auslesen und Beschreiben einer MP3-Datei. Nach Außen stellt sie nur wenige Methoden, Funktionen und Eigenschaften zur Verfügung. Die Methode WriteID3Tags speichert die übergebenen Argumente als Tags in der Datei. Die Methode WriteStandardTags speichert die übergebenen Argumente als Standardtags in der Datei. Die Eigenschaft Tags liefert die Informationen in Form eines zweidimensionalen Arrays zurück. Das erste Element der ersten Dimension liefert den Tagnamen, das zweite den Wert und das Dritte die Herkunft des aktuellen Elements.

Die Eigenschaft Filename nimmt den Dateipfad entgegen, GetGenreByNum liefert zu einer übergebenen Nummer das zugehörige Genre als Text. ShowID3 legt fest, ob ID3-Tags, ShowShell legt fest, ob Shell-Informationen und ShowStandard legt fest, ob Standard-Informationen zurückgeliefert werden sollen. Setzt man KeineDoppeltenTags auf Wahr, werden Tags mit gleichen Namen vermieden.

Option Explicit
Private Type MP3Tag
   Tag As String * 3
   Titel As String * 30
   Artist As String * 30
   Album As String * 30
   Jahr As String * 4
   Kommentar As String * 29
   Track As Byte
   Genre As Byte
End Type
Private Declare Sub CopyMemory _
   Lib "kernel32" Alias "RtlMoveMemory" ( _
   pDst As Any, _
   pSrc As Any, _
   ByVal ByteLen As Long)
Private Type GUID
   Bytes(0 To 15) As Byte
End Type
Private Declare Function StringFromGUID2 _
   Lib "OLE32.dll" ( _
   tGuid As GUID, _
   ByVal lpszString As String, _
   ByVal lMax As Long _
   ) As Long

' Standardwerte (die letzten 128 Bytes)
Private mstrTitle                   As String
Private mstrAutor                   As String
Private mstrAlbum                   As String
Private mstrKommentar               As String
Private mstrTrack                   As String
Private mstrJahr                    As String
Private mstrGenre                   As String
Private mstrGenreNumber             As String

Private mlngBeginData               As Long ' Position Datenbeginn
Private mlngBeginTags               As Long ' Position Beginn der Tags
Private mlngVersion                 As Long ' ID3-Version
Private mlngFileLen                 As Long ' Dateilänge
Private mstrFileName                As String   ' Dateiname
Private mabytFile()                 As Byte ' Dateiinhalt als Array
Private mstrFile                    As String ' Dateiinhalt als String
Private mblnSik                     As Boolean ' Sicherheitskopie anlegen
Private mblnShowStandard            As Boolean ' Standardtags zulassen
Private mblnShowShell               As Boolean ' Shellinformationen zulassen
Private mblnShowID3                 As Boolean ' ID3-Tags zulassen
Private mblnDisableCopies           As Boolean ' Gleiche Tags verhindern
Private mobjRegExp                  As Object ' Objekt zur Mustererkennung

' Enthält Tagnamen und die zugehörige Beschreibung
Private mcolTranslate               As New Collection
' Enthält die ausgelesenen Tags
Private mcolTags                    As Collection
' Beschreibung zu Genrenummern
Private mastrGenre(255)             As String

' #############################
' ## Infos über ID3-Tags ##
' ## http://www.id3.org/Home ##
' #############################


' Tags zurückgeben
Public Function Tags() As Variant
   Dim i          As Long
   Dim varTemp    As Variant
   Dim astrTemp() As String
   On Error Resume Next
   
   Call MP3_Main
   
   If mlngFileLen = 0 Then Exit Function
   
   ' Ausgabearray dimensionieren
   ReDim astrTemp(1 To 4, 1 To mcolTags.Count + 3)
   
   ' Infos über Dateiname zurückgeben
   astrTemp(1, 1) = "Dateiname"
   astrTemp(2, 1) = Mid(mstrFileName, InStrRev(mstrFileName, "\") + 1)
   astrTemp(3, 1) = "Allgemein"
   astrTemp(4, 1) = ""
   
   ' Infos über Dateipfad zurückgeben
   astrTemp(1, 2) = "Dateipfad"
   astrTemp(2, 2) = Left(mstrFileName, InStrRev(mstrFileName, "\") - 1)
   astrTemp(3, 2) = "Allgemein"
   astrTemp(4, 2) = ""
   
   ' Infos über Dateipfad zurückgeben
   astrTemp(1, 3) = "Dateilänge"
   astrTemp(2, 3) = Format(mlngFileLen, "#,##0")
   astrTemp(3, 3) = "Allgemein"
   astrTemp(4, 3) = ""
   
   i = 3
   ' Infos aus Collection auslesen und im Ausgabearray speichern
   For Each varTemp In mcolTags
      i = i + 1
      astrTemp(1, i) = varTemp("Name")
      astrTemp(2, i) = varTemp("Value")
      astrTemp(3, i) = varTemp("Source")
      astrTemp(4, i) = varTemp("OrigName")
   Next
   
   Tags = astrTemp
   
End Function


Private Sub MP3_Main()
   
   Call ReadFile
   
   If mlngFileLen = 0 Then Exit Sub
   
   GetExtendedInfos
   If mblnShowStandard Then Call GetStandard
   If mblnShowID3 Then Call ReadID3Tags
   
End Sub

Private Sub GetStandard()
   Dim udtTag              As MP3Tag
   Dim abytTemp(0)         As Byte
   
   ' Standarddaten in den letzten 128 Bytes der Datei auslesen
   CopyMemory udtTag, mabytFile(mlngFileLen - 127), 128
   
   mstrTitle = "": mstrAutor = ""
   mstrAlbum = "": mstrKommentar = ""
   mstrJahr = "":  mstrGenre = ""
   mstrTrack = 0:  mstrGenreNumber = 0
   
   With udtTag
      If UCase(MakeUp(.Tag)) = "TAG" Then
         mstrTitle = MakeUp(.Titel)
         mstrAutor = MakeUp(.Artist)
         mstrAlbum = MakeUp(.Album)
         mstrKommentar = MakeUp(.Kommentar)
         mstrJahr = MakeUp(.Jahr)
         mstrTrack = .Track
         mstrGenre = mastrGenre(.Genre)
         mstrGenreNumber = .Genre
         ' Ausgelesene Daten zur Collection mcolTags hinzufügen
         AddTagToCollection "Titel", "Titel", mstrTitle, abytTemp, "Standard"
         AddTagToCollection "Autor", "Autor", mstrAutor, abytTemp, "Standard"
         AddTagToCollection "Album", "Album", mstrAlbum, abytTemp, "Standard"
         AddTagToCollection "Kommentar", "Kommentar", mstrKommentar, abytTemp, "Standard"
         AddTagToCollection "Jahr", "Jahr", mstrJahr, abytTemp, "Standard"
         AddTagToCollection "Track", "Track", mstrTrack, abytTemp, "Standard"
         AddTagToCollection "Genre", "Genre", mstrGenre, abytTemp, "Standard"
         AddTagToCollection "Genrenummer", "Genrenummer", mstrGenreNumber, abytTemp, "Standard"
      End If
   End With

End Sub

Private Sub GetExtendedInfos()
   Dim objShell            As Object
   Dim objDir              As Object
   Dim objFile             As Object
   Dim i                   As Long
   Dim k                   As Long
   Dim strPath             As String
   Dim strFile             As String
   Dim strValue            As String
   Dim abytTemp(0)         As Byte
   Dim strName             As String
   
   ' Die Shell benutzen, um an Dateiinfos zu kommen
   On Error Resume Next
   
   ' Shellobjekt erzeugen
   Set objShell = CreateObject("Shell.Application")
   
   ' Pfad und Datei aus dem String mstrFileName extrahieren
   strPath = Left(mstrFileName, InStrRev(mstrFileName, "\"))
   strFile = Mid(mstrFileName, InStrRev(mstrFileName, "\") + 1)
   
   Set objDir = objShell.Namespace(LCase(strPath))
   Set objFile = objDir.ParseName(strFile)
   
   For i = 0 To 33
   
      strValue = "": strValue = objDir.GetDetailsOf(objFile, i)
      strName = "": strName = objDir.GetDetailsOf(Null, i)
      If strValue <> "" Then
         If mblnShowShell Then
            ' Ausgelesene Daten zur Collection mcolTags hinzufügen
            AddTagToCollection strName, strName, strValue, abytTemp, "Shell"
         Else
            If InStr(1, "bitrate abtastrate dauer kanäle", _
               LCase(strName), vbTextCompare) Then
               ' Ausgelesene Daten zur Collection mcolTags hinzufügen
               AddTagToCollection strName, strName, strValue, abytTemp, "Shell"
            End If
         End If
      End If
   Next
   
End Sub

Private Function ReadID3Tags() As Boolean
   Dim strRaw              As String
   Dim strPrivate          As String
   Dim lngRaw              As Long
   Dim lngBeginTag         As Long
   Dim strTagname          As String
   Dim strDescription      As String
   Dim strTag              As String
   Dim strTemp             As String
   Dim lngTagsLen          As Long
   Dim lngPos              As Long
   Dim abytTemp()          As Byte
   Dim abytGUID()          As Byte
   Dim lngTemp             As Long
   Dim lngLenTemp          As Long
   Dim lngLenValue         As Long
   Dim lngPrivNr           As Long
   Dim objMatch            As Object
   Dim strID               As String
   
   On Error Resume Next
   ' ID3 V2 Tags auslesen
   
   If (Chr(mabytFile(1)) & Chr(mabytFile(2)) & Chr(mabytFile(3))) <> "ID3" Then Exit Function
   mlngVersion = 0
   lngPos = 1
   
   ' Gesamtlänge der ID3-Tags ermitteln
   lngTagsLen = ID3TagsLen(lngPos + 6)
   
   ' Version ermitteln
   mlngVersion = mabytFile(lngPos + 3)
   strTag = mabytFile(lngPos + 3) & "." & mabytFile(lngPos + 4)
   ReDim abytTemp(0)
   ' und in Collection speichern
   AddTagToCollection "Version", "Version", strTag, abytTemp, "Allgemein"
   
   
   If mabytFile(lngPos + 5) And 2 ^ 5 = 2 ^ 5 Then
      ' Sollte so sein, konnte ich aber noch nicht testen
      ' Extended Header Bit #6 (total tag size - 10)
      lngPos = lngPos + 10
   End If
   lngPos = lngPos + 10
   
   ' Beginn und Ende der Daten errechnen
   mlngBeginData = lngTagsLen + lngPos
   mlngBeginTags = lngPos
   
   Do
      lngBeginTag = lngPos
      strTag = ""
      If mlngVersion = 2 Then
         ' Mustererkennung 3 Zeichen A-Z, a-z, _, 1-9
         mobjRegExp.Pattern = "\w\w\w"
         
         ' 3 Bytes Tagname
         strTagname = Mid(mstrFile, lngPos, 3)
         ' Muster auswerten
         Set objMatch = mobjRegExp.Execute(strTagname)
         If objMatch.Count = 0 Then Exit Do
         lngPos = lngPos + 3
         
         ' 3 Bytes Länge
         lngLenValue = ID3V2Len(lngPos)
         lngPos = lngPos + 4
         
         If (Left(strTagname, 1) = "W") And (Left(strTagname, 2) <> "WX") Then
            ' Taginhalt auslesen (Text, chr(0))
            ' Immer Iso-8859-1, kein Feld Textencryption
            strTag = MakeUp(Mid(mstrFile, lngPos - 1, lngLenValue - 1))
         Else
            ' Taginhalt auslesen (chr(0), Text, chr(0))
            ' 1. Byte Textencryption 0=Iso-8859-1, 1=Unicode
            strTag = MakeUp(Mid(mstrFile, lngPos, lngLenValue - 2))
         End If
         
         ' Gesamten Tag auslesen und im Array speichern
         lngLenTemp = lngLenValue + 6
         ReDim abytTemp(1 To lngLenTemp)
         CopyMemory abytTemp(1), mabytFile(lngBeginTag), lngLenTemp
         
         lngPos = lngPos + lngLenValue - 1
         
      ElseIf mlngVersion >= 3 Then
         ' Mustererkennung 4 Zeichen A-Z, a-z, _, 1-9
         mobjRegExp.Pattern = "\w\w\w\w"
         
         ' 4 Bytes Tagname
         strTagname = Mid(mstrFile, lngPos, 4)
         ' Muster auswerten
         Set objMatch = mobjRegExp.Execute(strTagname)
         If objMatch.Count = 0 Then Exit Do
         lngPos = lngPos + 4
         
         ' 4 Bytes Länge
         lngLenValue = ID3V3Len(lngPos)
         lngPos = lngPos + 6 '+ chr(0), chr(0)
         
         ' Taginhalt auslesen (chr(0), Text)
         ' 1. Byte Textencryption 0=Iso-8859-1, 1=Unicode
         strTag = MakeUp(Mid(mstrFile, lngPos, lngLenValue))
         strRaw = Mid(mstrFile, lngPos, lngLenValue)
         
         ' Gesamten Tag auslesen und im Array speichern
         lngLenTemp = lngLenValue + 10
         ReDim abytTemp(1 To lngLenTemp)
         CopyMemory abytTemp(1), mabytFile(lngBeginTag), lngLenTemp
         
         If strTagname = "PRIV" Then
            ' Private Frames, Datenform beliebig
            strTag = Left(strRaw, InStr(2, strRaw, Chr(0)) - 1)
            lngRaw = lngLenValue - Len(strTag) - 1
         Else
            strTag = MakeUp(strTag)
         End If
         
         lngPos = lngPos + lngLenValue
         
      End If
      
      If lngPos >= lngTagsLen Then
         ' Wenn zufällig über das Ende des Headers
         ' hinausgelesen wird, das Array mit den Rohdaten kürzen
         ReDim Preserve abytTemp(1 To mlngBeginData - lngBeginTag)
      End If
      
      ' Beschreibung zum 3- oder 4-stelligen Tagnamen holen
      strDescription = strTagname
      strDescription = mcolTranslate(strTagname)(2)
      
      If strTagname <> "" Then
         
         If strTagname = "PRIV" Then
            ' Private Frames
            ' Frametyp als Nullterminierter Text werten, anschl. Daten
            lngPrivNr = lngPrivNr + 1
            strDescription = strDescription & " Nr.:" & lngPrivNr
            
            If LCase(strTag) = LCase("WM/MediaClassPrimaryID") Then
               ' "D1607DBC-E323-4BE2-86A1-48A42A28441E"
               ' Use for music files. Do not use for audio that is not music.
               ' "01CD0F29-DA4E-4157-897B-6275D50C4F11"
               ' Use for audio files that are not music
               abytGUID = StrConv(Right(strRaw, 16), vbFromUnicode)
               strID = BytesToGUIDString(abytGUID)
               strTag = strTag & " = " & strID
            Else
               strTag = strTag & " = " & lngRaw & " Bytes Daten"
            End If
            
         End If
         
         ' Den Tag zur Collection hinzufügen
         AddTagToCollection strDescription, strTagname, strTag, abytTemp, "ID3"
         
      End If
      
   Loop While lngPos < lngTagsLen
   
   ReadID3Tags = True
   
End Function

Public Function WriteStandardTags( _
   Optional Titel As String, _
   Optional Autor As String, _
   Optional Album As String, _
   Optional Kommentar As String, _
   Optional Track As String, _
   Optional Jahr As String, _
   Optional Genre As String _
   ) As Boolean
   ' Standarddaten zurückschreiben
   Dim udtTag              As MP3Tag
   
   On Error Resume Next
   
   Err.Clear
   
   Call ReadFile
   
   If mlngFileLen = 0 Then Exit Function
   
   If LCase(Mid(mstrFile, mlngFileLen - 127, 3)) = "tag" Then
      CopyMemory udtTag, mabytFile(mlngFileLen - 127), 128
   End If   

   With udtTag
   
      If Titel <> "" Then .Titel = Trim(Titel)
      If Autor <> "" Then .Artist = Trim(Autor)
      If Album <> "" Then .Album = Trim(Album)
      If Kommentar <> "" Then .Kommentar = Trim(Kommentar)
      If (Track <> "") And (IsNumeric(Track)) Then
         .Track = CByte(Track)
      End If
      If (Genre <> "") And (IsNumeric(Genre)) Then
         .Genre = CByte(Genre)
      End If
      If (Jahr <> "") And (IsNumeric(Jahr)) Then
         .Jahr = Left(Jahr, 4)
      End If
      
      If UCase(.Tag) = "TAG" Then
         ' Es sind bereits Tags vorhanden
         CopyMemory mabytFile(mlngFileLen - 127), udtTag, 128
      Else
         .Tag = "TAG"
         ' Tags neu anlegen
         ReDim Preserve mabytFile(1 To mlngFileLen + 128)
         CopyMemory mabytFile(mlngFileLen + 1), udtTag, 128
         mlngFileLen = mlngFileLen + 128
      End If
      
   End With

   SaveFile mabytFile

   ' Ergebnis zurückgeben
   If Err.Number = 0 Then WriteStandardTags = True
   
End Function


' ID3 zurückschreiben Lyricist
Public Function WriteID3Tags( _
   Optional Title As StringOptional Comments As String, _
   Optional ContentType As StringOptional LinkedInformation As String, _
   Optional Composer As StringOptional EncodedBy As String, _
   Optional Lyricist As StringOptional LyricistTextWriter As String, _
   Optional OrigLyricsTextWriter As StringOptional Conductor As String, _
   Optional TrackNumber As StringOptional Publisher As String, _
   Optional InvolvedPeople As StringOptional Popularimeter As String, _
   Optional AlbumTitle As StringOptional CopyrightMessage As String, _
   Optional LeadPerformer As StringOptional BandOrchestra As String, _
   Optional RecordingDates As StringOptional YearPublishing As String, _
   Optional ModifiedBy As StringOptional PublishersWebpage As String, _
   Optional AudioSourceWebpage As StringOptional ArtistWebpage As String, _
   Optional AudioFileWebpage As StringOptional BuyCDWebpage As String, _
   Optional TextInformation As String _
   ) As Boolean

   Dim abytTemp()          As Byte
   Dim abytResult()        As Byte
   Dim abytHeader()        As Byte
   Dim varTemp             As Variant
   Dim i                   As Long
   Dim lngLen              As Long
   Dim lngHeader           As Long
   Dim blnNewHeader        As Boolean
   On Error Resume Next
   
   Call ReadFile
   
   If mlngFileLen = 0 Then Exit Function
   
   Set mcolTags = New Collection
   
   ReDim abytPreHeader(0)
   
   If ReadID3Tags() = False Then
      mlngVersion = 3
      blnNewHeader = True
   End If
   
   Err.Clear
   
   If Title <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TAL", "TIT2"), Title
   If Comments <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "COM", "COMM"), Comments
   If ContentType <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TCO", "TCON"), ContentType
   If LinkedInformation <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "LNK", "LINK"), LinkedInformation
   If Composer <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TCM", "TCOM"), Composer
   If EncodedBy <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TEN", "TENC"), EncodedBy
   If Lyricist <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "ULT", "USLT"), Lyricist
   If LyricistTextWriter <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TXT", "TEXT"), LyricistTextWriter
   If OrigLyricsTextWriter <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TOL", "TOLY"), OrigLyricsTextWriter
   If Conductor <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TP3", "TPE3"), Conductor
   If TrackNumber <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TRK", "TRCK"), TrackNumber
   If Publisher <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TPB", "TPUB"), Publisher
   If InvolvedPeople <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "IPL", "IPLS"), InvolvedPeople
   If Popularimeter <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "POP", "POPM"), Popularimeter
   If AlbumTitle <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TAL", "TALB"), AlbumTitle
   If CopyrightMessage <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TCR", "TCOP"), CopyrightMessage
   If LinkedInformation <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "LNK", "LINK"), LinkedInformation
   If LeadPerformer <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TP1", "TPE1"), LeadPerformer
   If BandOrchestra <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TP2", "TPE2"), BandOrchestra
   If RecordingDates <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TRD", "TRDA"), RecordingDates
   If YearPublishing <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TYE", "TYER"), YearPublishing
   If ModifiedBy <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TP4", "TPE4"), ModifiedBy
   If PublishersWebpage <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "WPB", "WPUB"), PublishersWebpage
   If ArtistWebpage <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "WAR", "WOAR"), ArtistWebpage
   If AudioFileWebpage <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "WAF", "WOAF"), AudioFileWebpage
   If AudioSourceWebpage <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "WAS", "WOAS"), AudioSourceWebpage
   If BuyCDWebpage <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "WCM", "WCOM"), BuyCDWebpage
   If TextInformation <> "" Then _
      RemoveAddID3 "WriteID3", IIf(mlngVersion = 2, "TXX", "TXXX"), TextInformation
      
   i = 1
   For Each varTemp In mcolTags
      lngLen = 0
      abytTemp = varTemp("Raw")
      lngLen = UBound(abytTemp)
      If lngLen > 1 Then
         ReDim Preserve abytHeader(1 To i + lngLen - 1)
         CopyMemory abytHeader(i), abytTemp(1), lngLen
         i = i + lngLen
      End If
   Next
   
   lngHeader = UBound(abytHeader)
   
   If blnNewHeader Then
      ReDim abytResult(1 To lngHeader + mlngFileLen + 10)
      ' Tagheader in Array abytResult einfügen
      abytResult(1) = Asc("I"): abytResult(2) = Asc("D"): abytResult(3) = Asc("3")
      abytResult(4) = 3: abytResult(5) = 0 ' Version 3.0
      ' Gesamtlänge Tags berechnen und in Array abytResult einfügen
      ReDim abytTemp(3): ID3TagsLenToByteArray abytTemp, lngHeader
      CopyMemory abytResult(7), abytTemp(0), 4
      'Taginhalt in Array abytResult einfügen
      CopyMemory abytResult(11), abytHeader(1), lngHeader
      ' Restliche Daten der Originaldatei in Array abytResult einfügen
      CopyMemory abytResult(10 + lngHeader), mabytFile(1), mlngFileLen
   Else
      ReDim abytResult(1 To lngHeader + mlngBeginTags + mlngFileLen - mlngBeginData)
      ' Tagheader in Array abytResult einfügen
      CopyMemory abytResult(1), mabytFile(1), mlngBeginTags - 1
      ' Gesamtlänge Tags berechnen und in Array abytResult einfügen
      i = lngHeader + mlngBeginTags
      ReDim abytTemp(3): ID3TagsLenToByteArray abytTemp, i
      CopyMemory abytResult(7), abytTemp(0), 4
      'Taginhalt in Array abytResult einfügen
      CopyMemory abytResult(mlngBeginTags), abytHeader(1), lngHeader
      ' Restliche Daten der Originaldatei in Array abytResult einfügen
      CopyMemory abytResult(i), mabytFile(mlngBeginData), mlngFileLen - mlngBeginData + 1
   End If
   
   SaveFile abytResult
   
   If Err.Number = 0 Then WriteID3Tags = True
   
End Function

Private Sub RemoveAddID3( _
   strSource As String, _
   strTagname As String, _
   strValue As String)
   Dim colTemp          As New Collection
   Dim abytTemp()       As Byte
   Dim abytName()       As Byte
   Dim abytValue()      As Byte
   Dim abytLen()        As Byte
   Dim lngNameLen       As Long
   Dim lngValueLen      As Long
   Dim lngLen           As Long
   Dim strDescription   As String
   On Error Resume Next
   
   strDescription = strTagname
   strDescription = mcolTranslate(strTagname)(2)
   lngNameLen = Len(strTagname)
   
   abytValue = StrConv(Chr(0) & strValue & Chr(0), vbFromUnicode)
   abytName = StrConv(strTagname, vbFromUnicode)
   
   If Left(strTagname, 2) = "TX" Then
      lngLen = Len(strValue) * 2 + 8
      ReDim abytValue(lngLen - 1)
      ' Textencryption Unicode
      abytValue(0) = 1
      ' Bytefolge Unicode festlegen
      abytValue(1) = 255
      abytValue(2) = 254
      ' Kein Descriptor, deshalb Terminierungszeichen 00
      abytValue(3) = 0
      abytValue(4) = 0
      ' Bytefolge Unicode für folgenden Text festlegen
      abytValue(5) = 255
      abytValue(6) = 254
      abytTemp = strValue & Chr(0)
      CopyMemory abytValue(7), abytTemp(0), UBound(abytTemp) + 1
      
   ElseIf (Left(strTagname, 1) = "W") And _
      (Mid(strTagname, 2, 1) <> "X") Then
      ' Internetadressen, Textencryption immer Iso-8859-1,
      ' deshalb auch kein Feld Textencryption
      abytValue = StrConv(strValue & Chr(0), vbFromUnicode)
      
   ElseIf Left(strTagname, 1) = "T" Then
      ' Textfelder
      lngLen = Len(strValue) * 2 + 5
      ReDim abytValue(lngLen - 1)
      ' Textencryption Unicode
      abytValue(0) = 1
      ' Bytefolge Unicode für nachfolgenden Text festlegen
      abytValue(1) = 255: abytValue(2) = 254
      abytTemp = strValue
      CopyMemory abytValue(3), abytTemp(0), UBound(abytTemp) + 1
      
   ElseIf (strTagname = "USLT") Or (strTagname = "ULT") _
      Or (strTagname = "COMM") Or (strTagname = "COM") Then
      lngLen = Len(strValue) * 2 + 12
      ReDim abytValue(lngLen - 1)
      ' Textencryption Unicode
      abytValue(0) = 1
      ' Sprache
      abytValue(1) = Asc("e")
      abytValue(2) = Asc("n")
      abytValue(3) = Asc("g")
      ' Bytefolge Unicode festlegen
      abytValue(4) = 255
      abytValue(5) = 254
      ' Kein Descriptor, deshalb Terminierungszeichen 00
      abytValue(6) = 0
      abytValue(7) = 0
      ' Bytefolge Unicode für folgenden Text festlegen
      abytValue(8) = 255
      abytValue(9) = 254
      abytTemp = strValue & Chr(0)
      CopyMemory abytValue(10), abytTemp(0), UBound(abytTemp) + 1
         
   End If
   lngLen = UBound(abytValue) + 1
   
   If mlngVersion = 2 Then
      ReDim abytLen(2)
      ID3V2LenToByteArray abytLen, lngLen
      ReDim abytTemp(1 To 3 + 3 + lngLen)
      CopyMemory abytTemp(1), abytName(0), 3
      CopyMemory abytTemp(4), abytLen(0), 3
      CopyMemory abytTemp(7), abytValue(0), lngLen
   Else
      ReDim abytLen(3)
      ID3V3LenToByteArray abytLen, lngLen + 1
      ReDim abytTemp(1 To 4 + 6 + lngLen + 1)
      CopyMemory abytTemp(1), abytName(0), 4
      CopyMemory abytTemp(5), abytLen(0), 4
      CopyMemory abytTemp(11), abytValue(0), lngLen
   End If
   
   colTemp.Add strDescription, "Name"
   colTemp.Add strValue, "Value"
   colTemp.Add strSource, "Source"
   colTemp.Add abytTemp, "Raw"
   colTemp.Add strTagname, "OrigName"
   
   mcolTags.Remove strTagname
   mcolTags.Remove strTagname & "ID3"
   mcolTags.Add colTemp, strTagname & "ID3"
   
   Err.Clear
   
End Sub

Private Sub ReadFile()
   Dim FF                  As Long
   On Error Resume Next

   Err.Clear
   
   mlngFileLen = 0
   Set mcolTags = New Collection
   
   FF = FreeFile
   
   ' .mp3 Datei öffnen und Inhalt auslesen
   Open mstrFileName For Binary As #FF
      mlngFileLen = LOF(FF)
      ReDim Preserve mabytFile(1 To mlngFileLen)
      Get #FF, , mabytFile
   Close ' .mp3 Datei Schließen
   
   mstrFile = StrConv(mabytFile, vbUnicode)
End Sub

Private Sub SaveFile(abytFile() As Byte)
   Dim FF                  As Long
   On Error Resume Next
   Err.Clear
   If mblnSik Then
      ' Sicherheitskopie mit der Endung sik anlegen
      Name mstrFileName As Left(mstrFileName, Len(mstrFileName) - 3) & "sik"
      If Err.Number = 58 Then
         Err.Clear
         ' Vorhandene mit gleichem Namen löschen
         Kill mstrFileName & ".sik"
         ' Sicherheitskopie mit der Endung sic anlegen
         Name mstrFileName As mstrFileName & ".sik"
      End If
   Else
      Kill mstrFileName
      ' Original wird gelöscht
   End If
   
   FF = FreeFile
   ' MP3 Datei öffnen/anlegen und Inhalt speichern
   Open mstrFileName For Binary As #FF
      Put #FF, , abytFile
   Close ' MP3 Datei Schließen

End Sub

Private Sub AddTagToCollection( _
   strOut As String, _
   strOrig As String, _
   strValue As String, _
   abytTemp() As Byte, _
   strSource As String)
   
   Dim colTemp As New Collection
   
   ' Werte in temporärer Collection speichern
   colTemp.Add strOut, "Name"
   colTemp.Add strOrig, "OrigName"
   colTemp.Add strValue, "Value"
   colTemp.Add abytTemp, "Raw"
   colTemp.Add strSource, "Source"
   
   ' temporäre Collection in modulweit gültige speichern
   If mblnDisableCopies Then
      ' Tags mit gleichen Originalnamen verhindern,
      ' unabhängig von der Quelle
      mcolTags.Add colTemp, strOrig
   Else
      ' Tags mit gleichen Originalnamen, aber
      ' unterschiedlicher Quelle zulassen
      mcolTags.Add colTemp, strOrig & strSource
   End If
End Sub

' Keine doppelten Tags zulassen (Kann vorkommen, wenn die
' Schell benutzt wird und Standardwerte ausgelesen werden)
Public Property Let KeineDoppeltenTags(ByVal vNewValue As Boolean)
  mblnDisableCopies = vNewValue
End Property

' Standardtags
Public Property Let ShowStandard(ByVal vNewValue As Boolean)
  mblnShowStandard = vNewValue
End Property

' Shellinfos
Public Property Let ShowShell(ByVal vNewValue As Boolean)
  mblnShowShell = vNewValue
End Property

' ID3 Tags zulassen
Public Property Let ShowID3(ByVal vNewValue As Boolean)
  mblnShowID3 = vNewValue
End Property

' Dateiname übergeben
Public Property Let Filename(ByVal vNewValue As String)
  mstrFileName = vNewValue
End Property

' Wert (0-255) übergeben, Genre zurückgeben
Public Function GetGenreByNum(bytNumber As ByteAs String
   On Error Resume Next
   GetGenreByNum = bytNumber
   GetGenreByNum = mastrGenre(bytNumber)
End Function

Private Function ID3TagsLenToByteArray(abytTemp() As ByteByVal lngLen As Long)
   ' Longwert in Array mit anderer Byteorder umwandeln
   abytTemp(0) = lngLen \ &H200000: lngLen = lngLen - abytTemp(0) * &H200000
   abytTemp(1) = lngLen \ &H4000: lngLen = lngLen - abytTemp(1) * &H4000
   abytTemp(2) = lngLen \ &H80: lngLen = lngLen - abytTemp(2) * &H80
   abytTemp(3) = lngLen
End Function

Private Function ID3TagsLen(ByVal lngPos As LongAs Long
   ' Das jeweils höchstwertigste Bit zählt nicht
   ID3TagsLen = _
        CLng(mabytFile(lngPos)) * 2097152 _
      + CLng(mabytFile(lngPos + 1)) * 16384& _
      + CLng(mabytFile(lngPos + 2)) * 128& _
      + CLng(mabytFile(lngPos + 3))
End Function

Private Function ID3V3LenToByteArray(abytTemp() As ByteByVal lngLen As Long)
   ' Longwert in Array mit anderer Byteorder umwandeln (Version 3, 4 Bytes)
   abytTemp(0) = lngLen \ 16384&: lngLen = lngLen - abytTemp(0) * 16384&
   abytTemp(1) = lngLen \ 2048&: lngLen = lngLen - abytTemp(1) * 2048&
   abytTemp(2) = lngLen \ 256&: lngLen = lngLen - abytTemp(2) * 256&
   abytTemp(3) = lngLen
End Function
Private Function ID3V2LenToByteArray(abytTemp() As ByteByVal lngLen As Long)
   ' Longwert in Array mit anderer Byteorder umwandeln (Version 2, 3 Bytes)
   abytTemp(0) = lngLen \ 2048&: lngLen = lngLen - abytTemp(0) * 2048&
   abytTemp(1) = lngLen \ 256&: lngLen = lngLen - abytTemp(1) * 256&
   abytTemp(2) = lngLen
End Function

Private Function ID3V3Len(ByVal lngPos As LongAs Long
   ' Andere Byteorder
   ID3V3Len = _
        CLng(mabytFile(lngPos)) * 16384& _
      + CLng(mabytFile(lngPos + 1)) * 2048& _
      + CLng(mabytFile(lngPos + 2)) * 256& _
      + CLng(mabytFile(lngPos + 3))
End Function
Private Function ID3V2Len(ByVal lngPos As LongAs Long
   ' Andere Byteorder
   ID3V2Len = _
        CLng(mabytFile(lngPos)) * 2048& _
      + CLng(mabytFile(lngPos + 1)) * 256& _
      + CLng(mabytFile(lngPos + 2))
End Function

Private Function MakeUp(ByVal strText As StringAs String
   On Error Resume Next
   Dim varDummy      As Variant
   Dim i             As Long
   
   ' Führendes Zeichen mit Code 0 entfernen
   If Left(strText, 1) = Chr(0) Then strText = Mid(strText, 2)
   ' Führendes Zeichen mit Code 1 entfernen
   If Left(strText, 1) = Chr(1) Then strText = Mid(strText, 2)
   
   ' Unicodeanteile bearbeiten
   varDummy = Split(strText, Chr(255) & Chr(254))
   strText = varDummy(0)
   For i = 1 To UBound(varDummy)
      strText = strText & StrConv(varDummy(i), vbFromUnicode)
   Next
   
   ' Zeichen mit Code 0 in Leerzeichen umwandeln
   MakeUp = Trim(Replace(strText, Chr(0), " "))
   
   ' Kennung Sprache (eng) entfernen
   If Left(MakeUp, 3) = "eng" Then MakeUp = Trim(Mid(MakeUp, 4))
   
End Function

Private Sub Class_Initialize()
   ' Objekt zur Mustererkennung von Zeichenfolgen anlegen
   Set mobjRegExp = CreateObject("vbscript.regexp")
   CreateGenre
   CreateID3
   mblnSik = True
   mblnShowStandard = True
   mblnShowShell = True
   mblnShowID3 = True
End Sub

Private Sub CreateID3()
   Dim colTemp                As Collection
   Dim astrTemp(1 To 2, 137)  As String
   Dim i                      As Long
   
   ' Version 3-4
   astrTemp(1, 1) = "AENC": astrTemp(2, 1) = "Audio encryption"
   astrTemp(1, 2) = "APIC": astrTemp(2, 2) = "Attached picture"
   astrTemp(1, 3) = "COMM": astrTemp(2, 3) = "Comments"
   astrTemp(1, 4) = "COMR": astrTemp(2, 4) = "Commercial frame"
   astrTemp(1, 5) = "ENCR": astrTemp(2, 5) = "Encryption method registration"
   astrTemp(1, 6) = "EQUA": astrTemp(2, 6) = "Equalization"
   astrTemp(1, 7) = "ETCO": astrTemp(2, 7) = "Event timing codes"
   astrTemp(1, 8) = "GEOB": astrTemp(2, 8) = "General encapsulated object"
   astrTemp(1, 9) = "GRID": astrTemp(2, 9) = "Group identification registration"
   astrTemp(1, 10) = "IPLS": astrTemp(2, 10) = "Involved people list"
   astrTemp(1, 11) = "LINK": astrTemp(2, 11) = "Linked information"
   astrTemp(1, 12) = "MCDI": astrTemp(2, 12) = "Music CD identifier"
   astrTemp(1, 13) = "MLLT": astrTemp(2, 13) = "MPEG location lookup table"
   astrTemp(1, 14) = "OWNE": astrTemp(2, 14) = "Ownership frame"
   astrTemp(1, 15) = "PRIV": astrTemp(2, 15) = "Private frame"
   astrTemp(1, 16) = "PCNT": astrTemp(2, 16) = "Play counter"
   astrTemp(1, 17) = "POPM": astrTemp(2, 17) = "Popularimeter"
   astrTemp(1, 18) = "POSS": astrTemp(2, 18) = "Position synchronisation frame"
   astrTemp(1, 19) = "RBUF": astrTemp(2, 19) = "Recommended buffer size"
   astrTemp(1, 20) = "RVAD": astrTemp(2, 20) = "Relative volume adjustment"
   astrTemp(1, 21) = "RVRB": astrTemp(2, 21) = "Reverb"
   astrTemp(1, 22) = "SYLT": astrTemp(2, 22) = "Synchronized lyric/text"
   astrTemp(1, 23) = "SYTC": astrTemp(2, 23) = "Synchronized tempo codes"
   astrTemp(1, 24) = "TALB": astrTemp(2, 24) = "Album/Movie/Show title"
   astrTemp(1, 25) = "TBPM": astrTemp(2, 25) = "BPM (beats per minute)"
   astrTemp(1, 26) = "TCOM": astrTemp(2, 26) = "Composer"
   astrTemp(1, 27) = "TCON": astrTemp(2, 27) = "Content type"
   astrTemp(1, 28) = "TCOP": astrTemp(2, 28) = "Copyright message"
   astrTemp(1, 29) = "TDAT": astrTemp(2, 29) = "Date"
   astrTemp(1, 30) = "TDLY": astrTemp(2, 30) = "Playlist delay"
   astrTemp(1, 31) = "TENC": astrTemp(2, 31) = "Encoded by"
   astrTemp(1, 32) = "TEXT": astrTemp(2, 32) = "Lyricist/Text writer"
   astrTemp(1, 33) = "TFLT": astrTemp(2, 33) = "File type"
   astrTemp(1, 34) = "TIME": astrTemp(2, 34) = "Time"
   astrTemp(1, 35) = "TIT1": astrTemp(2, 35) = "Content group description"
   astrTemp(1, 36) = "TIT2": astrTemp(2, 36) = "Title/songname/content description"
   astrTemp(1, 37) = "TIT3": astrTemp(2, 37) = "Subtitle/Description refinement"
   astrTemp(1, 38) = "TKEY": astrTemp(2, 38) = "Initial key"
   astrTemp(1, 39) = "TLAN": astrTemp(2, 39) = "Language(s)"
   astrTemp(1, 40) = "TLEN": astrTemp(2, 40) = "Length"
   astrTemp(1, 41) = "TMED": astrTemp(2, 41) = "Media type"
   astrTemp(1, 42) = "TOAL": astrTemp(2, 42) = "Original album/movie/show title"
   astrTemp(1, 43) = "TOFN": astrTemp(2, 43) = "Original filename"
   astrTemp(1, 44) = "TOLY": astrTemp(2, 44) = "Original lyricist(s)/text writer(s)"
   astrTemp(1, 45) = "TOPE": astrTemp(2, 45) = "Original artist(s)/performer(s)"
   astrTemp(1, 46) = "TORY": astrTemp(2, 46) = "Original release year"
   astrTemp(1, 47) = "TOWN": astrTemp(2, 47) = "File owner/licensee"
   astrTemp(1, 48) = "TPE1": astrTemp(2, 48) = "Lead performer(s)/Soloist(s)"
   astrTemp(1, 49) = "TPE2": astrTemp(2, 49) = "Band/orchestra/accompaniment"
   astrTemp(1, 50) = "TPE3": astrTemp(2, 50) = "Conductor/performer refinement"
   astrTemp(1, 51) = "TPE4": astrTemp(2, 51) = "Interpreted, remixed, or otherwise modified by"
   astrTemp(1, 52) = "TPOS": astrTemp(2, 52) = "Part of a set"
   astrTemp(1, 53) = "TPUB": astrTemp(2, 53) = "Publisher"
   astrTemp(1, 54) = "TRCK": astrTemp(2, 54) = "Track number/Position in set"
   astrTemp(1, 55) = "TRDA": astrTemp(2, 55) = "Recording dates"
   astrTemp(1, 56) = "TRSN": astrTemp(2, 56) = "Internet radio station name"
   astrTemp(1, 57) = "TRSO": astrTemp(2, 57) = "Internet radio station owner"
   astrTemp(1, 58) = "TSIZ": astrTemp(2, 58) = "Size"
   astrTemp(1, 59) = "TSRC": astrTemp(2, 59) = "ISRC (international standard recording code)"
   astrTemp(1, 60) = "TSSE": astrTemp(2, 60) = "Software/Hardware and settings used for encoding"
   astrTemp(1, 61) = "TYER": astrTemp(2, 61) = "Year"
   astrTemp(1, 62) = "TXXX": astrTemp(2, 62) = "User defined text information frame"
   astrTemp(1, 63) = "UFID": astrTemp(2, 63) = "Unique file identifier"
   astrTemp(1, 64) = "USER": astrTemp(2, 64) = "Terms of use"
   astrTemp(1, 65) = "USLT": astrTemp(2, 65) = "Unsychronized lyric/text transcription"
   astrTemp(1, 66) = "WCOM": astrTemp(2, 66) = "Commercial information"
   astrTemp(1, 67) = "WCOP": astrTemp(2, 67) = "Copyright/Legal information"
   astrTemp(1, 68) = "WOAF": astrTemp(2, 68) = "Official audio file webpage"
   astrTemp(1, 69) = "WOAR": astrTemp(2, 69) = "Official artist/performer webpage"
   astrTemp(1, 70) = "WOAS": astrTemp(2, 70) = "Official audio source webpage"
   astrTemp(1, 71) = "WORS": astrTemp(2, 71) = "Official internet radio station homepage"
   astrTemp(1, 72) = "WPAY": astrTemp(2, 72) = "Payment"
   astrTemp(1, 73) = "WPUB": astrTemp(2, 73) = "Publishers official webpage"
   astrTemp(1, 74) = "WXXX": astrTemp(2, 74) = "User defined URL link frame"
   ' Version 2
   astrTemp(1, 75) = "BUF": astrTemp(2, 75) = "Recommended buffer size"
   astrTemp(1, 76) = "CNT": astrTemp(2, 76) = "Play counter"
   astrTemp(1, 77) = "COM": astrTemp(2, 77) = "Comments"
   astrTemp(1, 78) = "CRA": astrTemp(2, 78) = "Audio encryption"
   astrTemp(1, 79) = "CRM": astrTemp(2, 79) = "Encrypted meta frame"
   astrTemp(1, 80) = "ETC": astrTemp(2, 80) = "Event timing codes"
   astrTemp(1, 81) = "EQU": astrTemp(2, 81) = "Equalization"
   astrTemp(1, 82) = "GEO": astrTemp(2, 82) = "General encapsulated object"
   astrTemp(1, 83) = "IPL": astrTemp(2, 83) = "Involved people list"
   astrTemp(1, 84) = "LNK": astrTemp(2, 84) = "Linked information"
   astrTemp(1, 85) = "MCI": astrTemp(2, 85) = "Music CD Identifier"
   astrTemp(1, 86) = "MLL": astrTemp(2, 86) = "MPEG location lookup table"
   astrTemp(1, 87) = "PIC": astrTemp(2, 87) = "Attached picture"
   astrTemp(1, 88) = "POP": astrTemp(2, 88) = "Popularimeter"
   astrTemp(1, 89) = "REV": astrTemp(2, 89) = "Reverb"
   astrTemp(1, 90) = "RVA": astrTemp(2, 90) = "Relative volume adjustment"
   astrTemp(1, 91) = "SLT": astrTemp(2, 91) = "Synchronized lyric/text"
   astrTemp(1, 92) = "STC": astrTemp(2, 92) = "Synced tempo codes"
   astrTemp(1, 93) = "TAL": astrTemp(2, 93) = "Album/Movie/Show title"
   astrTemp(1, 94) = "TBP": astrTemp(2, 94) = "BPM (Beats Per Minute)"
   astrTemp(1, 95) = "TCM": astrTemp(2, 95) = "Composer"
   astrTemp(1, 96) = "TCO": astrTemp(2, 96) = "Content type"
   astrTemp(1, 97) = "TCR": astrTemp(2, 97) = "Copyright message"
   astrTemp(1, 98) = "TDA": astrTemp(2, 98) = "Date"
   astrTemp(1, 99) = "TDY": astrTemp(2, 99) = "Playlist delay"
   astrTemp(1, 100) = "TEN": astrTemp(2, 100) = "Encoded by"
   astrTemp(1, 101) = "TFT": astrTemp(2, 101) = "File type"
   astrTemp(1, 102) = "TIM": astrTemp(2, 102) = "Time"
   astrTemp(1, 103) = "TKE": astrTemp(2, 103) = "Initial key"
   astrTemp(1, 104) = "TLA": astrTemp(2, 104) = "Language(s)"
   astrTemp(1, 105) = "TLE": astrTemp(2, 105) = "Length"
   astrTemp(1, 106) = "TMT": astrTemp(2, 106) = "Media type"
   astrTemp(1, 107) = "TOA": astrTemp(2, 107) = "Original artist(s)/performer(s)"
   astrTemp(1, 108) = "TOF": astrTemp(2, 108) = "Original filename"
   astrTemp(1, 109) = "TOL": astrTemp(2, 109) = "Original Lyricist(s)/text writer(s)"
   astrTemp(1, 110) = "TOR": astrTemp(2, 110) = "Original release year"
   astrTemp(1, 111) = "TOT": astrTemp(2, 111) = "Original album/Movie/Show title"
   astrTemp(1, 112) = "TP1": astrTemp(2, 112) = "Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group"
   astrTemp(1, 113) = "TP2": astrTemp(2, 113) = "Band/Orchestra/Accompaniment"
   astrTemp(1, 114) = "TP3": astrTemp(2, 114) = "Conductor/Performer refinement"
   astrTemp(1, 115) = "TP4": astrTemp(2, 115) = "Interpreted, remixed, or otherwise modified by"
   astrTemp(1, 116) = "TPA": astrTemp(2, 116) = "Part of a set"
   astrTemp(1, 117) = "TPB": astrTemp(2, 117) = "Publisher"
   astrTemp(1, 118) = "TRC": astrTemp(2, 118) = "ISRC (International Standard Recording Code)"
   astrTemp(1, 119) = "TRD": astrTemp(2, 119) = "Recording dates"
   astrTemp(1, 120) = "TRK": astrTemp(2, 120) = "Track number/Position in set"
   astrTemp(1, 121) = "TSI": astrTemp(2, 121) = "Size"
   astrTemp(1, 122) = "TSS": astrTemp(2, 122) = "Software/hardware and settings used for encoding"
   astrTemp(1, 123) = "TT1": astrTemp(2, 123) = "Content group description"
   astrTemp(1, 124) = "TT2": astrTemp(2, 124) = "Title/Songname/Content description"
   astrTemp(1, 125) = "TT3": astrTemp(2, 125) = "Subtitle/Description refinement"
   astrTemp(1, 126) = "TXT": astrTemp(2, 126) = "Lyricist/text writer"
   astrTemp(1, 127) = "TXX": astrTemp(2, 127) = "User defined text information frame"
   astrTemp(1, 128) = "TYE": astrTemp(2, 128) = "Year"
   astrTemp(1, 129) = "UFI": astrTemp(2, 129) = "Unique file identifier"
   astrTemp(1, 130) = "ULT": astrTemp(2, 130) = "Unsychronized lyric/text transcription"
   astrTemp(1, 131) = "WAF": astrTemp(2, 131) = "Official audio file webpage"
   astrTemp(1, 132) = "WAR": astrTemp(2, 132) = "Official artist/performer webpage"
   astrTemp(1, 133) = "WAS": astrTemp(2, 133) = "Official audio source webpage"
   astrTemp(1, 134) = "WCM": astrTemp(2, 134) = "Commercial information"
   astrTemp(1, 135) = "WCP": astrTemp(2, 135) = "Copyright/Legal information"
   astrTemp(1, 136) = "WPB": astrTemp(2, 136) = "Publishers official webpage"
   astrTemp(1, 137) = "WXX": astrTemp(2, 137) = "User defined URL link frame"
   
   For i = 1 To UBound(astrTemp, 2)
      Set colTemp = New Collection
      colTemp.Add astrTemp(1, i), "Name"
      colTemp.Add astrTemp(2, i), "Description"
      mcolTranslate.Add colTemp, CStr(astrTemp(1, i))
   Next
End Sub

Private Sub CreateGenre()
   mastrGenre(0) = "Blues"
   mastrGenre(1) = "Classic Rock"
   mastrGenre(2) = "Country"
   mastrGenre(3) = "Dance"
   mastrGenre(4) = "Disco"
   mastrGenre(5) = "Funk"
   mastrGenre(6) = "Grunge"
   mastrGenre(7) = "Hip-Hop"
   mastrGenre(8) = "Jazz"
   mastrGenre(9) = "Metal"
   mastrGenre(10) = "New Age"
   mastrGenre(11) = "Oldies"
   mastrGenre(12) = "Other"
   mastrGenre(13) = "Pop"
   mastrGenre(14) = "R&B"
   mastrGenre(15) = "Rap"
   mastrGenre(16) = "Reggae"
   mastrGenre(17) = "Rock"
   mastrGenre(18) = "Techno"
   mastrGenre(19) = "Industrial"
   mastrGenre(20) = "Alternative"
   mastrGenre(21) = "Ska"
   mastrGenre(22) = "Death Metal"
   mastrGenre(23) = "Pranks"
   mastrGenre(24) = "Soundtrack"
   mastrGenre(25) = "Euro-Techno"
   mastrGenre(26) = "Ambient"
   mastrGenre(27) = "Trip-Hop"
   mastrGenre(28) = "Vocal"
   mastrGenre(29) = "Jazz&Funk"
   mastrGenre(30) = "Fusion"
   mastrGenre(31) = "Trance"
   mastrGenre(32) = "Classical"
   mastrGenre(33) = "Instrumental"
   mastrGenre(34) = "Acid"
   mastrGenre(35) = "House"
   mastrGenre(36) = "Game"
   mastrGenre(37) = "Sound Clip"
   mastrGenre(38) = "Gospel"
   mastrGenre(39) = "Noise"
   mastrGenre(40) = "Alternative Rock"
   mastrGenre(41) = "Bass"
   mastrGenre(42) = "Soul"
   mastrGenre(43) = "Punk"
   mastrGenre(44) = "Space"
   mastrGenre(45) = "Meditative"
   mastrGenre(46) = "Instrumental Pop"
   mastrGenre(47) = "Instrumental Rock"
   mastrGenre(48) = "Ethnic"
   mastrGenre(49) = "Gothic"
   mastrGenre(50) = "Darkwave"
   mastrGenre(51) = "Techno-Industrial"
   mastrGenre(52) = "Electronic"
   mastrGenre(53) = "Pop-Folk"
   mastrGenre(54) = "Eurodance"
   mastrGenre(55) = "Dream"
   mastrGenre(56) = "Southern Rock"
   mastrGenre(57) = "Comedy"
   mastrGenre(58) = "Cult"
   mastrGenre(59) = "Gangsta"
   mastrGenre(60) = "Top 40"
   mastrGenre(61) = "Christian Rap"
   mastrGenre(62) = "Pop/Funk"
   mastrGenre(63) = "Jungle"
   mastrGenre(64) = "Native US"
   mastrGenre(65) = "Cabaret"
   mastrGenre(66) = "New Wave"
   mastrGenre(67) = "Psychedelic"
   mastrGenre(68) = "Rave"
   mastrGenre(69) = "Showtunes"
   mastrGenre(70) = "Trailer"
   mastrGenre(71) = "Lo-Fi"
   mastrGenre(72) = "Tribal"
   mastrGenre(73) = "Acid Punk"
   mastrGenre(74) = "Acid Jazz"
   mastrGenre(75) = "Polka"
   mastrGenre(76) = "Retro"
   mastrGenre(77) = "Musical"
   mastrGenre(78) = "Rock & Roll"
   mastrGenre(79) = "Hard Rock"
   mastrGenre(80) = "Folk"
   mastrGenre(81) = "Folk-Rock"
   mastrGenre(82) = "National Folk"
   mastrGenre(83) = "Swing"
   mastrGenre(84) = "Fast Fusion"
   mastrGenre(85) = "Bebop"
   mastrGenre(86) = "Latin"
   mastrGenre(87) = "Revival"
   mastrGenre(88) = "Celtic"
   mastrGenre(89) = "Bluegrass"
   mastrGenre(90) = "Avantgarde"
   mastrGenre(91) = "Gothic Rock"
   mastrGenre(92) = "Progressive Rock"
   mastrGenre(93) = "Psychedelic Rock"
   mastrGenre(94) = "Symphonic Rock"
   mastrGenre(95) = "Slow Rock"
   mastrGenre(96) = "Big Band"
   mastrGenre(97) = "Chorus"
   mastrGenre(98) = "Easy Listening"
   mastrGenre(99) = "Acoustic"
   mastrGenre(100) = "Humour"
   mastrGenre(101) = "Speech"
   mastrGenre(102) = "Chanson"
   mastrGenre(103) = "Opera"
   mastrGenre(104) = "Chamber Music"
   mastrGenre(105) = "Sonata"
   mastrGenre(106) = "Symphony"
   mastrGenre(107) = "Booty Bass"
   mastrGenre(108) = "Primus"
   mastrGenre(109) = "Porn Groove"
   mastrGenre(110) = "Satire"
   mastrGenre(111) = "Slow Jam"
   mastrGenre(112) = "Club"
   mastrGenre(113) = "Tango"
   mastrGenre(114) = "Samba (Musik)"
   mastrGenre(115) = "Folklore"
   mastrGenre(116) = "Ballad"
   mastrGenre(117) = "Power Ballad"
   mastrGenre(118) = "Rhytmic Soul"
   mastrGenre(119) = "Freestyle"
   mastrGenre(120) = "Duet"
   mastrGenre(121) = "Punk Rock"
   mastrGenre(122) = "Drum Solo"
   mastrGenre(123) = "Acapella"
   mastrGenre(124) = "Euro-House"
   mastrGenre(125) = "Dance Hall"
   mastrGenre(126) = "Goa"
   mastrGenre(127) = "Drum’n’Bass"
   mastrGenre(128) = "Club-House"
   mastrGenre(129) = "Hardcore"
   mastrGenre(130) = "Terror"
   mastrGenre(131) = "Indie"
   mastrGenre(132) = "BritPop"
   mastrGenre(133) = "Black Punk"
   mastrGenre(134) = "Polski Punk"
   mastrGenre(135) = "Beat"
   mastrGenre(136) = "Christian Gangsta"
   mastrGenre(137) = "Heavy Metal"
   mastrGenre(138) = "Black Metal"
   mastrGenre(139) = "Crossover"
   mastrGenre(140) = "Contemporary Christian"
   mastrGenre(141) = "Christian Rock"
   mastrGenre(142) = "Merengue"
   mastrGenre(143) = "Salsa"
   mastrGenre(144) = "Thrash Metal"
   mastrGenre(145) = "Anime"
   mastrGenre(146) = "JPop"
   mastrGenre(147) = "SynthPop"
End Sub

Public Function BytesToGUIDString(GUIDBytes() As ByteAs String
  Dim udtGUID  As GUID
  Dim lngLen   As Long
  Dim strDummy As String
  ' Eine 16.Byte lange Folge in einen GUID-String umwandeln
  
  ' GUID-Struktur ausfüllen, hier die 16 Bytes übergeben
  strDummy = String(78, 0)
  CopyMemory udtGUID.Bytes(0), GUIDBytes(LBound(GUIDBytes)), 16
  
  ' API-Funktion aufrufen
  lngLen = StringFromGUID2(udtGUID, strDummy, Len(strDummy))
  
  ' Den zurückgelieferten Unicode in Ansi umwandeln. Jedes Zeichen
  ' hat in diesem String 4 statt 2 Bytes
  ' Vorher: "{75B22630-668E-11CF-A6D9-
  ' 00AA0062CE6C}"
  ' Nachher: : "{75B22630-668E-11CF-A6D9-00AA0062CE6C}"
  ' Als Funktionsergebnis zurückgeben
  BytesToGUIDString = Left(StrConv(strDummy, vbFromUnicode), lngLen - 1)
  
End Function

Public Property Get GetGenre() As Variant
   GetGenre = mastrGenre
End Property

Listing 1.4

Die öffentliche Funktion Tags

Diese Funktion liefert die Informationen einer MP3-Datei, dessen kompletter Pfad an die öffentliche Eigenschaft Filename übergeben wurde.

Zuerst wird die Prozedur MP3_Main aufgerufen. Nach der Rückkehr enthält die Kollektion mcolTags alle ausgelesenen Informationen. Mit Hilfe der Count-Eigenschaft der Kollektion wird das temporäre Array astrTemp redimensioniert, so dass es alle Informationen aufnehmen kann.

Die ersten drei Elemente der zweiten Dimension des Arrays nehmen den Dateinamen, den Dateipfad und die Länge auf. Anschließend werden alle Elemente der Kollektion durchlaufen und auch diese Informationen werden im Array gespeichert.

Das Array wird anschließend als Funktionsergebnis zurückgegeben.

Die Prozedur MP3_Main

Diese Prozedur ruft nacheinander die Prozeduren ReadFile, GetExtendedInfos und falls gewünscht, GetStandard und ReadID3Tags auf.

Die Prozedur GetStandard

Diese Prozedur liefert Standardtags, welche sich in den letzten 128 Bytes einer MP3-Datei befinden.

Mit CopyMemory werden dazu die letzten 128 Bytes der Datei in eine Struktur vom Typ MP3Tag kopiert. Existieren Standardtags, erkennbar an der Zeichenkette "Tag" im Element Tag, werden die einzelnen Informationen mit Hilfe der Prozedur AddTagToCollection inklusive Beschreibung und Herkunft in der klassenweit gültigen Kollektion mcolTags gespeichert.

Die Prozedur GetExtendedInfos

Diese Prozedur liefert Informationen, welche über die Windows-Shell ausgelesen wurden. Die gelieferten Informationen entsprechen denen, welche man auch im Explorer sichtbar machen kann. Mit Namespace("Path") der Shell.Application (Late Binding) wird ein Verzeichnis gebunden. In diesem Verzeichnis wird mit ParseName("File") eine Datei darin ausgewählt, von der man die Metadaten zurückbekommen möchte.

Es können maximal 31 Eigenschaften mit einem Index von 0-33 vorkommen, deshalb werden in einer Schleife nacheinander alle möglichen Indices daraufhin getestet, ob Werte vorhanden sind. Wenn gewünscht, werden mit Hilfe der Prozedur AddTagToCollection alle erweiterten Inhalte inklusive Beschreibung, Herkunft und Rohdaten in der klassenweit gültigen Kollektion mcolTags gespeichert. Möchte man das nicht, schaut man nach, ob der Eigenschaftsname im String "bitrate abtastrate dauer kanäle" vorkommt, damit zu mindestens diese essenziellen Eigenschaften ausgegeben werden. Bei anderen Sprachversionen sollte der Vergleichsstring an die entsprechende Sprache angepasst werden.

Die Funktion ReadID3Tags

Diese Funktion überprüft zu Beginn, ob überhaupt ID3-Tags in der Datei vorhanden sind. Ist das nicht der Fall, kann die Funktion sofort verlassen werden. Um das zu verifizieren, werden die ersten drei Bytes der Datei ausgewertet, diese müssen die Zeichenkette "ID3" enthalten. Die nächsten Bytes enthalten die Gesamtlänge der Tags, die Funktion ID3TagsLen nimmt als Argument diese Position auf und liefert die Länge in Bytes zurück.

Anschließend wird die Version ermittelt, das sind die nächsten zwei Bytes der Datei. Diese Information wird mit dem Aufruf der Prozedur AddTagToCollection in der klassenweit gültigen Kollektion gespeichert. Ist im nächsten Byte das Bit Nummer 6 gesetzt, folgt laut Spezifikation ein erweiterter Header mit 10 Bytes Länge, gefunden habe ich aber bis heute noch keinen einzigen. Ich konnte deshalb noch nicht testen, ob in diesem Fall die weitere Auswertung funktioniert.

Dahinter beginnen die eigentlichen Tags, das Ende in der Datei wird mit Hilfe der Längenangabe berechnet. Jetzt werden die Tags versionsabhängig ausgewertet. In den ersten drei- bzw. vier Bytes ist jeweils eine Zeichenkette als Kennung enthalten. In Version 2 ist es eine drei Zeichen lange, ab Version 3 eine vier Zeichen lange Zeichenkette. Mit der Pattern-Methode des RegExp-Objektes wird eine Mustererkennung vorgenommen, damit sichergestellt ist, dass auch aktuell eine Kennung vorliegt.

Auf die Kennung folgt eine ein Byte große Information, ob der Taginhalt Unicode oder ASCII enthält. Tags, welche in der Kennung als ersten Buchstabe ein "W" enthalten und als zweiten Buchstaben kein "X" haben, sind Webadressen, die niemals als Unicode formatiert sind, dort fehlt dieses Byte. Der Inhalt des Tags wird mit der Mid-Anweisung und der Längenangabe extrahiert und an die Funktion MakeUp übergeben. In dieser wird er aufbereitet und nach der Rückkehr in einem temporären Array gespeichert.

Private Tags, gekennzeichnet mit "PRIV", werden als beschreibender, Nullterminierter String gewertet, auf den die eigentlichen Daten folgen. Normalerweise gebe ich nur die Beschreibung und die Anzahl der nachfolgenden Bytes aus. Handelt es sich aber um Daten vom Typ "WM/MediaClassPrimaryID", werden die folgenden 16 Bytes mit der Funktion BytesToGUIDString in einen GUID-String umgewandelt. Beispielsweise bedeutet laut Microsoft die GUID "{D1607DBC-E323-4BE2-86A1-48A42A28441E}", dass es sich um eine Audio-Musikdatei handelt.

In der Kollektion mcolTranslate stecken die Beschreibungen zu den drei, bzw. vier Byte langen Kennungen und sind erreichbar über den gleichnamigen Schlüssel. Mit Hilfe der Prozedur AddTagToCollection werden alle Taginhalte inklusive Beschreibung, Herkunft und Rohdaten in der klassenweit gültigen Kollektion mcolTags gespeichert.

Die Funktion MakeUp

Diese Funktion überprüft zu Beginn, ob der Tag Unicode oder ASCII enthält. Dazu wird der Text an der Stelle Chr(255) & Chr(254) gesplittet. Unicode findet sich dann ab dem zweiten Element, also ab Index 1. Die Elemente ab Index 1 werden also mit StrConv umgewandelt. Anschließend werden noch Zeichen mit dem Wert Null in Leerzeichen umgewandelt. Das Präfix eng, welches nicht als Unicode kodiert ist, dient zur Sprachkennung und wird auch noch entfernt.

Die öffentliche Funktion WriteStandardTags

Diese Funktion übernimmt als Argument die zu schreibenden Standardtags als Zeichenketten auf.

Zu Beginn wird mit dem Aufruf von ReadFile der Dateiinhalt in ein Bytearray und eine Zeichenkette eingelesen. Existieren bereits Standardtags, erkennbar an der Zeichenkette "Tag" 128 Bytes vor dem Ende, werden diese in die Struktur vom Typ MP3Tag eingelesen. Anschließend schreibt man, sofern vorhanden, die übergebenen Argumente in die Struktur.

Existieren Standardtags, wird die Struktur mit CopyMemory an die letzten 128 Bytes geschrieben, existieren diese noch nicht, wird die Größe des Arrays mabytFile um 128 Bytes erhöht und die Standardtags an diese Stelle geschrieben. Das ganze Array wird an SaveFile übergeben, wo die Datei neu geschrieben wird.

Die öffentliche Funktion WriteID3Tags

Diese Funktion übernimmt als Argument die zu schreibenden Tags als Zeichenketten. Es ist nicht nötig, alle Argumente an diese Funktion zu übergeben, die Argumente sind durchgehend optional. Der besseren Lesbarkeit halber kann ohne weiteres mit benannten Argumenten arbeiten, das heißt man übergibt den Argumentnamen, setzt einen Doppelpunkt und Gleichheitszeichen dahinter und lässt darauf den zu übergebenden Wert folgen (mobjMP3.WriteID3Tags( Title:=txtTitle1, Comments:=txtComments). Somit erspart man sich eine wahre Orgie von Kommata, möchte man beispielsweise nur das letzte Argument übergeben.

Zu Beginn wird die klassenweit gültige Kollektion, welche alle Tags der Datei aufnimmt, zurückgesetzt und neu gefüllt, indem die Informationen durch den Aufruf der Funktion ReadID3Tags neu eingelesen werden. Anschließend wird für jedes übergebene Argument einmal die Prozedur RemoveAddID3 aufgerufen, welche aus der Kollektion das entsprechende Element löscht und eins mit den neuen Informationen hinzufügt.

Anschließend setzt man die neue Datei zusammen, indem man erst einmal die in der Kollektion steckenden Bytearrays, welche in jedem einzelnen Element unter dem Namen "Raw" abgelegt sind, zu einem ID3-Header zusammensetzt. Hinzu kommt an den Anfang des Headers noch die Kennung "ID3", die Version, welche aus zwei Bytes besteht und die Länge des Headers. Zum Umwandeln der Länge in die entsprechenden Bytes dient die Funktion ID3TagsLenToByteArray.

Anschließend folgen die restlichen, unveränderten Musikdaten. Letztendlich bestehen diese aus einer Folge von Frames, welche wiederum ein paar Bytes beinhalten, die jeden Frame beschreiben. Existieren Standardtags am Ende der Datei, werden diese zusammen mit den Musikdaten hinzugefügt. Das ganze Array wird an SaveFile übergeben, wo die Datei neu geschrieben wird.

Die Prozedur RemoveAddID3

Diese Prozedur ersetzt in der klassenweit gültigen Kollektion einen bereits vorhandenen Eintrag, oder legt ihn neu an. Die an diese Prozedur übergebenen Argumente enthalten die Daten des neuen Eintrages.

Ist der erste Buchstabe des übergebenen Tagnamens ein T, handelt es sich beim Zielfeld um ein Textfeld. Dieses wird in dieser Funktion generell als Unicode formatiert. Das erste Byte, das ist das Feld Textencryption, wird dabei auf 1 gesetzt. Die nächsten zwei Bytes setzt man auf 255 und 254 und kennzeichnet damit den nachfolgenden Text als Unicode. Das habe ich zwar so nicht in den Spezifikationen nachlesen können, aber bei sehr vielen Tests herausgefunden. Danach folgt der eigentliche Unicodetext.

Sind die ersten zwei Buchstaben TX, wird etwas anders verfahren, als bei normalen Textfeldern. Auch hier habe ich das erst durch umfangreiche Tests herausgefunden. Ob meine Implementierung offiziell richtig ist, konnte ich auch hier nicht ermitteln. Bei Internetadressen ist der erste Buchstabe ein W und der zweite kein X. in diesem Fall ist das Feld Textencryption unnötig, denn die Codierung ist immer Iso-8859-1.

Bei den Tags "USLT", "ULT", "COMM" und "COM" kommt an den Beginn noch die Sprachcodierung, in den meisten Fällen ist das die Zeichenkette "eng". Es schließen sich die Zeichen chr(255) & chr(254) & chr(0) & chr(0) & chr(255) & chr(254) an, anschließend folgt der eigentliche Unicodetext.

Vor den generierten Text kommen schließlich noch die Kennung und die Taglänge, welche je nach Version drei-, bzw. vier Bytes lang sein kann. Die Einzelnen Informationen, wie etwa der Tagname oder die Rohdaten werden in einer Kollektion zwischengespeichert und diese in die klassenweit gültige eingefügt.

Die Prozedur ReadFile

Diese Prozedur öffnet die zu bearbeitende Datei und speichert den gesamten Inhalt in einem klassenweit gültigem Bytearray und einer Zeichenkette.

Die Prozedur SaveFile

Diese Prozedur übernimmt als Argument ein Bytearray, welches den Inhalt der zu beschreibenden MP3-Datei enthält. Falls gewünscht, wird die Originaldatei als Sicherheitskopie umbenannt. Wenn nicht, löscht man die Originaldatei, legt mit Open eine neue Datei an und speichert mit der Put-Anweisung das Bytearray darin.

Würde man die Originaldatei nicht löschen und wäre die zu schreibende Datei kürzer als das Original, hätte man das Problem, dass sich noch Teile der alten Datei in der neuen Datei befinden. Der neue Teil wird zwar hineinkopiert, aber die Länge nicht angepasst. Will man das vermeiden, muss man mit ein paar API-Funktionen den EOF (End Of File) Pointer neu setzen. Das habe ich mir aber hier erspart, denn das Beispiel ist bereits komplex genug.

Die Prozedur AddTagToCollection

Diese Prozedur übernimmt als erstes Argument einen ausführlichen Tagnamen, das ist der Name des Wertes, der auch als Überschrift verwendet werden kann. Das zweite Argument ist der drei- oder vier Zeichen lange interne Name des Wertes. Das dritte Argument übergibt den eigentlichen Wert des Tags. Das vierte Argument ist ein Bytearray, welches den gesamten Tag inklusive Längenangabe und Namen in unveränderter Form enthält. Mit dem fünften Argument wird die Herkunft beschrieben, damit, falls gewünscht, gleiche Tagnamen unterschiedlicher Herkunft in der Kollektion gespeichert werden können.

Zunächst werden die übergebenen Werte in einer temporären Kollektion unter einem den jeweiligen Wert beschreibenden Schlüsselnamen gespeichert. Diese Kollektion wird anschließend in einer modulweit gültigen Kollektion gespeichert. Möchte man gleiche Tagnamen vermeiden, verwendet man beim Hinzufügen zur Kollektion als Key (Schlüssel) lediglich den internen Namen, andernfalls hängt man an den Key noch die Herkunft.

Die Funktion ID3V2Len, ID3V3Len und ID3TagsLen

Diese Funktionen übernehmen die Position einer Längenangabe und extrahieren aus dem klassenweit gültigen Bytearray, welches den Dateiinhalt repräsentiert, die Länge. In Version 2 werden drei, in Version 3 + 4 vier Bytes ausgewertet. Die etwas kompliziert anmutende Berechnung ist erforderlich, da das jeweils höchste Bit nicht gesetzt ist und auch kein Inhalt der eigentlichen Zahl ist. Außerdem passt die interne Bytereihenfolge nicht in die Intel-Welt.

Die Funktion ID3V2LenToByteArray, ID3V3LenToByteArray und ID3TagsLenToByteArray

Diese Funktionen übernehmen im zweiten Parameter eine Längenangabe und füllen das im ersten Parameter übergebene Bytearray aus. Je nach Version sind das drei- oder vier Bytes. Warum eine solche Rechnung erforderlich ist, kann man der vorherigen Funktionsbeschreibung entnehmen.

Die Ereignisprozedur Class_Initialize

Diese Prozedur wird beim Anlegen des Klassenobjektes ausgeführt. In dieser werden einige klassenweit gültige Variable mit Werten vorbelegt.

Die Funktion BytesToGUIDString

Diese interne Funktion übernimmt ein Bytearray, welches die 16 Bytes einer GUID (Globally Unique Identifier) enthält und gibt eine in geschweifte Klammern eingebettete Zeichenfolge zurück.

Eine GUID ist prinzipiell eine global eindeutige Zahl mit 128 Bit, die zur besseren Lesbarkeit als Zeichenfolge mit 36 Stellen dargestellt wird. Die Zeichenfolge {D1607DBC-E323-4BE2-86A1-48A42A28441E} ist solch ein Beispiel und kennzeichnet eine WM/MediaClassPrimaryID, hier ist es ein Kennzeichen für eine Musikdatei.

Zur Umwandlung wird die API-Funktion StringFromGUID2 benutzt, welche eine ausgefüllte Struktur vom Typ GUID, einen Zeichenpuffer und dessen Länge erwartet. Die 16 zugrundeliegenden Bytes werden mit Hilfe der API CopyMemory in die Struktur GUID kopiert. Die API-Funktion StringFromGUID2 beschreibt den übergebenen Puffer und liefert die Länge der in den Puffer geschriebenen Zeichen. Der Puffer enthält nun die Zeichenfolge als Unicode, das heißt, je zwei Bytes repräsentieren ein Zeichen. Da aber in VBA intern ein Zeichen sowieso als Unicode vorliegt, sind es in Wirklichkeit vier Bytes, was mit StrConv ausgebügelt wird.

Die Prozedur CreateID3

Diese Prozedur erzeugt eine klassenweit gültige Kollektion. Jedes Element darin enthält zwei Elemente einer eigenen Kollektion mit den Namen “Name“ und “Description“. Das Element “Name“ enthält die drei- bzw. vier Zeichen lange ID3-Kennungen, das Element “Description“ deren ausführliche Beschreibungen. Die Länge der Kennung beträgt bei der Version 2 drei, ab der Version 3 vier Zeichen.

Die Prozedur CreateGenre

Diese Prozedur erzeugt ein klassenweit gültiges Array, welches die offiziellen Musikrichtungen (Genre) als Text enthält. Der Index des jeweiligen Elements korrespondiert mit der Genrenummer. Definiert sind, soweit ich weiß, 147 von 255 möglichen Musikrichtungen.

Die Eigenschaft GetGenre

Diese öffentliche Eigenschaft liefert ein Array, welches die offiziellen Musikrichtungen (Genre) als Text enthält.

Die Funktion GetGenreByNum

Diese öffentliche Funktion übernimmt eine Nummer und gibt die zugehörige offizielle Musikrichtung (Genre) als Text zurück.