Zurück zur Homepage

WMA (Windows Media Audio)

Das Windows Media Audio (WMA) wird wie MP3 zur Komprimierung von digitalen Audioinhalten verwendet. Es ist aber nicht ganz so weit verbreitet wie beispielsweise MP3, das liegt aber meiner Meinung zum größten Teil nur daran, dass WMA die Einbindung eines DRM-Kopierschutzes unterstützt.

Die Komprimierung erfolgt wie bei MP3 verlustbehaftet, es gehen also beim Komprimieren definitiv Informationen verloren. Trotzdem ist dieser Verlust nahezu unhörbar und je besser das Verfahren ist, desto näher kommt der Höreindruck an den des Originals heran. WMA ist dabei so gut, dass es bei gleicher Qualität sogar eine niedrigere Bitrate als MP3 benötigt, was natürlich die Dateigröße reduziert. In diesem Beispiel werden die Informationen von WMA-Dateien ausgelesen, auf einem Tabellenblatt ausgegeben und können schließlich auch geändert werden.

Um einen Vorgeschmack auf die bevorstehenden Aufgaben zu bekommen, hier ein kurzer Überblick.

Als Hülle für WMA- und WMV-Streams (WMV=Windows Media Video) dienen ASF-Container (Microsoft Advanced Systems Format). Näher spezifiziert ist dieses Format in einer Word-Datei mit dem Namen ASF_Specification.doc (http://search.microsoft.com/results.aspx?mkt=en-US&l=1&Setlang=en-US&q=Asf%20Specification.doc) von Microsoft. Eine weitere Anlaufstelle ist die Adresse http://msdn.microsoft.com/en-us/library/aa391599(VS.85).aspx.

Wie bereits beschrieben, ist ein WMA-Stream in einem ASF-Container eingebettet. Dieser Container wiederum enthält neben den reinen Streamdaten auch andere Objekte. Die Hauptobjekte darin sind das Header- das Date- und das Index-Objekt. Jedes Objekt beginnt mit einem 16 Byte langen Wert, der eine GUID repräsentiert. Ein Globally Unique Identifier (GUID) ist prinzipiell eine global eindeutige Zahl mit 128 Bit (16 Byte), die zur besseren Lesbarkeit als Zeichenfolge mit 36 Stellen und umhüllenden geschweiften Klammern dargestellt wird. Auf diese GUID folgt eine Längenangabe, welche die Anzahl der in diesem Objekt enthaltenen Bytes beschreibt und dahinter beginnen die eigentlichen Daten.

Uns interessiert besonders das Header-Objekt mit der GUID {75B22630-668E-11CF-A6D9-00AA0062CE6C}. Dieses Objekt enthält mehrere untergeordnete Objekte mit je einer eigenen GUID. Interessant sind in jedem Fall die nachfolgenden Objekte und diese werden im vorliegenden Beispiel auch ausgewertet: ASF_File_Properties_Object, ASF_Content_Description_Object, ASF_Extended_Content_Description_Object, ASF_Stream_Properties_Object, ASF_Stream_Bitrate_Properties_Object und ASF_Codec_List_Object.

Die meisten Headerobjekte haben eine von Microsoft festgelegte Struktur, so auch das Content Description Object, welches einige (wenige) Standardtags enthält. Vergleichbar sind diese Informationen mit den Standardtags einer MP3-Datei, welche sich in den letzten 128 Bytes befinden. Im Gegensatz zu den Standardtags von MP3 ist die Textlänge von WMA-Standardtags aber nicht begrenzt.

Etwas Besonderes ist das Extended Content Description Object, in dem man beliebige Tags speichern kann. Beim Anlegen, Ändern und Speichern habe ich mich aber auf einige offizielle beschränkt, gelesen werden aber alle, auch selbstdefinierte.

Ein Vorteil bei WMA gegenüber MP3 ist, dass man beispielsweise die Informationen zur Spieldauer direkt aus dem Header, speziell aus dem File Properties Object auslesen kann. Dort sind auch einige andere Informationen über die Datei enthalten, so dass man in den meisten Fällen auf den Einsatz der Windows-Shell zur Informationsbeschaffung verzichten kann.

MP3 (Vorschau)

In einem anderen Beispiel wird gezeigt, wie man die Metadaten von MP3-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 das Bearbeiten von MP3-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 ufWMA

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

MP3

Abbildung 1

Option Explicit
Private mstrFile     As String
Private mobjWMA      As clsWMA
Private Sub cmdFile_Click()
   Dim varFile As Variant
   ' Dateiname- und Pfad holen
   varFile = Application.GetOpenFilename( _
      "WMA Files (*.wma), *.wma")
   ' 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 mobjWMA = New clsWMA
   
   ' Textfelder löschen
   txtTitel.Text = ""
   txtAutor.Text = ""
   txtCopyright.Text = ""
   txtBeschreibung.Text = ""
   txtRating.Text = ""
   txtAlbumArtist.Text = ""
   txtAlbumTitle.Text = ""
   txtProvider.Text = ""
   txtProviderRating.Text = ""
   txtProviderStyle.Text = ""
   txtGenre.Text = ""
   txtYear.Text = ""
   txtTrackNumber.Text = ""
   txtTrack.Text = ""
   txtLyrics.Text = ""
   txtPublisher.Text = ""
   txtComposer.Text = ""
   txtAlbumCoverURL.Text = ""
   txtWriter.Text = ""
   txtRadioStationName.Text = ""
   txtProducer.Text = ""
   txtAuthorURL.Text = ""
   
   ' Spaltenbreite Listenfeld 'Alle Infos' festlegen
   lsbResult.ColumnWidths = "3,5 cm;20 cm"
   
   With mobjWMA
   
      ' 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"
               txtTitel.Text = astrTags(2, k)
            Case "Autor"
               txtAutor.Text = astrTags(2, k)
            Case "Copyright"
               txtCopyright.Text = astrTags(2, k)
            Case "Description"
               txtBeschreibung.Text = astrTags(2, k)
            Case "Rating"
               txtRating.Text = astrTags(2, k)
            ' Extended-Informationen in die Textfelder schreiben
            Case "WM/AlbumArtist"
               txtAlbumArtist.Text = astrTags(2, k)
            Case "WM/AlbumTitle"
               txtAlbumTitle.Text = astrTags(2, k)
            Case "WM/Provider"
               txtProvider.Text = astrTags(2, k)
            Case "WM/ProviderRating"
               txtProviderRating.Text = astrTags(2, k)
            Case "WM/ProviderStyle"
               txtProviderStyle.Text = astrTags(2, k)
            Case "WM/Genre"
               txtGenre.Text = astrTags(2, k)
            Case "WM/Year"
               txtYear.Text = astrTags(2, k)
            Case "WM/TrackNumber"
               txtTrackNumber.Text = astrTags(2, k)
            Case "WM/Track"
               txtTrack.Text = astrTags(2, k)
            Case "WM/Lyrics"
               txtLyrics.Text = astrTags(2, k)
            Case "WM/Publisher"
               txtPublisher.Text = astrTags(2, k)
            Case "WM/Composer"
               txtComposer.Text = astrTags(2, k)
            Case "WM/AlbumCoverURL"
               txtAlbumCoverURL.Text = astrTags(2, k)
            Case "WM/Writer"
               txtWriter.Text = astrTags(2, k)
            Case "WM/RadioStationName"
               txtRadioStationName.Text = astrTags(2, k)
            Case "WM/Producer"
               txtProducer.Text = astrTags(2, k)
            Case "WM/AuthorURL"
               txtAuthorURL.Text = astrTags(2, k)
         End Select
      
      Next
      
   End With

End Sub

Private Sub cmdWrite_Click()

   If mobjWMA 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
      
   ' Tags mit Infos aus den Textfeldern zurückschreiben
   If mobjWMA.WriteTags( _
      Titel:=txtTitel, _
      Autor:=txtAutor, _
      Copyright:=txtCopyright, _
      Beschreibung:=txtBeschreibung, _
      Rating:=txtRating, _
      AlbumArtist:=txtAlbumArtist, _
      AlbumTitle:=txtAlbumTitle, _
      Provider:=txtProvider, _
      ProviderRating:=txtProviderRating, _
      ProviderStyle:=txtProviderStyle, _
      Genre:=txtGenre, _
      Year:=txtYear, _
      TrackNumber:=txtTrackNumber, _
      Track:=txtTrack, _
      Lyrics:=txtLyrics, _
      Publisher:=txtPublisher, _
      Composer:=txtComposer, _
      Producer:=txtProducer, _
      AlbumCoverURL:=txtAlbumCoverURL, _
      Writer:=txtWriter, _
      RadioStationName:=txtRadioStationName, _
      AuthorURL:=txtAuthorURL _
      ) = True Then
      
      MsgBox "Tags erfolgreich in Datei" & vbCrLf & _
         mstrFile & vbCrLf & _
         "geschrieben!"
         
   End If
   
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 WMA-Datei ausgewählt wurde, werden die Inhalte der Tags auf den Registern "Standard Tags" und "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 angezeigt. Auf den Registerkarten "Extended Tags" und "Lyrics" werden in verschiedenen Textfeldern die ausgelesenen 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 bestehende WMA-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 clsWMA ü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 und das zweite den Wert des aktuellen Elements.

Alle zurückgelieferten Informationen werden anschließend im Listenfeld gespeichert und auch in die entsprechenden Textfelder geschrieben.

Das Klickereignis cmdWrite_Click

Diese Prozedur liest die Tags aus den entsprechenden Textfeldern und übergibt sie an die Methode WriteTags der Objektklasse clsWMA.

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 zwischengespeichert, 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 clsWMA geliefert werden, auf dem Tabellenblatt auszugeben. Beim Klick auf die Schaltfläche mit der Beschriftung "Datei Editieren" wird die Userform ufWMA angezeigt, mit der man die Tags einer Datei ändern kann.

Option Explicit

Private Sub cmdEdit_Click()
   ufWMA.Show vbModeless
End Sub

Private Sub cmdread_Click()
   Dim MyWMA         As New clsWMA
   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
   
   On Error Resume Next
   
   ' 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 .wma Dateien ..."
   
   Application.ScreenUpdating = False
   
   ' Dateiliste erstellen
   varFiles = SearchFiles(strPath, "*.wma")
   
   ' Zielbereich löschen
   Me.Cells.ClearContents
   
   With MyWMA
   
      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
         
         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)
         DoEvents
         
      Next
      
   End With
   
   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
   
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 *.wma werden alle Dateien inklusive Pfad zurückgegeben, welche dem Muster entsprechen. Das zurückgegebene Array enthält anschließend die kompletten Dateipfade aller WMA-Dateien, welche in dem übergebenen Verzeichnis und all dessen Unterverzeichnissen stecken.

Diese ausgelesenen Pfade werden nacheinander an die Eigenschaft Filename der Objektklasse clsWMA ü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 des aktuellen Elements.

Jede zurückgelieferte Information sollte nun in je eine eigene Spalte geschrieben werden, wobei gleiche Informationen natürlich auch in die gleiche Spalte kommen sollen. Dazu werden in einer Kollektion (colCaption) der Tagname und die zugehörige Spalte gespeichert, als Schlüssel wird der Tagname benutzt. Bevor man nun die jeweilige Information 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 werden wiederum in der Kollektion gespeichert.

Nachdem alle Informationen ins Tabellenblatt geschrieben wurden, entnimmt man der Kollektion colCaption 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, da ein einmaliges Ausführen meistens nicht den gewünschten Erfolg bringt.

Das Klassenmodul clsWMA

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

Die Eigenschaft Filename nimmt den Dateipfad entgegen und ShowShell legt fest, ob Shell-Informationen zurückgeliefert werden sollen. Setzt man die Eigenschaft SicherheitskopienAnlegen auf Wahr, was standardmäßig der Fall ist, werden vor dem Ändern Sicherheitskopien der Dateien angelegt.

Option Explicit
Private Type GUID
   Bytes(0 To 15) As Byte
End Type
Private Type OBJ_DESCRIPTION
   Obj_ID(15)      As Byte     ' Objekt GUID
   Obj_Size        As Double   ' Objekt-Größe
   Title_Len       As Integer  ' Titel-Länge
   Author_Len      As Integer  ' Künstler-Länge
   Copyright_Len   As Integer  ' Copyright-Länge
   Description_Len As Integer  ' Beschreibungs-Länge
   Rating_Len      As Integer  ' Rating-Länge
End Type
Private Declare Function StringFromGUID2 _
   Lib "OLE32.dll" ( _
   tGuid As GUID, _
   ByVal lpszString As String, _
   ByVal lMax As Long _
   ) As Long
Private Declare Sub CopyMemory _
   Lib "kernel32" Alias "RtlMoveMemory" ( _
   pDst As Any, _
   pSrc As Any, _
   ByVal ByteLen As Long)
   
' Header-Objekt
Private Const ASF_Header_Object As String = _
  "{75B22630-668E-11CF-A6D9-00AA0062CE6C}"
  
' Im Header enthaltene Objekte
Private Const ASF_File_Properties_Object As String = _
  "{8CABDCA1-A947-11CF-8EE4-00C00C205365}"
Private Const ASF_Stream_Properties_Object As String = _
  "{B7DC0791-A9B7-11CF-8EE6-00C00C205365}"
Private Const ASF_Header_Extension_Object As String = _
  "{5FBF03B5-A92E-11CF-8EE3-00C00C205365}"
Private Const ASF_Codec_List_Object As String = _
  "{86D15240-311D-11D0-A3A4-00A0C90348F6}"
Private Const ASF_Script_Command_Object As String = _
  "{1EFB1A30-0B62-11D0-A39B-00A0C90348F6}"
Private Const ASF_Marker_Object As String = _
  "{F487CD01-A951-11CF-8EE6-00C00C205365}"
Private Const ASF_Bitrate_Mutual_Exclusion_Object As String = _
  "{D6E229DC-35DA-11D1-9034-00A0C90349BE}"
Private Const ASF_Error_Correction_Object As String = _
  "{75B22635-668E-11CF-A6D9-00AA0062CE6C}"
Private Const ASF_Content_Description_Object As String = _
  "{75B22633-668E-11CF-A6D9-00AA0062CE6C}"
Private Const ASF_Extended_Content_Description_Object As String = _
  "{D2D0A440-E307-11D2-97F0-00A0C95EA850}"
Private Const ASF_Digital_Signature_Object As String = _
  "{2211B3FC-BD23-11D2-B4B7-00A0C955FC6E}"
Private Const ASF_Padding_Object As String = _
  "{1806D474-CADF-4509-A4BA-9AABCB96AAE8}"
Private Const ASF_Content_Branding_Object As String = _
  "{2211B3FA-BD23-11D2-B4B7-00A0C955FC6E}"
Private Const ASF_Stream_Bitrate_Properties_Object As String = _
  "{7BF875CE-468D-11D1-8D82-006097C9A2B2}"
  
' Media Typen
Private Const ASF_Audio_Media As String = _
  "{F8699E40-5B4D-11CF-A8FD-00805F5C442B}"
Private Const ASF_Video_Media As String = _
  "{BC19EFC0-5B4D-11CF-A8FD-00805F5C442B}"
Private Const ASF_Command_Media As String = _
  "{59DACFC0-59E6-11D0-A3AC-00A0C90348F6}"
Private Const ASF_JFIF_Media As String = _
  "{B61BE100-5B4E-11CF-A8FD-00805F5C442B}"
Private Const ASF_Degradable_JPEG_Media As String = _
  "{35907DE0-E415-11CF-A917-00805F5C442B}"
Private Const ASF_File_Transfer_Media As String = _
  "{91BD222C-F21C-497A-8B6D-5AA86BFC0185}"
Private Const ASF_Binary_Media As String = _
  "{3AFB65E2-47EF-40F2-AC2C-70A90D71D343}"
  
' Objekte im ASF_Extended_Content_Description_Object
Private mcolContentsEx              As Collection

' Arrays zur Aufnahme von Daten
Private mabytASF_Header_Object()    As Byte
Private mabytOutsideHeader()        As Byte

' Standardwerte ASF_Content_Description_Object
Private mstrTitle                   As String
Private mstrAutor                   As String
Private mstrCopyright               As String
Private mstrBeschreibung            As String
Private mstrRating                  As String

Private mlngFileLen                 As Long ' Dateilänge
Private mlngAfterContent            As Long ' Pos nach Ex-Content
Private mlngPosFileProp             As Long ' Pos Dateiinfos
Private mstrFileName                As String   ' Dateiname
Private mastrTags()                 As String   ' Tags
Private mblnASF                     As Boolean ' Ist ASF-Datei
Private mblnSik                     As Boolean ' Ist ASF-Datei
Private mblnShowShell               As Boolean
Private mdteTimeout                 As Date

' ##################################################################
' ## Infos über ASF ##
' ## http://msdn.microsoft.com/en-us/library/aa391599(VS.85).aspx ##
' ## download.microsoft.com asf_specification.doc ##
' ##################################################################

' Tag Descriptors zurückgeben
Public Property Get Tags() As String()
   mdteTimeout = Now + TimeSerial(0, 0, 20)
   WMA_Main
   Tags = mastrTags
End Property

Private Sub WMA_Main()
   Dim abytFile()          As Byte
   Dim strGUID             As String
   Dim abytTemp()          As Byte
   Dim lngSize             As Long
   Dim i                   As Long
   Dim k                   As Long
   Dim FF                  As Long
   Dim lngLen              As Long
   Dim lngHeaderSize       As Long
   Dim lngPos              As Long
   
   On Error Resume Next
   
   FF = FreeFile
   Erase mastrTags
   mblnASF = False
   Err.Clear
   
   ' WMA Datei öffnen und Inhalt auslesen
   Open mstrFileName For Binary As #FF
      mlngFileLen = LOF(FF)
      ReDim abytFile(1 To mlngFileLen)
      Get #FF, , abytFile
   Close ' WMA Datei Schließen
   
   If Err.Number <> 0 Then Exit Sub
   
   ReDim abytTemp(15) ' 1. GUID-auslesen
   CopyMemory abytTemp(0), abytFile(1), 16
   strGUID = BytesToGUIDString(abytTemp)
   
   ReDim Preserve mastrTags(1 To 2, 1 To 3)
   mastrTags(1, 1) = "Dateiname"
   mastrTags(2, 1) = Mid(mstrFileName, InStrRev(mstrFileName, "\") + 1)
   mastrTags(1, 2) = "Dateipfad"
   mastrTags(2, 2) = Left(mstrFileName, InStrRev(mstrFileName, "\"))
   
   If mblnShowShell Then GetExtendedInfos
   
   ' Wenn Beginn nicht der Header ist, verlassen
   mastrTags(1, 3) = "WMA/ASF"
   If strGUID <> ASF_Header_Object Then
      mastrTags(2, 3) = "Nein"
      Exit Sub
   Else
      mastrTags(2, 3) = "Ja"
      mblnASF = True
   End If
   
   ' Headergröße extrahieren
   CopyMemory lngHeaderSize, abytFile(17), 4

   ' Gesamten Header im Array zwischenspeichern
   ReDim abytTemp(0 To lngHeaderSize - 1)
   CopyMemory abytTemp(0), abytFile(1), lngHeaderSize
   mabytASF_Header_Object = abytTemp
   
   ' Daten außerhalb des Headers im Array zwischenspeichern
   ReDim abytTemp(0 To mlngFileLen - 1 - lngHeaderSize)
   CopyMemory abytTemp(0), _
      abytFile(lngHeaderSize + 1), _
      mlngFileLen - lngHeaderSize
   mabytOutsideHeader = abytTemp
   
   i = 31
   
   Do
      lngPos = lngPos + 1
      
      If Now > mdteTimeout Then Exit Do
      
      ReDim abytTemp(15) ' GUID-auslesen
      CopyMemory abytTemp(0), abytFile(i), 16
      strGUID = BytesToGUIDString(abytTemp)
      
      ' Größe des Objektinhalts-auslesen
      CopyMemory lngSize, abytFile(i + 16), 4
      
      'Objektinhalt auslesen
      ReDim abytTemp(lngSize - 1)
      CopyMemory abytTemp(0), abytFile(i), lngSize
      
      ' GUIDs auswerten
      Select Case strGUID
         Case ASF_Content_Description_Object
            Parse_ASF_Content_Description_Object abytTemp
         Case ASF_Extended_Content_Description_Object
            Parse_ASF_Extended_Content_Description_Object abytTemp
            mlngAfterContent = i + lngSize - 1
         Case ASF_Stream_Properties_Object
            Parse_ASF_Stream_Properties_Object abytTemp
         Case ASF_Stream_Bitrate_Properties_Object
            Parse_ASF_Stream_Bitrate_Properties_Object abytTemp
         Case ASF_File_Properties_Object
            Parse_ASF_File_Properties_Object abytTemp
            mlngPosFileProp = i - mlngFileLen
         Case ASF_Codec_List_Object
            Parse_ASF_Codec_List_Object abytTemp
         Case ASF_Content_Branding_Object
         Case ASF_Error_Correction_Object
         Case ASF_Bitrate_Mutual_Exclusion_Object
         Case ASF_Marker_Object
         Case ASF_Script_Command_Object
         Case ASF_Header_Extension_Object
         Case ASF_Digital_Signature_Object
         Case ASF_Padding_Object
         Case Else
      End Select
      
      i = i + lngSize
      
   Loop While i < lngHeaderSize
   
End Sub

Private Sub Parse_ASF_Codec_List_Object(abytData() As Byte)
   Dim i                      As Long
   Dim k                      As Long
   Dim m                      As Long
   Dim n                      As Long
   Dim lngCodecs              As Long
   Dim lngTemp                As Long
   Dim strTemp                As String
   Dim strResult              As String
   Dim abytTemp()             As Byte
   
   On Error Resume Next
   i = UBound(mastrTags, 2)
   m = 40
   
   ' Anzahl Codecs ermitteln
   CopyMemory lngCodecs, abytData(m), 4
   m = m + 4
   
   ' Arraygröße anpassen
   ReDim Preserve mastrTags(1 To 2, 1 To i + lngCodecs)
   
   For lngCodecs = 1 To lngCodecs
      strResult = "Typ="
      CopyMemory lngTemp, abytData(m), 2
      Select Case lngTemp
         Case 1
            strResult = strResult & "Videocodec; "
         Case 2
            strResult = strResult & "Audiocodec; "
         Case Else
            strResult = strResult & "Unbekannt; "
      End Select
      m = m + 2
      
      ' Länge Namen auslesen
      CopyMemory lngTemp, abytData(m), 2
      m = m + 2
      lngTemp = lngTemp * 2
      ' Namen auslesen
      ReDim abytTemp(lngTemp - 3)
      CopyMemory abytTemp(0), abytData(m), lngTemp - 2
      strTemp = abytTemp
      strResult = strResult & "Codecname=" & strTemp & "; "
      m = m + lngTemp
      
      ' Länge Codecbeschreibung auslesen
      CopyMemory lngTemp, abytData(m), 2
      m = m + 2
      lngTemp = lngTemp * 2
      ' Beschreibung auslesen
      ReDim abytTemp(lngTemp - 3)
      CopyMemory abytTemp(0), abytData(m), lngTemp - 2
      strTemp = abytTemp
      strResult = strResult & "Beschreibung=" & strTemp & "; "
      m = m + lngTemp
      
      ' Länge CodecInfo auslesen
      CopyMemory lngTemp, abytData(m), 2
      m = m + 2
      ' Info auslesen
      ReDim abytTemp(lngTemp - 1)
      CopyMemory abytTemp(0), abytData(m), lngTemp
      strResult = strResult & "InfoBits (Hex)="
      For n = 0 To UBound(abytTemp)
         strResult = strResult & _
            String(2 - Len(Hex(abytTemp(n))), "0") & _
            Hex(abytTemp(n)) & " "
      Next
      m = m + lngTemp
      
      i = i + 1
      k = k + 1
      
      ' Codecinfos für externe Verwendung im Array speichern
      mastrTags(1, i) = "Codec Nr.:" & k
      mastrTags(2, i) = strResult
      
   Next
   
End Sub

Private Sub Parse_ASF_Stream_Bitrate_Properties_Object(abytData() As Byte)
   Dim i                      As Long
   Dim m                      As Long
   Dim lngRecords             As Long
   Dim lngTemp                As Long
   Dim strTemp                As String
   Dim abytTemp()             As Byte
   
   On Error Resume Next
   i = UBound(mastrTags, 2)
   m = 24
   
   ' Anzahl Recorde ermitteln
   CopyMemory lngRecords, abytData(m), 2
   m = m + 2
   
   ' Arraygröße anpassen
   ReDim Preserve mastrTags(1 To 2, 1 To i + lngRecords)
   
   ' Alle Recorde durchlaufen
   For lngRecords = 1 To lngRecords
      i = i + 1
      
      ' Recordnummer auslesen
      CopyMemory lngTemp, abytData(m), 2
      mastrTags(1, i) = "Bitrate Rec. Nr. : " & lngTemp
      m = m + 2
      
      ' Bitrate auslesen
      CopyMemory lngTemp, abytData(m), 4
      mastrTags(2, i) = lngTemp
      m = m + 4
      
   Next
End Sub

Private Sub Parse_ASF_Stream_Properties_Object(abytData() As Byte)
   Dim i                      As Long
   Dim m                      As Long
   Dim strTemp                As String
   Dim abytTemp()             As Byte
   
   On Error Resume Next
   i = UBound(mastrTags, 2)
   ReDim Preserve mastrTags(1 To 2, 1 To i + 1)
   mastrTags(1, i + 1) = "Mediatyp"
   ReDim abytTemp(15)
   m = 24
   
   ' Mediatyp-GUID auslesen
   CopyMemory abytTemp(0), abytData(m), 16
   
   ' Mediatyp ermitteln
   Select Case BytesToGUIDString(abytTemp)
      Case ASF_Audio_Media: strTemp = "Audio_Media"
      Case ASF_Video_Media: strTemp = "Video_Media"
      Case ASF_Command_Media: strTemp = "Command_Media"
      Case ASF_JFIF_Media: strTemp = "JFIF_Media"
      Case ASF_Degradable_JPEG_Media: strTemp = "Degradable_JPEG_Media"
      Case ASF_File_Transfer_Media: strTemp = "File_Transfer_Media"
      Case ASF_Binary_Media: strTemp = "Binary_Media"
   End Select
   
   ' Mediatyp für externe Verwendung im Array speichern
   mastrTags(2, i + 1) = strTemp
End Sub

Private Sub Parse_ASF_File_Properties_Object(abytData() As Byte)
   Dim i                      As Long
   Dim m                      As Long
   Dim lngTemp                As Long
   Dim curTemp                As Currency
   Dim dblTemp                As Double
   Dim dteTemp                As Date
   Dim abytTemp()             As Byte
   
   On Error Resume Next
   i = UBound(mastrTags, 2)
   ReDim Preserve mastrTags(1 To 2, 1 To i + 10)
   
   ReDim abytTemp(15)
   m = 24
   ' Datei-GUID auslesen und
   ' für externe Verwendung im Array speichern
   CopyMemory abytTemp(0), abytData(m), 16
   mastrTags(1, i + 1) = "Datei-GUID"
   mastrTags(2, i + 1) = BytesToGUIDString(abytTemp)
   m = m + 16
   ' Dateigröße auslesen und
   ' für externe Verwendung im Array speichern
   CopyMemory curTemp, abytData(m), 8
   dblTemp = 10000 * curTemp
   mastrTags(1, i + 2) = "Dateigröße"
   mastrTags(2, i + 2) = Int(dblTemp)
   m = m + 8
   ' Erstellungszeitpunkt auslesen (in 100 Nanosekunden seit 1601
   ' und für externe Verwendung im Array speichern
   CopyMemory curTemp, abytData(m), 8
   dblTemp = curTemp
   dteTemp = dblTemp / 86400000 + DateSerial(1601, 1, 1)
   mastrTags(1, i + 3) = "Erstellungszeitpunkt"
   mastrTags(2, i + 3) = Format(dteTemp, "DD.MM.YYYY hh:nn:ss")
   m = m + 8
   ' Menge Datenpakete auslesen und
   ' für externe Verwendung im Array speichern
   CopyMemory curTemp, abytData(m), 8
   dblTemp = 10000 * curTemp
   mastrTags(1, i + 4) = "Datenpakete"
   mastrTags(2, i + 4) = Int(dblTemp)
   m = m + 8
   ' Abspielzeit auslesen und
   ' für externe Verwendung im Array speichern
   CopyMemory curTemp, abytData(m), 8
   dblTemp = curTemp
   dteTemp = dblTemp / 86400000
   mastrTags(1, i + 5) = "Abspielzeit"
   mastrTags(2, i + 5) = Format(dteTemp, "hh:nn:ss")
   m = m + 8
   ' Sendezeit auslesen und
   ' für externe Verwendung im Array speichern
   CopyMemory curTemp, abytData(m), 8
   dblTemp = curTemp
   dteTemp = dblTemp / 86400000
   mastrTags(1, i + 6) = "Sendezeit"
   mastrTags(2, i + 6) = Format(dteTemp, "hh:nn:ss")
   m = m + 8
   ' Bufferzeit auslesen und
   ' für externe Verwendung im Array speichern
   CopyMemory curTemp, abytData(m), 8
   dblTemp = curTemp
   dteTemp = dblTemp / 86400000
   mastrTags(1, i + 7) = "Bufferzeit"
   mastrTags(2, i + 7) = Format(dteTemp, "hh:nn:ss")
   m = m + 8 + 4
   ' MinDataPacketSize auslesen und
   ' für externe Verwendung im Array speichern
   CopyMemory lngTemp, abytData(m), 4
   mastrTags(1, i + 8) = "MinDataPacketSize"
   mastrTags(2, i + 8) = lngTemp
   m = m + 4
   ' MaxDataPacketSize auslesen und
   ' für externe Verwendung im Array speichern
   CopyMemory lngTemp, abytData(m), 4
   mastrTags(1, i + 9) = "MaxDataPacketSize"
   mastrTags(2, i + 9) = lngTemp
   m = m + 4
   ' MaximumBitrate auslesen und
   ' für externe Verwendung im Array speichern
   CopyMemory lngTemp, abytData(m), 4
   mastrTags(1, i + 10) = "MaximumBitrate"
   mastrTags(2, i + 10) = lngTemp

End Sub

Private Sub Parse_ASF_Content_Description_Object(abytData() As Byte)
   Dim udtDescription   As OBJ_DESCRIPTION
   Dim i                As Long
   Dim m                As Long
   Dim k                As Integer
   Dim abytTemp()       As Byte
   
   mstrTitle = ""
   mstrAutor = ""
   mstrCopyright = ""
   mstrBeschreibung = ""
   mstrRating = ""
   
   ' Standardfelder auslesen
   On Error Resume Next
   i = UBound(mastrTags, 2)
   ReDim Preserve mastrTags(1 To 2, 1 To i + 5)
   
   CopyMemory udtDescription, abytData(0), Len(udtDescription)
   With udtDescription
      k = .Title_Len
      mastrTags(1, i + 1) = "Titel"
      If k > 2 Then
         ReDim abytTemp(k - 3)
         CopyMemory abytTemp(0), abytData(34), k - 2
         ' Inhalt für externe Verwendung im Array speichern
         mastrTags(2, i + 1) = abytTemp
         ' Inhalt für interne Verwendung speichern
         mstrTitle = abytTemp
      End If
      m = 34 + k
      
      k = .Author_Len
      mastrTags(1, i + 2) = "Autor"
         If k > 2 Then
         ReDim abytTemp(k - 3)
         CopyMemory abytTemp(0), abytData(m), k - 2
         ' Inhalt für externe Verwendung im Array speichern
         mastrTags(2, i + 2) = abytTemp
         ' Inhalt für interne Verwendung speichern
         mstrAutor = abytTemp
      End If
      m = m + k
      
      k = .Copyright_Len
      mastrTags(1, i + 3) = "Copyright"
      If k > 2 Then
         ReDim abytTemp(k - 3)
         CopyMemory abytTemp(0), abytData(m), k - 2
         ' Inhalt für externe Verwendung im Array speichern
         mastrTags(2, i + 3) = abytTemp
         ' Inhalt für interne Verwendung speichern
         mstrCopyright = abytTemp
      End If
      m = m + k
      
      k = .Description_Len
      mastrTags(1, i + 4) = "Description"
      If k > 2 Then
         ReDim abytTemp(k - 3)
         CopyMemory abytTemp(0), abytData(m), k - 2
         ' Inhalt für externe Verwendung im Array speichern
         mastrTags(2, i + 4) = abytTemp
         ' Inhalt für interne Verwendung speichern
         mstrBeschreibung = abytTemp
      End If
      m = m + k
      
      k = .Rating_Len
      mastrTags(1, i + 5) = "Rating"
      If k > 2 Then
         ReDim abytTemp(k - 3)
         CopyMemory abytTemp(0), abytData(m), k - 2
         ' Inhalt für externe Verwendung im Array speichern
         mastrTags(2, i + 5) = abytTemp
         ' Inhalt für interne Verwendung speichern
         mstrRating = abytTemp
      End If
      m = m + k
   End With
   
End Sub

Private Sub Parse_ASF_Extended_Content_Description_Object(abytData() As Byte)
   Dim i                As Long
   Dim k                As Long
   Dim m                As Long
   Dim abytTemp()       As Byte
   Dim curTemp          As Currency
   Dim dblTemp          As Currency
   Dim strName          As String
   Dim strValue         As String
   Dim lngValue         As Long
   Dim lngValueType     As Long
   Dim lngTemp          As Long
   Dim lngNameLen       As Long
   Dim colTemp          As Collection
   Dim lngBegin         As Long
   On Error Resume Next
   
   ' Collection neu anlegen
   Set mcolContentsEx = New Collection
   
   ' Anzahl Objekte im Objekt ermitteln
   CopyMemory k, abytData(24), 2
   
   ' Größe des Ausgabearrays anpassen
   i = UBound(mastrTags, 2)
   ReDim Preserve mastrTags(1 To 2, 1 To i + k)
   
   m = 26
   For k = 1 To k
   
      ' Temporäre Collection anlegen
      Set colTemp = New Collection
      
      ' Beginn des Objektes zwischenspeichern
      lngBegin = m
      
      ' Länge Wertname ermitteln
      CopyMemory lngNameLen, abytData(m), 2
      m = m + 2
      
      ' Wertname ermitteln
      strName = ""
      If lngNameLen > 2 Then
         ReDim abytTemp(lngNameLen - 3)
         CopyMemory abytTemp(0), abytData(m), lngNameLen - 2
         strName = abytTemp
      End If
      
      ' Wertname in temporärer Collection speichern
      colTemp.Add strName, "Name"
      
      m = m + lngNameLen
      
      ' Datentyp auslesen
      CopyMemory lngValueType, abytData(m), 2
      m = m + 2
      
      ' Länge Daten auslesen
      CopyMemory lngTemp, abytData(m), 2
      m = m + 2
      
      strValue = ""
      
      ' Entscheiden, wie der Wert interpretiert wird
      Select Case lngValueType
      
         Case 0 ' Unicodestring
            If lngTemp > 2 Then
               ReDim abytTemp(lngTemp - 3)
               CopyMemory abytTemp(0), abytData(m), lngTemp - 2
               strValue = abytTemp
            End If
            m = m + lngTemp
         Case 1 ' Bytearray
            ReDim abytTemp(lngTemp - 1)
            CopyMemory abytTemp(0), abytData(m), lngTemp
            strValue = abytTemp
            m = m + lngTemp
         Case 2 ' Bool (4 Byte)
            CopyMemory lngValue, abytData(m), 4
            strValue = CBool(lngValue)
            m = m + 4
         Case 3 'DWORD (4 Byte)
            CopyMemory lngValue, abytData(m), 4
            strValue = lngValue
            m = m + 4
         Case 4 ' QWord (8Byte)
            CopyMemory curTemp, abytData(m), 8
            If (InStr(1, LCase(strName), "time")) Or _
               (InStr(1, LCase(strName), "date")) Then
               dblTemp = CDbl(curTemp) / 86400000 + _
                  DateSerial(1601, 1, 1)
               strValue = Format(dblTemp, "DD.MM.YYYY hh:nn:ss")
            Else
               strValue = curTemp * 10000
            End If            m = m + 8
         Case 5 ' Word (2 Byte)
            CopyMemory lngValue, abytData(m), 2
            strValue = lngValue
            m = m + 2
      End Select
      
      ' Komplettes Objekt als Bytearray speichern
      ReDim abytTemp(m - lngBegin - 1)
      CopyMemory abytTemp(0), abytData(lngBegin), m - lngBegin
      
      ' Komplettes Objekt als Bytearray in temporärer Collection speichern
      colTemp.Add abytTemp, "Daten"
      
      ' Inhalt für interne Verwendung in Collection speichern
      mcolContentsEx.Add colTemp
      
      ' Inhalt für externe Verwendung im Array speichern
      i = i + 1
      mastrTags(1, i) = strName
      mastrTags(2, i) = strValue
   Next
End Sub

Public 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 strTemp       As String
   
   ' Die Shell benutzen, um an Dateiinfos zu kommen
   On Error Resume Next
   
   ' Shellobjekt erzeugen
   Set objShell = CreateObject("Shell.Application")
   
   strPath = Left(mstrFileName, InStrRev(mstrFileName, "\"))
   strFile = Mid(mstrFileName, InStrRev(mstrFileName, "\") + 1)
   
   Set objDir = objShell.Namespace(LCase(strPath))
   Set objFile = objDir.ParseName(strFile)
   
   k = UBound(mastrTags, 2)
   
   For i = 0 To 100
   
      strTemp = ""
      strTemp = objDir.GetDetailsOf(objFile, i)
      
      If strTemp <> "" Then
         
         k = k + 1
         ReDim Preserve mastrTags(1 To 2, 1 To k)

         ' Eigenschaftsname auslesen und im Ergebnisarray speichern
         mastrTags(1, k) = objDir.GetDetailsOf(Null, i)
         
         ' Wert im Ergebnisarray speichern
         mastrTags(2, k) = strTemp
         
      End If
      
   Next
   
End Sub

' Daten zurückschreiben
Public Function WriteTags( _
   Optional Titel As String, _
   Optional Autor As String, _
   Optional Copyright As String, _
   Optional Beschreibung As String, _
   Optional Rating As String, _
   Optional AlbumTitle As String, _
   Optional AlbumArtist As String, _
   Optional Provider As String, _
   Optional ProviderRating As String, _
   Optional ProviderStyle As String, _
   Optional Genre As String, _
   Optional Year As String, _
   Optional TrackNumber As String, _
   Optional Track As String, _
   Optional Lyrics As String, _
   Optional Publisher As String, _
   Optional Composer As String, _
   Optional AlbumCoverURL As String, _
   Optional Writer As String, _
   Optional RadioStationName As String, _
   Optional Producer As String, _
   Optional AuthorURL As String _
   ) As Boolean
   
   Dim abytFile()          As Byte
   Dim abytTemp()          As Byte
   Dim abytContent()       As Byte
   Dim abytContentEx()     As Byte
   
   Dim varContentEx        As Variant
   Dim varContent          As Variant
   Dim varTemp             As Variant
   Dim varRest             As Variant
   
   Dim strTemp             As String
   
   Dim i                   As Long
   Dim m                   As Long
   Dim x                   As Long
   Dim lngTemp             As Long
   Dim lngCount            As Long
   Dim FF                  As Long
   Dim abytHeader()        As Byte
   Dim lngHeaderSize       As Long
   
   Dim blnElse             As Boolean
   Dim blnAlbumArtist      As Boolean
   Dim blnAlbumTitle       As Boolean
   Dim blnProvider         As Boolean
   Dim blnProviderRating   As Boolean
   Dim blnProviderStyle    As Boolean
   Dim blnGenre            As Boolean
   Dim blnYear             As Boolean
   Dim blnTrackNumber      As Boolean
   Dim blnTrack            As Boolean
   Dim blnLyrics           As Boolean
   Dim blnPublisher        As Boolean
   Dim blnComposer         As Boolean
   Dim blnAlbumCoverURL    As Boolean
   Dim blnWriter           As Boolean
   Dim blnRadioStationName As Boolean
   Dim blnProducer         As Boolean
   Dim blnAuthorURL        As Boolean
   Dim strTag              As String
   
   On Error Resume Next
   
   ' GUID ASF_Content_Description_Object als Array speichern
   varContentEx = Array( _
      64, 164, 208, 210, 7, 227, 210, 17, 151, 240, 0, _
      160, 201, 94, 168, 80)
      
   ' GUID ASF_Extended_Content_Description_Object als Array speichern
   varContent = Array( _
      51, 38, 178, 117, 142, 102, 207, 17, 166, 217, 0, _
      170, 0, 98, 206, 108)
      
   ReDim abytContent(50000)
   ReDim abytContentEx(50000)
   
   ' GUIDs als Beginn im Bytearray speichern
   For i = 0 To 15
      abytContent(i) = varContent(i)
      abytContentEx(i) = varContentEx(i)
   Next
   
   ' Vorhandene Werte auslesen
   Call WMA_Main
   
   ' Kein ASF-Format, verlassen
   If Not mblnASF Then Exit Function
   
   ' ##################################
   ' # ASF_Content_Description_Object #
   ' ##################################
   
   ' Standardwerte im ASF_Content_Description_Object setzen
   Titel = IIf(Titel = "", mstrTitle, Trim(Titel))
   Autor = IIf(Autor = "", mstrAutor, Trim(Autor))
   Copyright = IIf(Copyright = "", mstrCopyright, Trim(Copyright))
   Beschreibung = IIf(Beschreibung = "", mstrBeschreibung, Trim(Beschreibung))
   Rating = IIf(Rating = "", mstrRating, Trim(Rating))
   
   m = 24 ' Position hinter GUID und Länge
   x = 34 ' Position Beginn des Unicodestrings
   
   ' X wird jeweils als Referenz übergeben und in der aufgerufenen
   ' Prozedur auf den Beginn des nächsten Strings gesetzt
   If Titel <> "" Then CreateContent Titel, abytContent, m, x
   m = m + 2   ' Länge erfordert 2 Bytes
   If Autor <> "" Then CreateContent Autor, abytContent, m, x
   m = m + 2   ' Länge erfordert 2 Bytes
   If Copyright <> "" Then CreateContent Copyright, abytContent, m, x
   m = m + 2   ' Länge erfordert 2 Bytes
   If Beschreibung <> "" Then CreateContent Beschreibung, abytContent, m, x
   m = m + 2   ' Länge erfordert 2 Bytes
   If Rating <> "" Then CreateContent Rating, abytContent, m, x
   ' Array zurechtstutzen
   ReDim Preserve abytContent(x - 1)
   ' Länge ASF_Content_Description_Object speichern
   CopyMemory abytContent(16), x, 4
   
   ' ###########################################
   ' # ASF_Extended_Content_Description_Object #
   ' ###########################################
   With mcolContentsEx
      ' Einträge, die neu geschrieben werden sollen,
      ' aus Collection entfernen
      If AlbumArtist <> "" Then .Remove "WM/AlbumArtist"
      If AlbumTitle <> "" Then .Remove "WM/AlbumTitle"
      If Provider <> "" Then .Remove "WM/Provider"
      If ProviderRating <> "" Then .Remove "WM/ProviderRating"
      If ProviderStyle <> "" Then .Remove "WM/ProviderStyle"
      If Genre <> "" Then .Remove "WM/Genre"
      If Year <> "" Then .Remove "WM/Year"
      If TrackNumber <> "" Then .Remove "WM/TrackNumber"
      If Track <> "" Then .Remove "WM/Track"
      If Lyrics <> "" Then .Remove "WM/Lyrics"
      If Publisher <> "" Then .Remove "WM/Publisher"
      If Composer <> "" Then .Remove "WM/Composer"
      If AlbumCoverURL <> "" Then .Remove "WM/AlbumCoverURL"
      If Writer <> "" Then .Remove "WM/Writer"
      If RadioStationName <> "" Then .Remove "WM/RadioStationName"
      If Producer <> "" Then .Remove "WM/Producer"
      If AuthorURL <> "" Then .Remove "WM/AuthorURL"
   End With
   
   m = 26
   
   For Each varTemp In mcolContentsEx
   ' Liste mit vorhandenen ASF_Extended_Content_Description_Object
   ' Objekten durchlaufen
   
      ' Anzahl Objekte
      lngCount = lngCount + 1
      
      ' Objekt aus Collection unverändert im Bytearray speichern
      abytTemp = varTemp("Daten")
      
      lngTemp = UBound(abytTemp) + 1
      
      ' Inhalt an die entsprechende Stelle im Zialarray speichern
      CopyMemory abytContentEx(m), abytTemp(0), lngTemp
      
      m = m + lngTemp
      
   Next varTemp
   
   ' Noch nicht vorhandene Tags einfügen
   If AlbumArtist <> "" Then
      CreateContentEx "WM/AlbumArtist", AlbumArtist, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If AlbumTitle <> "" Then
      CreateContentEx "WM/AlbumTitle", AlbumTitle, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If Provider <> "" Then
      CreateContentEx "WM/Provider", Provider, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If ProviderRating <> "" Then
      CreateContentEx "WM/ProviderRating", ProviderRating, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If ProviderStyle <> "" Then
      CreateContentEx "WM/ProviderStyle", ProviderStyle, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If Genre <> "" Then
      CreateContentEx "WM/Genre", Genre, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If Year <> "" Then
      CreateContentEx "WM/Year", Year, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If TrackNumber <> "" Then
      CreateContentEx "WM/TrackNumber", TrackNumber, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If Track <> "" Then
      CreateContentEx "WM/Track", Track, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If Lyrics <> "" Then
      CreateContentEx "WM/Lyrics", Lyrics, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If Publisher <> "" Then
      CreateContentEx "WM/Publisher", Publisher, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If Composer <> "" Then
      CreateContentEx "WM/Composer", Composer, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If AlbumCoverURL <> "" Then
      CreateContentEx "WM/AlbumCoverURL", AlbumCoverURL, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If Writer <> "" Then
      CreateContentEx "WM/Writer", Writer, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If RadioStationName <> "" Then
      CreateContentEx "WM/RadioStationName", RadioStationName, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If Producer <> "" Then
      CreateContentEx "WM/Producer", Producer, abytContentEx, m
      lngCount = lngCount + 1
   End If
   If AuthorURL <> "" Then
      CreateContentEx "WM/AuthorURL", AuthorURL, abytContentEx, m
      lngCount = lngCount + 1
   End If
   
   ' Array zurechtstutzen
   ReDim Preserve abytContentEx(m - 1)
   
   ' Länge ASF_Extended_Content_Description_Object speichern
   CopyMemory abytContentEx(16), m, 4
   
   ' Anzahl enthaltene Objekte speichern
   CopyMemory abytContentEx(24), lngCount, 2
   
   ' Dateipuffer ausreichend dimensionieren
   ReDim abytFile(mlngFileLen * 1.5)
   
   
   ' ##########################################
   ' # Datei zusammensetzen #
   ' ##########################################
   
   ' Headerkopf
   lngTemp = UBound(mabytASF_Header_Object) + 1
   CopyMemory abytFile(0), mabytASF_Header_Object(0), 30
   m = 30
   
   ' ASF_Content_Description_Object speichern
   lngTemp = UBound(abytContent) + 1
   If lngTemp > 1 Then
      CopyMemory abytFile(m), abytContent(0), lngTemp
      m = m + lngTemp
   End If
   
   ' ASF_Extended_Content_Description_Object speichern
   lngTemp = UBound(abytContentEx) + 1
   If lngTemp > 1 Then
      CopyMemory abytFile(m), abytContentEx(0), lngTemp
      m = m + lngTemp
   End If
   
   ' Rest des Headers speichern
   lngTemp = UBound(mabytASF_Header_Object) + 1
   lngTemp = lngTemp - mlngAfterContent
   If lngTemp > 1 Then
      CopyMemory abytFile(m), mabytASF_Header_Object(mlngAfterContent), lngTemp
      m = m + lngTemp
   End If
   
   lngHeaderSize = m
   
   ' Datenstream speichern
   lngTemp = UBound(mabytOutsideHeader) + 1
   If m + lngTemp > UBound(abytFile) Then Exit Function
   If lngTemp > 1 Then
      CopyMemory abytFile(m), mabytOutsideHeader(0), lngTemp
      m = m + lngTemp
   End If
   
   ' Array auf Dateigröße kappen
   ReDim Preserve abytFile(m - 1)
   
   'HeaderSize eintragen
   CopyMemory abytFile(16), lngHeaderSize, 4
   
   'Dateigröße eintragen
   CopyMemory abytFile(m + mlngPosFileProp + 39), m, 4
   
   If mblnSik Then
      Err.Clear
      Name mstrFileName As Left(mstrFileName, Len(mstrFileName) - 3) & "sik"
      If Err.Number = 58 Then
         ' Vorhandene Datei mit gleichem Namen löschen
         Kill mstrFileName & ".sik"
         ' Sicherheitskopie mit der Endung sic anlegen
         Name mstrFileName As mstrFileName & ".sik"
      End If
   Else
      ' Original wird gelöscht
      Kill mstrFileName
   End If
   
   FF = FreeFile
   ' WMA Datei öffnen/anlegen und Inhalt speichern
   Open mstrFileName For Binary As #FF
      Put #FF, , abytFile
   Close ' WMA Datei Schließen
   
   ' Ergebnis zurückgeben
   WriteTags = True
   
End Function

Private Sub CreateContentEx( _
   ByRef strName As String, _
   ByVal strValue As String, _
   ByRef abytField() As Byte, _
   ByRef m As Long)
   
   Dim lngTemp    As Long
   Dim lngType    As Long
   Dim abytTemp() As Byte
   
   ' Content Descriptor erzeugen
   
   lngType = 0 ' Unicodestring
   
   strName = strName & Chr(0)
   strValue = strValue & Chr(0)
   
   ' Array aus String
   abytTemp = strName
   ' Länge in Bytes
   lngTemp = LenB(strName)
   
   ' Länge Wertname kopieren
   CopyMemory abytField(m), lngTemp, 2
   m = m + 2
   
   ' Wertname kopieren
   CopyMemory abytField(m), abytTemp(0), lngTemp
   m = m + lngTemp
   
   ' Werttyp eintragen
   CopyMemory abytField(m), lngType, 2
   m = m + 2
   
   abytTemp = strValue
   lngTemp = LenB(strValue)
   
   ' Länge Wert kopieren
   CopyMemory abytField(m), lngTemp, 2
   m = m + 2
   
   ' Wert kopieren
   CopyMemory abytField(m), abytTemp(0), lngTemp
   m = m + lngTemp
   
End Sub

Private Sub CreateContent( _
   ByRef strText As String, _
   ByRef abytContent() As Byte, _
   ByRef m As Long, _
   ByRef x As Long _
   )
   Dim lngTemp       As Long
   Dim abytTemp()    As Byte
   
   lngTemp = Len(strText) * 2 + 2
   abytTemp = strText & Chr(0) ' Ende String &h0000
   CopyMemory abytContent(m), lngTemp, 2 ' Länge in Bytes
   CopyMemory abytContent(x), abytTemp(0), lngTemp ' Unicodestring
   x = x + lngTemp
   
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

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

' Festlegen, ob Sicherheitskopien erstellt werden
Public Property Let SicherheitskopienAnlegen(ByVal vNewValue As Boolean)
  mblnSik = vNewValue
End Property

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

Private Sub Class_Initialize()
   mblnSik = True
   mblnShowShell = True
End Sub

Listing 1.4

Die öffentliche Funktion Tags

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

Zuerst wird die Prozedur WMA_Main aufgerufen. Nach der Rückkehr enthält das Array mastrTags alle ausgelesenen Informationen, die als Funktionsergebnis zurückgegeben werden.

Die Prozedur WMA_Main

Diese Prozedur öffnet die mit der Eigenschaft Filename spezifizierte Datei, liest die enthaltenen Daten in das Array abytFile und schließt die Datei wieder. In das Array abytTemp werden anschließend mit der API CopyMemory die ersten 16 Bytes der Datei kopiert, mit der Funktion BytesToGUIDString in einen GUID-String umgewandelt und in der Variablen strGUID gespeichert.

Nun werden in das klassenweit gültige Array mastrTags die ersten zwei Elemente (zweite Dimension) eingetragen. Das sind der Dateiname und der Dateipfad. Das erste Element der ersten Dimension nimmt dabei den Informationsnamen und das zweite den zugehörigen Wert auf.

Sind Informationen gewünscht, die über die Shell geliefert werden, erkennbar an dem Wert der Variablen mblnShowShell, wird die Prozedur GetExtendedInfos aufgerufen.

Jetzt wird nachgeschaut, ob die Datei auch tatsächlich eine ASF-Datei ist, dazu wird die GUID der ersten 16 Bytes der Datei ausgewertet. Entspricht sie dem Wert der Konstanten ASF_Header_Object, enthält diese Datei ein auswertbares Header-Objekt, wenn nicht, wird die Prozedur an dieser Stelle verlassen.

Die 8 Bytes (QWORD) ab der 17. Position in der Datei enthalten die Länge des Headers. In nahezu allen Fällen reichen aber die 4 Bytes des Low-Double-Words aus. Bei Videodateien könnte es in seltenen Fällen etwas knapp werden, denn ein vorzeichenbehafteter Long-Wert kann nur positive Werte bis etwa 2 GB annehmen und man müsste in diesem Fall einen 8 Byte breiten Datentyp verwenden. Ein Header mit einer Größe von über 2 GB wird aber auch dort in den seltensten Fällen anzutreffen sein. Das gleiche gilt auch für die untergeordneten Objekte.

Mit Hilfe dieser ausgelesenen Längenangabe wird mit der API CopyMemory der gesamte Header in das klassenweit gültige Bytearray mabytASF_Header_Object kopiert. Der Rest der Datei wird im klassenweit gültigen Bytearray mabytOutsideHeader gespeichert.

Nun kann man in einer Schleife den kompletten Header durchlaufen, indem man für jedes darin enthaltene Objekt die 16 Byte breite GUID, die darauf folgende Längenangabe und die sich daran anschließenden Daten ausliest. An der ersten Position hinter einem Objekt folgt die nächste GUID, eine Längenangabe und wiederum Daten. Die Schleife wird so lange durchlaufen, bis man am Ende vom Header angelangt ist.

Jede ausgelesene GUID, also wieder diese ominösen 16 Byte, werden mit der Funktion BytesToGUIDString in einen GUID-String umgewandelt. Bei jedem Schleifendurchlauf wird mit Select Case nachgeschaut, ob das aktuelle Objekt ausgewertet werden soll. Nachfolgende GUIDs werden ausgewertet, indem die entsprechende Prozedur aufgerufen wird und das komplette Objekt als Bytearray übergeben wird:

·         ASF_Content_Description_Object:_ASF_Content_Description_Object

·          ASF_Extended_Content_Description_Object: Parse_ASF_Extended_Content_Description_Object

·         ASF_Stream_Properties_Object: Parse_ASF_Stream_Properties_Object

·         ASF_Stream_Bitrate_Properties_Object: Parse_ASF_Stream_Bitrate_Properties_Object

·         ASF_File_Properties_Object: Parse_ASF_File_Properties_Object

·         ASF_Codec_List_Object: Parse_ASF_Codec_List_Object

Das Auswerten anderer interessanter Objekte ist vorbereitet, es ist aber keine entsprechende Prozedur vorhanden. Wie das auszuwertende Objekt aufgebaut ist, lässt sich der Dokumentation von Microsoft entnehmen. Diese ist letztendlich die exakte Wegbeschreibung, der man unbedingt folgen sollte.

Die Prozedur Parse_ASF_Codec_List_Object

Diese interne Funktion übernimmt ein Bytearray, welches das komplette Objekt enthält.

In diesem Bytearray findet man ab Byte 40 eine 4 Byte große Angabe, wie viel Codecs im Objekt zu Finden sind. In einer Schleife werden nacheinander alle verfügbaren Codec-Informationen durchlaufen.

Jeder Codec beginnt mit einer 2 Byte breiten Angabe, die den Typ des Codecs beschreibt, 1 bedeutet beispielsweise Videocodec, 2 gleich Audiocodec. Darauf folgt eine 2 Byte große Längenangabe, welche die Länge des Codecnamens angibt und darauf der eigentliche Name. Die nächsten 2 Bytes geben die Länge der nachfolgenden Beschreibung an. Darauf folgt wieder eine 2 Byte große Längenangabe und anschließend kommen die eigentlichen CodecInfos.

Der Typ, der Name, die Beschreibung und die Codecinfos werden in einer Zeichenkette zusammengefasst und in dem klassenweit gültigen Array mastrTags gespeichert.

Die Prozedur Parse_ASF_Stream_Bitrate_Properties_Object

Diese interne Funktion übernimmt ein Bytearray, welches das komplette Objekt enthält.

In diesem Bytearray findet man ab Byte 24 eine 2 Byte große Angabe, wie viele Informationen zu (Record) Streams in diesem Objekt zu Finden sind. In einer Schleife werden nacheinander alle durchlaufen. Jede Information zur Bitrate eines Streams beginnt mit einer 2 Byte breiten Recordnummer. Darauf folgt eine 4 Byte große Angabe zur Bitrate des Streams.

Die Recordnummer und die zugehörige Bitrate werden in einem String zusammengefasst und in dem klassenweit gültigen Array mastrTags gespeichert.

Die Prozedur Parse_ASF_Stream_Properties_Object

Diese interne Funktion übernimmt ein Bytearray, welches das komplette Objekt enthält.

In diesem Bytearray findet man ab Byte 24 eine 16 Byte große GUID, welche den Medientyp beschreibt. Die ausgelesene GUID wird mit der Funktion BytesToGUIDString in einen GUID-String umgewandelt und mit Select Case unter Zuhilfenahme verschiedener GUID-Konstanten in den jeweiligen Namen übersetzt.

Dieser nun als String vorliegende Medientyp wird anschließend in dem klassenweit gültigen Array mastrTags gespeichert.

Die Prozedur Parse_ASF_File_Properties_Object

Diese interne Funktion übernimmt ein Bytearray, welches das komplette Objekt enthält.

In diesem Bytearray findet man ab Byte 24 eine 16 Byte große, einmalige Dateikennung, eine sogenannte GUID. Die ausgelesene GUID wird mit der Funktion BytesToGUIDString in einen GUID-String umgewandelt und in einer Variablen gespeichert.

Darauf folgt die 8 Byte große Angabe der Dateigröße, welche mit CopyMemory in eine Variable vom Typ Currency kopiert wird. Da dieser Datentyp eine skalierte Ganzzahl ist, muß dieser noch mit dem Faktor 10000 multipliziert werden.

Die nächsten 8 Bytes enthalten den Erstellungszeitpunkt in 100 Nanosekunden seit dem 01.01.1601. Auch hier wird der skalierte Ganzzahlentyp Currency benutzt, die 8 Bytes werden mit CopyMemory in diese Variable hinein kopiert und anschließend in einen Datumswert umgewandelt.

Darauf folgen noch weitere 8 Byte große Werte, die alle mit CopyMemory in eine Variable vom Typ Currency kopiert werden. Das sind einmal die Anzahl der Datenpakete, die Abspiel-, Sende- und Bufferzeit in Millisekunden, die Angaben zu MinDataPacketSize, MaxDataPacketSize und MaximumBitrate.

Die Prozedur Parse_ASF_Content_Description_Object

Diese interne Funktion übernimmt ein Bytearray, welches das komplette Objekt enthält. In diesem Bytearray findet man die Standardtags Titel, Autor, Copyright, Beschreibung und Rating.

Zu Beginn kopiert man erst einmal mit CopyMemory 34 Byte Daten ab Position 1 in eine Struktur vom Typ OBJ_DESCRIPTION. Diese Struktur enthält dann unter anderen die Anzahl der Bytes (nicht der Zeichen) der einzelnen Tags.

Mit CopyMemory werden die jeweils angegebenen Bytes aus dem übergebenen Bytearray ab der jeweils berechneten Position in ein temporäres Bytearray kopiert. Dieses wiederum wird als String in dem klassenweit gültigen Array mastrTags gespeichert. Mit StrConv muss in diesem Fall nicht gearbeitet werden, da bereits das Bytearray den Text als Unicode enthält und ein einfaches Zuweisen ausreicht.

Die Prozedur Parse_ASF_Extended_Content_Description_Object

Diese interne Funktion übernimmt ein Bytearray, welches das komplette Objekt enthält. In diesem Bytearray findet man verschiedene benutzerdefinierte Tags. Die Art, Anzahl und Größe ist dabei nicht von vornherein festgelegt oder begrenzt, einige Tags sind aber von Microsoft näher spezifiziert und als Standard veröffentlicht worden. Beim Zurückschreiben werden lediglich die offiziellen Tags berücksichtigt, ausgelesen aber alle.

Ab Byte 24 gibt eine zwei Byte große Zahl Auskunft darüber, wieviel Tags dieses Objekt überhaupt enthält. Mit CopyMemory wird diese Information in eine Variable kopiert. Das klassenweit gültige Array mastrTags wird nun in der zweiten Dimension so redimensioniert, dass es alle zu erwartenden Tags auch aufnehmen kann.

An dieser Stelle wird auch die klassenweit gültige Kollektion mcolContentsEx angelegt, die dazu dient, alle ausgelesenen Tags für die weitere interne Verwendung (Zurückschreiben von Tags) zwischenzuspeichern.

In einer For … Next Schleife werden nun nacheinander alle Tags ausgelesen. In jedem Schleifendurchlauf wird zu Beginn eine neue, temporäre Kollektion angelegt. Diese nimmt verschiedene Informationen auf, darunter auch den kompletten, unveränderten Tag als Bytearray. Diese temporäre Kollektion wird dann später in der klassenweit gültigen Kollektion mcolContentsEx mit dem Tagnamen als Schlüssel gespeichert.

Ein Tag beginnt mit einer 2 Byte großen Angabe, welche die Länge des darauf folgenden Tagnamens in Byte angibt. Eingeschlossen in diese Längenangabe sind die zwei Nullbytes am Ende, welche das Ende eines Unicodestrings kennzeichnen. Die Länge wird mit CopyMemory direkt aus dem Bytearray in eine Variable kopiert. Bei Zeichenketten wird mit CopyMemory erst einmal der Unicodetext aus dem Bytearray in ein temporäres Bytearray kopiert und anschließend direkt einer Stringvariablen zugewiesen.

Darauf folgen 2 Bytes, welche den Datentyp angeben. Die daran anschließenden 2 Bytes enthalten die Länge der nachfolgenden Daten. Beide Angaben werden mit CopyMemory in Variablen kopiert. Je nach Datentyp werden die Daten unterschiedlich behandelt.

·         Unicodestring
Dieser Datentyp wird so behandelt, wie zuvor der Tagname. Die Variable strValue nimmt den Inhalt zur Ausgabe auf.

·         Bytearray
Die Variable strValue behandelt den Inhalt als Unicodestring und nimmt den Inhalt zur Ausgabe auf.

·         Bool
Die Variable strValue nimmt den als Wahrheitswert interpretierten 4 Byte großen Datentyp Bool auf.

·         DWORD
Die Variable strValue nimmt den als Zahl (Long) interpretierten 4 Byte großen Datentyp DWORD auf.

·         QWord
Die Variable strValue nimmt den als Datum interpretierten 8 Byte großen Datentyp QWord auf. Die 8 Bytes enthalten den Zeitpunkt in 100 Nanosekunden seit dem 01.01.1601. Hier wird der skalierte Ganzzahlentyp Currency benutzt, die 8 Bytes werden mit CopyMemory in diese Variable hinein kopiert und anschließend in einen Datumswert umgewandelt.

·         Word
Die Variable strValue nimmt den als Zahl (Integer) interpretierten 2 Byte großen Datentyp Word auf.

Danach wird der komplette Tag in der temporären Kollektion unter dem Namen "Daten" gespeichert. Die temporäre Kollektion wird anschließend in der klassenweit gültigen Kollektion mcolContentsEx unter dem Namen des Tags gespeichert.

Für die externe Verwendung wird jeweils der ausgelesene Name und der Wert im Array mastrTags gespeichert.

Die öffentliche Funktion WriteTags

Diese Funktion übernimmt als Argumente 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 man 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 (mobjWMA.WriteTags( Title:=txtTitle1, Comments:=txtComments). Somit erspart man sich eine wahre Orgie von Kommata, möchte man beispielsweise nur das letzte Argument übergeben.

Zu Beginn werden erst einmal zwei Bytearrays abytContent und abytContentEx variabler Größe angelegt, welche später die zwei Objekte ASF_Content_Description_Object und ASF_Extended_Content_Description_Object aufnehmen sollen.

Darin hinein werden an den Anfang die entsprechenden GUIDs (16 Byte Daten) kopiert, welche das Objekt kennzeichnen. Anschließend ruft man die Prozedur WMA_Main, in welcher die Zieldatei neu ausgelesen wird. Ist anschließend die Variable mblnASF falsch, kann man die Prozedur verlassen, da es sich bei der Datei offensichtlich nicht um eine WMA-Datei handelt.

Um nichtleere Standardtags in das Bytearray abytContent zu kopieren, wird die Prozedur CreateContent benutzt. Dieser übergibt man das Bytearray, den Inhalt des Tags als String, die Position der Längenangabe und die Position, an welcher der jeweilige Unicodestring beginnt.

Die letzte Positionsangabe wird als Referenz übergeben, das bedeutet, dass eine Änderung der Variablen in der aufgerufenen Prozedur auch den Variableninhalt in der aufrufenden Prozedur ändert. In der aufgerufenen Prozedur ist die Länge des übergebenen Unicodestrings bekannt und es wird am Ende der Zeiger x auf den Anfang des nächsten Strings gesetzt.

Die Position der Längenangabe m wird jedes Mal um zwei erhöht, unabhängig davon, ob zuvor die Prozedur CreateContent aufgerufen wurde. Am Ende dient die Positionsangabe x noch dazu, das Bytearray abytContent zu redimensionieren und die Länge des gesamten Objektes als 4 Byte großen Longwert ab Position 17 zu schreiben.

Nun kommen die Tags des ASF_Extended_Content_Description_Object an die Reihe. Die darin enthaltenen Tags stecken als Bytearray nach dem Aufruf der Prozedur Parse_ASF_Extended_Content_Description_Object in der Kollektion mcolContentsEx. Wird als Argument an die Funktion WriteTags ein nichtleerer String übergeben, wird das gleichnamige Element in der Kollektion mcolContentsEx gelöscht.

Anschließend werden die übrig gebliebenen Elemente in einer For Each Schleife durchlaufen. Jedes Element enthält wiederum ein Element mit dem Namen "Daten", welches das komplette Tag als Bytearray enthält. Dieses wird dann mit CopyMemory in das Array abytContentEx kopiert. Nachdem alle nicht zu ändernden Tags dort unverändert hineinkopiert wurden, kann man daran gehen, die zu ändernden Tags hineinzuschreiben.

Dazu wird jeweils nachgeschaut, ob das übergebene Argument einen nichtleeren String enthält. Ist das der Fall, wird die Prozedur CreateContentEx aufgerufen. Dieser wird als Argument das Bytearray abytContentEx als Referenz übergeben, damit immer auch das Original geändert wird. Weiterhin werden der Tagname, der Taginhalt und der Zeiger m auf die Position übergeben, ab der der Tag in das Bytearray geschrieben wird. Der Zeiger wird auch in diesem Fall als Referenz übergeben.

Am Ende dient die Positionsangabe m noch dazu, das Bytearray abytContentEx zu redimensionieren, und die Länge des gesamten Objektes als 4 Byte großen Longwert ab Position 17 zu schreiben. Ab Position 25 wird noch die Anzahl der enthaltenen Tags als 2 Byte große Angabe geschrieben.

Nachdem man die Objekte ASF_Extended_Content_Description_Object und ASF_Content_Description_Objects als Bytearrays vorliegen hat, kann man daran gehen, die komplette Datei als Bytearray abytFile zusammenzusetzen.

Zuerst wird mit CopyMemory der Headerkopf in das Bytearray abytFile kopiert, dieser steckt in dem Array mabytASF_Header_Object. Anschließend werden die als Bytearrays vorliegenden Objekte ASF_Extended_Content_Description_Object und ASF_Content_Description_Objects in das Bytearray abytFile kopiert. Der Rest des Headers steckt in dem Bytearray mabytASF_Header_Object ab der Position mlngAfterContent. Auch dieser Teil wird in das Bytearray abytFile kopiert.

Nun fehlt im Bytearray abytFile noch die Angabe zur Länge des Headers (lngHeaderSize), dieser wird mit CopyMemory an die Position 17 geschrieben. An den Header schließt sich der Rest der ursprünglichen Datei an, der im Bytearray mabytOutsideHeader steckt und unverändert in das Array abytFile kopiert wird.

Das Zielarray wird nun zurechtgestutzt und die Gesamtlänge an die zugehörige Position im ASF_File_Properties_Object geschrieben. Die Variable mlngPosFileProp enthält die Position des ASF_File_Properties_Object relativ zum Ende der Ursprungsdatei. Die gesuchte Längenangabe liegt 39 Bytes dahinter.

Ist eine Sicherungskopie gewünscht, wird die Ursprungsdatei umbenannt, sie erhält die Dateiendung sik. Ist das nicht der Fall, wird die Ursprungsdatei gelöscht. Nun wird mit der Open-Anweisung eine neue Datei im Zielpfad mit Zielnamen angelegt und mit dem Put-Befehl werden die Daten des Bytearrays abytFile hineingeschrieben. Mit der Close-Anweisung wird die Datei geschlossen.

Die Prozedur CreateContentEx

Diese Prozedur legt einen Tag im übergebenen Array abytField an. Da das Array als Referenz übergeben wird, ändert man in dieser Prozedur auch das Originalarray.

Zu Beginn werden an die übergebenen Argumente strName und strValue jeweils ein Zeichen mit dem Asciicode Null gehängt. VBA kennt, im Gegensatz zu C oder C++ keine Nullterminierten Strings, deshalb muss das terminierende Zeichen angehängt werden. Durch einfaches Zuweisen zu einem Bytearray variabler Länge werden aus den Nullterminierten Strings Unicode-Bytearrays.

Nun wird jeweils mit CopyMemory die Länge des Namens (2 Byte), der Tagname (Bytearray), der Werttyp (2 Byte), die Länge des Wertes (2 Bytes) und der Wert selber (Bytearray) in das Bytearray abytField kopiert. Der übergebene Zeiger wird auf die Position hinter dem Wert gesetzt.

Die Prozedur CreateContent

Diese Prozedur legt ein Tag im übergebenen Array abytContent an Da das Array als Referenz übergeben wird, ändert man in dieser Prozedur auch das Originalarray.

Zu Beginn wird an das übergebene Argument strText ein Zeichen mit dem Asciicode Null gehängt. VBA kennt, im Gegensatz zu C oder C++ keine Nullterminierten Strings, deshalb muss das terminierende Zeichen angehängt werden. Durch einfaches Zuweisen zu einem Bytearray variabler Länge wird aus dem Nullterminierten String ein Unicode-Bytearray.

An die Position m wird die Länge (2 Bytes) und an die Position x das Bytearray kopiert. Die Position x wird anschließend hinter das Ende des eingetragenen Unicodetextes gesetzt.

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. Diese ausgelesenen Eigenschaften werden anschließend in dem klassenweit gültigen Array mastrTags gespeichert.

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.