MP3-Liste
Auf ihrer Platte haben sich viele MP3's angesammelt?
Meine Klasse MP3_Infos liefert die Informationen einer MP3-Datei wie Titel,
Artist, Songlänge, Genre, Album, Jahr, Track, Kommentar, Bitrate, Layer,
Version, Samplingrate, Aufzeichnungsmodus, Rauschunterdrückung, Original-
und Copyrightflag. Wo es Sinn macht, können die Daten auch zurückgeschrieben
werden. Die neuen (seltenen) ID3 V2 Framebasierenden Tags werden auch gelesen,
können in der vorliegenden Version aber nicht zurückgeschrieben werden.
Im vorliegenden Modul kann über einen Dialog (API) ein Anfangsverzeichnis
ausgewählt werden, an dem die Suche nach MP3's beginnt. Da Dir$ Rekursionen
nicht packt, werden die untergeordneten Verzeichnisse in einem Array zwischengespeichert
und später abgearbeitet. Die Infos der Dateien werden in einer Collection
gespeichert, diese wird dann als Element einer Übergeordneten Collection
übergeben. Nachher werden die Infos in das Tabellenblatt geschrieben, gleichzeitig
wird je ein Hyperlink erzeugt, damit man durch einen simlen Klick das Lied abspielen
kann.
'Beginn Klasse
Private iPfad As String
Private iSamplingrate As String
Private iBitrate As Double
Private iAufzeichnungsmodus As String
Private iMpegArt As Byte
Private iMpegLayer As Byte
Private iLänge As Long
Private iCopyright As Boolean
Private iOriginal As Boolean
Private iEmphases As String
Private iTrack As String
Private iGenre()
Private TagInfo As MP3Tag
Private iv3Album As String
Private iv3Titel As String
Private iv3Artist As String
Private iv3Track As String
Private iv3Genre As String
Private iv3Kommentar As String
Private iv3Jahr As String
Private iv3Sprache As String
Private iv3Länge As String
Private iv3Typ As String
Private iv3UrspKünstler As String
Private iv3PlayZähler As String
Private iv3Encodet As String
Private iv3Link As String
Private iv3Copyr As String
Private iv3Composer As String
Private iv3Publisher As String
Private iv3Software As String
Private Header As String * 10000
Private iv3Sonstiges As String
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 Sub InfosHolen()
Dim iHeader() As Byte
Dim DateiNr As Long
Dim Header As String
Dim Headerbeginn As Long
Dim zähler As Long
Dim ID3V3pos As Long, IDV3Länge(0 To 3) As Byte
Dim ID3Vers(0 To 1) As Byte, IDV3TagLänge As Long
DateiNr = FreeFile
Open iPfad For Binary As #DateiNr
iLänge = LOF(DateiNr)
'Einfach ein paar tausend Zeichen
einlesen, irgendwo
'darin ist schon ein Frame
Get #DateiNr, 1, Header
Do
'Das Syncword
des ersten Frames suchen. 12 Bits &HFFF
'Noch nie beobachtet, aber auch
&HFFE möglich.
zähler = zähler +
1
zähler = InStr(zähler,
Header, Chr(&HFF))
If ((Asc(Mid$(Header, zähler
+ 1, 1)) And &HF0) = &HF0) _
Or ((Asc(Mid$(Header,
zähler + 1, 1)) And &HE0) = &HE0) Then
'Syncword
gefunden
Headerbeginn
= zähler
'Headergröße gesamt ist nur 4 Byte, bleiben nach Abzug
'des
Syncwords 12 Bits übrig
iHeader
= StrConv(Mid$(Header, _
Headerbeginn,
4), vbFromUnicode)
'Den Tag auslesen, der die infos über Musikstück enthält.
'Das
sind die letzten 128 Bytes
Get
#DateiNr, iLänge - 127, TagInfo
If LCase(TagInfo.Tag)
<> "tag" Then
TaginfoLöschen
Get
#DateiNr, 1, Header
ID3V3pos
= InStr(Header, "ID3")
If
ID3V3pos <> 0 Then
Get
#DateiNr, ID3V3pos + 3, ID3Vers
' ID3V2 Tag wurde gefunden
Get
#DateiNr, ID3V3pos + 6, IDV3Länge
'Da &HFFF nicht vorkommen darf, sind jeweils
'die
4 oberen Bits eines Bytes Lo. Deshalb die
'umständliche
Berechnung
IDV3TagLänge
= CLng(IDV3Länge(0)) * 16384 _
+
CLng(IDV3Länge(1)) * 2048 _
+
CLng(IDV3Länge(2)) * 256 _
+
CLng(IDV3Länge(3)) + 10
Get
#DateiNr, 1, Header
ID3Info
Header, ID3Vers(0)
End
If
Else
iAufzeichnungsmodus
= Aufzeichnungsmodus(iHeader)
iSamplingrate
= Samplingrate(iHeader)
iBitrate
= Bitratenwert(iHeader)
iEmphases
= Emphases(iHeader)
iCopyright
= (iHeader(3) And 2 ^ 3) <> 0
iOriginal
= (iHeader(3) And 2 ^ 2) <> 0
End
If
Exit
Do
End If
Loop While zähler <> 0
Fehlerbehandlung:
Close
End Sub
Private Function Emphases(a As Variant) As String
If a(0) = 0 Then Exit Function
'Emphase Algorithmus zur Qualitätsverbesserung
Select Case (a(3) And 3)
Case 0
Emphases = "Keine"
Case 1
Emphases = "50/15 ms "
Case 2
Emphases = "reserviert"
Case 3
Emphases = "CCITT j.17"
End Select
End Function
Private Function Aufzeichnungsmodus(a As Variant) As
String
If a(0) = 0 Then Exit Function
Select Case (a(3) \ 2 ^ 6)
Case 0
Aufzeichnungsmodus = "Stereo"
Case 1
Aufzeichnungsmodus = "JointStereo"
Case 2
Aufzeichnungsmodus = "DualChannel"
Case 3
Aufzeichnungsmodus = "Mono"
End Select
End Function
Private Function Samplingrate(a As Variant) As String
If a(0) = 0 Then Exit Function
Select Case (a(2) \ 2 ^ 2) And 3
Case 0
Samplingrate = "44100Hz
- 22050Hz"
Case 1
Samplingrate = "48000Hz
- 24000Hz"
Case 2
Samplingrate = "32000Hz
- 16000Hz"
End Select
End Function
Private Function Bitratenwert(a As Variant) As Double
'Die Kombination MPEG1 oder MPEG2 und der Index
'ergibt die Position in der festgelegten Tabelle
Dim Rate As Byte
Dim dummy(1 To 6)
Dim i As Long, k As Long, l As Long
Dim Bitraten(1 To 2, 1 To 3, 1 To 14)
On Error Resume Next
If a(0) = 0 Then Exit Function
If a(1) = 0 Then Exit Function
If a(2) = 0 Then Exit Function
If a(1) And 2 ^ 3 Then iMpegArt = 1
iMpegArt = 2 - iMpegArt
iMpegLayer = 4 - (a(1) \ 2) And 3
If iMpegLayer = 0 Then iMpegLayer = 3
Rate = (a(2) \ 2 ^ 4)
dummy(1) = Array(32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416,
448)
dummy(2) = Array(32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320,
384)
dummy(3) = Array(32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320)
dummy(4) = dummy(1)
dummy(5) = dummy(2)
dummy(6) = Array(8, 16, 24, 32, 64, 80, 65, 64, 128, 160, 112, 128, 256, 320)
For i = 0 To 1
For k = 1 To 3
For l = 0 To 13
Bitraten(i
+ 1, k, l + 1) = dummy(i * 3 + k)(l)
Next
Next
Next
Bitratenwert = Bitraten(iMpegArt, iMpegLayer, Rate)
End Function
Private Function GenreString(Wert As Byte) As String
On Error Resume Next
GenreString = iGenre(Wert)
End Function
Private Function NullTrim(a As String) As String
Dim zähler As Long, b As String
For zähler = 1 To Len(a)
b = Mid$(a, zähler, 1)
If (Asc(b) > 31) And (Asc(b) < 128) Then
NullTrim = NullTrim & b
End If
Next
NullTrim = Trim(NullTrim)
End Function
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Nur Leserechte. Änderungen machen keinen Sinn
Public Property Get Layer() As String
Select Case iMpegLayer
Case 0
Layer = "Ungültig"
Case 1
Layer = "Layer 1 Dig. Compact
Casette"
Case 2
Layer = "Layer 2 DAB, MUSICAM"
Case 3
Layer = "Layer 3 MP3"
End Select
End Property
Public Property Get Songlänge() As String
On Error Resume Next
Songlänge = Format$((iLänge * 8 / (iBitrate
* 1000)) / (3600 * CDbl(24)), "hh:mm:ss")
End Property
Public Property Get Sampling() As String
Sampling = iSamplingrate
End Property
Public Property Get Bitrate() As String
Bitrate = iBitrate
End Property
Public Property Get Stereomodus() As String
Stereomodus = iAufzeichnungsmodus
End Property
Public Property Get MpegArt() As String
MpegArt = "Mpeg-" & iMpegArt
End Property
Public Property Get MpegLayer() As String
MpegLayer = iMpegLayer
End Property
Public Property Get Copyright() As Boolean
Copyright =iCopyright
End Property
Public Property Get Original() As Boolean
Original = iOriginal
End Property
Public Property Get Rauschunterdrückung() As String
Rauschunterdrückung = iEmphases
End Property
Public Property Get Pfad() As String
Pfad = iPfad
End Property
Public Property Let Pfad(ByVal vNewValue As String)
iPfad = vNewValue
ZusatzinfosLöschen
InfosHolen
End Property
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Lesen und Schreiben
Public Sub WerteZurückschreiben()
Dim DateiNr As Long
DateiNr = FreeFile
On Error GoTo Fehlerbehandlung
Open iPfad For Binary As #DateiNr
Put #DateiNr, LOF(DateiNr) - 127, TagInfo
Close
Fehlerbehandlung:
End Sub
Public Property Get Titel() As String
Titel = NullTrim(TagInfo.Titel)
End Property
Public Property Let Titel(ByVal vNewValue As String)
TagInfo.Titel = vNewValue
End Property
Public Property Get Artist() As String
Artist = NullTrim(TagInfo.Artist)
End Property
Public Property Let Artist(ByVal vNewValue As String)
TagInfo.Artist = vNewValue
End Property
Public Property Get Album() As String
Album = NullTrim(TagInfo.Album)
End Property
Public Property Let Album(ByVal vNewValue As String)
TagInfo.Album = vNewValue
End Property
Public Property Get Jahr() As String
Jahr = NullTrim(TagInfo.Jahr)
End Property
Public Property Let Jahr(ByVal vNewValue As String)
TagInfo.Jahr = vNewValue
End Property
Public Property Get Kommentar() As String
Kommentar = NullTrim(TagInfo.Kommentar)
End Property
Public Property Let Kommentar(ByVal vNewValue As String)
TagInfo.Kommentar = vNewValue
End Property
Public Property Get Genre() As String
Genre = GenreString(TagInfo.Genre)
End Property
Public Property Get GenreEnum()
GenreEnum = iGenre
End Property
Public Property Let GenreNummer(ByVal vNewValue As Byte)
TagInfo.Genre = vNewValue
End Property
Public Property Get Track() As String
Track = TagInfo.Track
End Property
Public Property Let Track(ByVal vNewValue As String)
TagInfo.Track = vNewValue
End Property
Public Property Get ID3Genre() As String
ID3Genre = iv3Genre
End Property
Public Property Get ID3Album() As String
ID3Album = iv3Album
End Property
Public Property Get ID3Titel() As String
ID3Titel = iv3Titel
End Property
Public Property Get ID3Artist() As String
ID3Artist = iv3Artist
End Property
Public Property Get ID3Track() As String
ID3Track = iv3Track
End Property
Public Property Get ID3Kommentar() As String
ID3Kommentar = iv3Kommentar
End Property
Public Property Get ID3Jahr() As String
ID3Jahr = iv3Jahr
End Property
Public Property Get ID3Sprache() As String
ID3Sprache = iv3Sprache
End Property
Public Property Get ID3Länge() As String
ID3Länge = iv3Länge
End Property
Public Property Get ID3Typ() As String
ID3Typ = iv3Typ
End Property
Public Property Get ID3UrspKünstler() As String
ID3UrspKünstler = iv3UrspKünstler
End Property
Public Property Get ID3PlayZähler() As String
ID3PlayZähler = iv3PlayZähler
End Property
Public Property Get ID3Encodet() As String
ID3Encodet = iv3Encodet
End Property
Public Property Get ID3Link() As String
ID3Link = iv3Link
End Property
Public Property Get ID3Copyr() As String
ID3Copyr = iv3Copyr
End Property
Public Property Get ID3Composer() As String
ID3Composer = iv3Composer
End Property
Public Property Get ID3Publisher() As String
ID3Publisher = iv3Publisher
End Property
Public Property Get ID3Software() As String
ID3Software = iv3Software
End Property
Public Property Get ID3Sonstiges() As String
ID3Sonstiges = iv3Sonstiges
End Property
Private Sub ID3Info(Infobuffer As String, Version As
Byte)
Dim Fname As String
Dim FLänge As String
Dim Flag As String
Dim FInhalt As String
Dim dummy As String
Dim IDV3TagLänge As Long
Dim IDV3Länge() As Byte
If Mid$(Infobuffer, 6, 1) = Chr(4) Then
Infobuffer = Mid$(Infobuffer, 10)
End If
ZusatzinfosLöschen
Infobuffer = Mid$(Infobuffer, 11)
Do
If Version = 3 Or Version = 4 Then
Fname = Left$(Infobuffer, 4)
If InStr(1, Fname, "3DI")
Then Exit Do
FLänge = Mid$(Infobuffer,
5, 4)
'Da &HFFF
nicht vorkommen darf, sind jeweils
'die 4 oberen Bits eines Bytes
Lo. Deshalb die
'umständliche Berechnung
IDV3Länge = StrConv(FLänge,
vbFromUnicode)
IDV3TagLänge = CLng(IDV3Länge(0))
* 16384 _
+ CLng(IDV3Länge(1))
* 2048 _
+ CLng(IDV3Länge(2))
* 256 _
+ CLng(IDV3Länge(3))
+ 10
Flag = Mid$(Infobuffer, 9, 2)
If IDV3TagLänge > 11
Then
dummy
= IDV3TagLänge - 11
FInhalt
= Mid$(Infobuffer, 12, dummy)
Select
Case Fname
Case
"TALB": iv3Album = FInhalt
Case
"TIT2": iv3Titel = FInhalt
Case
"TPE1": iv3Artist = FInhalt
Case
"TRCK": iv3Track = FInhalt
Case
"TCON": iv3Genre = FInhalt
Case
"COMM": iv3Kommentar = FInhalt
Case
"TYER": iv3Jahr = FInhalt
Case
"TLAN": iv3Sprache = FInhalt
Case
"TLEN": iv3Länge = FInhalt
Case
"TMED": iv3Typ = FInhalt
Case
"TOPE": iv3UrspKünstler = FInhalt
Case
"PCNT": iv3PlayZähler = FInhalt
Case
"TENC": iv3Encodet = FInhalt
Case
"WXXX": iv3Link = FInhalt
Case
"TCOP": iv3Copyr = FInhalt
Case
"TCOM": iv3Composer = FInhalt
Case
"TPUB": iv3Publisher = FInhalt
Case
"TSSE": iv3Software = FInhalt
Case
Else: iv3Sonstiges = FInhalt
End
Select
End If
Infobuffer = Mid$(Infobuffer,
IDV3TagLänge + 1)
ElseIf Version = 2 Then
Fname = Left$(Infobuffer, 4)
If InStr(1, Fname, "3DI")
Then Exit Do
FLänge = Mid$(Infobuffer,
5, 4)
'Da &HFFF
nicht vorkommen darf, sind jeweils
'die 4 oberen Bits eines Bytes
Lo. Deshalb die
'umstänldiche Berechnung
IDV3Länge = StrConv(FLänge,
vbFromUnicode)
IDV3TagLänge = CLng(IDV3Länge(0))
* 16384 _
+ CLng(IDV3Länge(1))
* 2048 _
+ CLng(IDV3Länge(2))
* 256 _
+ CLng(IDV3Länge(3))
+ 10
If IDV3TagLänge > 7
Then
dummy
= IDV3TagLänge - 7
FInhalt
= Mid$(Infobuffer, 8, dummy)
Select
Case Fname
Case
"TAL": iv3Album = FInhalt
Case
"TT2": iv3Titel = FInhalt
Case
"TP1": iv3Artist = FInhalt
Case
"TRK": iv3Track = FInhalt
Case
"TCO": iv3Genre = FInhalt
Case
"COM": iv3Kommentar = FInhalt
Case
"TYE": iv3Jahr = FInhalt
Case
"TLA": iv3Sprache = FInhalt
Case
"TMT": iv3Typ = FInhalt
Case
"TOA": iv3UrspKünstler = FInhalt
Case
"TEN": iv3Encodet = FInhalt
Case
"TCR": iv3Copyr = FInhalt
Case
"TCM": iv3Composer = FInhalt
Case
"TSS": iv3Software = FInhalt
Case
Else: iv3Sonstiges = FInhalt
End
Select
End If
Infobuffer = Mid$(Infobuffer,
IDV3TagLänge + 1)
End If
Loop Until Len(Infobuffer) = 0
End Sub
Private Sub VariablenZurücksetzen()
iSamplingrate = ""
iBitrate = 0
iAufzeichnungsmodus = ""
iMpegArt = 0
iMpegLayer = 0
iLänge = 0
iCopyright = False
iOriginal = False
iEmphases = ""
End Sub
Private Sub TaginfoLöschen()
With TagInfo
.Album = ""
.Artist = ""
.Genre = 12
.Jahr = ""
.Kommentar = ""
.Titel = ""
.Track = 0
End With
End Sub
Private Sub ZusatzinfosLöschen()
iv3Album = ""
iv3Titel = ""
iv3Artist = ""
iv3Track = ""
iv3Genre = ""
iv3Kommentar = ""
iv3Jahr = ""
iv3Sprache = ""
iv3Länge = ""
iv3Typ = ""
iv3UrspKünstler = ""
iv3PlayZähler = ""
iv3Encodet = ""
iv3Link = ""
iv3Copyr = ""
iv3Composer = ""
iv3Publisher = ""
iv3Software = ""
End Sub
Private Sub Class_Initialize()
ReDim iGenre(0 To 125)
iGenre(0) = "Blues"
iGenre(1) = "Classic Rock"
iGenre(2) = "Country"
iGenre(3) = "Dance"
iGenre(4) = "Disco"
iGenre(5) = "Funk"
iGenre(6) = "Grunge"
iGenre(7) = "Hip-Hop"
iGenre(8) = "Jazz"
iGenre(9) = "Metal"
iGenre(10) = "New Age"
iGenre(11) = "Oldies"
iGenre(12) = "Other"
iGenre(13) = "Pop"
iGenre(14) = "R&B"
iGenre(15) = "Rap"
iGenre(16) = "Reggae"
iGenre(17) = "Rock"
iGenre(18) = "Techno"
iGenre(19) = "Industrial"
iGenre(20) = "Alternative"
iGenre(21) = "Ska"
iGenre(22) = "Death Metal"
iGenre(23) = "Pranks"
iGenre(24) = "Soundtrack"
iGenre(25) = "Euro-Techno"
iGenre(26) = "Ambient"
iGenre(27) = "Trip-Hop"
iGenre(28) = "Vocal"
iGenre(29) = "Jazz Funk"
iGenre(30) = "Fusion"
iGenre(31) = "Trance"
iGenre(32) = "Classical"
iGenre(33) = "Instrumental"
iGenre(34) = "Acid"
iGenre(35) = "House"
iGenre(36) = "Game"
iGenre(37) = "Sound Clip"
iGenre(38) = "Gospel"
iGenre(39) = "Noise"
iGenre(40) = "AlternRock"
iGenre(41) = "Bass"
iGenre(42) = "Soul"
iGenre(43) = "Punk"
iGenre(44) = "Space"
iGenre(45) = "Meditative"
iGenre(46) = "Instrumental Pop"
iGenre(47) = "Instrumental Rock"
iGenre(48) = "Ethnic"
iGenre(49) = "Gothic"
iGenre(50) = "Darkwave"
iGenre(51) = "Techno -Industrial"
iGenre(52) = "Electronic"
iGenre(53) = "Pop-Folk"
iGenre(54) = "Eurodance"
iGenre(55) = "Dream"
iGenre(56) = "Southern Rock"
iGenre(57) = "Comedy"
iGenre(58) = "Cult"
iGenre(59) = "Gangsta"
iGenre(60) = "Top 40"
iGenre(61) = "Christian Rap"
iGenre(62) = "Pop/Funk"
iGenre(63) = "Jungle"
iGenre(64) = "Native American"
iGenre(65) = "Cabaret"
iGenre(66) = "New Wave"
iGenre(67) = "Psychadelic"
iGenre(68) = "Rave"
iGenre(69) = "Showtunes"
iGenre(70) = "TriGenreiler"
iGenre(71) = "Lo-Fi"
iGenre(72) = "Tribal"
iGenre(73) = "Acid Punk"
iGenre(74) = "Acid Jazz"
iGenre(75) = "Polka"
iGenre(76) = "Retro"
iGenre(77) = "MusiciGenrel"
iGenre(78) = "Rock & Roll"
iGenre(79) = "Hard Rock"
iGenre(80) = "Folk"
iGenre(81) = "Folk-Rock"
iGenre(82) = "National Folk"
iGenre(83) = "Swing"
iGenre(84) = "Fast Fusion"
iGenre(85) = "Bebob"
iGenre(86) = "Latin"
iGenre(87) = "Revival"
iGenre(88) = "Celtic"
iGenre(89) = "Bluegrass"
iGenre(90) = "Avantgarde"
iGenre(91) = "Gothic Rock"
iGenre(92) = "Progressive Rock"
iGenre(93) = "Psychedelic Rock"
iGenre(94) = "Symphonic Rock"
iGenre(95) = "Slow Rock"
iGenre(96) = "Big Band"
iGenre(97) = "Chorus"
iGenre(98) = "Easy Listening"
iGenre(99) = "Acoustic"
iGenre(100) = "Humour"
iGenre(101) = "Speech"
iGenre(102) = "Chanson"
iGenre(103) = "Opera"
iGenre(104) = "Chamber Music"
iGenre(105) = "Sonata"
iGenre(106) = "Symphony"
iGenre(107) = "Booty Bass"
iGenre(108) = "Primus"
iGenre(109) = "Porn Groove"
iGenre(110) = "Satire"
iGenre(111) = "Slow Jam"
iGenre(112) = "Club"
iGenre(113) = "Tango"
iGenre(114) = "Samba"
iGenre(115) = "Folklore"
iGenre(116) = "Ballad"
iGenre(117) = "Power Ballad"
iGenre(118) = "Rhythmic Soul"
iGenre(119) = "Freestyle"
iGenre(120) = "Duet"
iGenre(121) = "Punk Rock"
iGenre(122) = "Drum Solo"
iGenre(123) = "Acapella"
iGenre(124) = "Euro-House"
iGenre(125) = "Dance Hall"
End Sub
'Beginn Modul
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32.dll"
Alias _
"SHBrowseForFolderA" (lpBrowseInfo
As BROWSEINFO) _
As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll"
Alias _
"SHGetPathFromIDListA" (ByVal pidl
As Long, _
ByVal pszPath As String) As Long
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private MP3Klasse As New MP3_Infos
Private Const BIF_RETURNONLYFSDIRS = &H1
Private DateiZähler As Long
Sub start()
Dim Liste As New Collection
Dim a, zähler As Long, zähler1 As Long
Dim startdir As String
On Error Resume Next
'Startverzeichnis wählen
startdir = VerzeichnisWählen()
If startdir = "" Then Exit Sub
DateiZähler
= 0
'Collection mit vorhandenen Liedern füllen
MP3_Liste startdir, Liste, "mp3"
zähler = 1
With Sheets("MP3")
'Informationen ins Blatt eintragen
.Cells.ClearContents
Application.ScreenUpdating = False
For Each a In Liste
zähler = zähler + 1
For zähler1 = 1 To a.Count
If zähler1 = 2 Then
'In
die zweite Spalte kommt ein Link
If zähler >
2 Then
'Hyperlink auf die Datei erzeugen
.Hyperlinks.Add
Anchor:=.Cells(zähler, zähler1), _
Address:=a.Item(zähler1)
Else
'aber nur, wenns nicht die Überschrift ist
.Cells(zähler,
zähler1) = a.Item(zähler1)
End If
Else
'Info
eintragen
Cells(zähler,
zähler1) = a.Item(zähler1)
End If
Next
Next
End With
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Private Sub MP3_Liste(startdir As String, ByRef Liste
As Collection, Filter As String)
Dim V() As String, zähler As Long, Dateiname As String
Dim DateiNr As Long, aktVerz As String
Dim Header As String, Bitrate As Double
Dim Sampling As String, Modus As String
Dim Frames As Long, Framelänge As Long
Dim MpegLayer As Long, SamplesProFrame As Long
Dim Nutzlänge As Double
Dim BitHeader(1 To 4) As Byte
Dim Länge As Double, Headerbeginn As Long
Dim Informationen As Collection
Dim dummy
If Left$(Filter, 1) <> "." Then Filter = "."
& Filter
If Liste.Count = 0 Then
'Erster Eintrag in der Collection
Liste
'ist eine Collection mit den Überschriften
Set Informationen = New Collection
Informationen.Add "Datei", "Datei"
Informationen.Add "Pfad", "Pfad"
Informationen.Add "Titel", "Titel"
Informationen.Add "Artist", "Artist"
Informationen.Add "Songlänge", "Songlänge"
Informationen.Add "Genre", "Genre"
Informationen.Add "Album", "Album"
Informationen.Add "Jahr", "Jahr"
Informationen.Add "Track", "Track"
Informationen.Add "Kommentar", "Kommentar"
Informationen.Add "Bitrate", "Bitrate"
Informationen.Add "MpegLayer", "MpegLayer"
Informationen.Add "MpegArt", "MpegArt"
Informationen.Add "Sampling", "Sampling"
Informationen.Add "Stereomodus", "Stereomodus"
Informationen.Add "Rauschunterdrückung",
"Rauschunterdrückung"
Informationen.Add "Original", "Original"
Informationen.Add "Copyright", "Copyright"
Informationen.Add "ID3Sprache", "ID3Sprache"
Informationen.Add "ID3UrspKünstler",
"ID3UrspKünstler"
Informationen.Add "ID3Composer", "ID3Composer"
Informationen.Add "ID3Publisher", "ID3Publisher"
Informationen.Add "ID3Software", "ID3Software"
Informationen.Add "ID3PlayZähler", "ID3PlayZähler"
Informationen.Add "ID3Link", "ID3Link"
Informationen.Add "ID3Typ", "ID3Typ"
Informationen.Add "ID3Sonstiges", "ID3Sonstiges"
Liste.Add Informationen, "Überschrift"
End If
ReDim V(1 To 100)
If Right$(startdir, 1) <> "\" Then
'Nachschauen, ob übergebener
Pfad auch einen Backslash enthält.
'Wenn nicht, dann anhängen
startdir = startdir & "\"
End If
aktVerz = startdir
startdir = startdir & "*"
Dateiname = Dir$(startdir, vbDirectory Or vbNormal)
Do While Dateiname <> ""
If GetAttr(aktVerz & Dateiname) And vbDirectory
Then
'wenn Datei ein Verzeichnis ist
If Right$(Dateiname, 1) <> "."
Then
'und zwar
ein untergeordnetes,
zähler = zähler +
1
'dann ein
Array mit Verzeichnissen füllen.
If zähler > UBound(V)
Then
ReDim Preserve V(1
To zähler + 1)
End If
V(zähler) = Dateiname
End If
Else
'Handelt es sich um
eine Datei,
If LCase(Right$(Dateiname, Len(Filter)))
= LCase(Filter) Then
'und entspricht
sie noch den Filterbedingungen,
With MP3Klasse
'dann den Pfad an die Klasse übergeben
.Pfad
= aktVerz & Dateiname
'und Infos von Klasse in neue Collection schreiben.
Set
Informationen = New Collection
Informationen.Add
Dateiname, "Datei"
Informationen.Add
.Pfad, "Pfad"
Informationen.Add
.Titel, "Titel"
Informationen.Add
.Artist, "Artist"
Informationen.Add
.Songlänge, "Songlänge"
Informationen.Add
.Genre, "Genre"
Informationen.Add
.Album, "Album"
Informationen.Add
.Jahr, "Jahr"
Informationen.Add
.Track, "Track"
Informationen.Add
.Kommentar, "Kommentar"
Informationen.Add
.Bitrate, "Bitrate"
Informationen.Add
.MpegLayer, "MpegLayer"
Informationen.Add
.MpegArt, "MpegArt"
Informationen.Add
.Sampling, "Sampling"
Informationen.Add
.Stereomodus, "Stereomodus"
Informationen.Add
.Rauschunterdrückung, "Rauschunterdrückung"
Informationen.Add
.Original, "Original"
Informationen.Add
.Copyright, "Copyright"
Informationen.Add
.ID3Sprache, "ID3Sprache"
Informationen.Add
.ID3UrspKünstler, "ID3UrspKünstler"
Informationen.Add
.ID3Composer, "ID3Composer"
Informationen.Add
.ID3Publisher, "ID3Publisher"
Informationen.Add
.ID3Software, "ID3Software"
Informationen.Add
.ID3PlayZähler, "ID3PlayZähler"
Informationen.Add
.ID3Link, "ID3Link"
Informationen.Add
.ID3Typ, "ID3Typ"
Informationen.Add
.ID3Sonstiges, "ID3Sonstiges"
DateiZähler
= DateiZähler + 1
Application.StatusBar
= "Dateiinfos (" & DateiZähler - 1 & ") = "
& aktVerz & Dateiname
If DateiZähler
Mod 20 = 0 Then DoEvents
'und als Element an die Collection Liste hängen.
Liste.Add
Informationen, aktVerz & Dateiname
End With
End If
End If
Dateiname = Dir$()
Loop
'Jetzt erst werden die Unterverzeichnisse abgearbeitet,
'weil Dir$ mit Rekursionen nicht klarkommt.
If zähler = 0 Then Exit Sub
ReDim Preserve V(1 To zähler)
For zähler = 1 To UBound(V)
'Jetzt ruft sich diese Funktion
noch mal auf.
MP3_Liste aktVerz & V(zähler), Liste, Filter
Next
End Sub
Public Function VerzeichnisWählen() As String
Dim Ret As Long
Dim Browse As BROWSEINFO
Dim Liste As Long
Dim Pfad As String, wPos As Integer
Browse.lpszTitle = "Bitte ein Startverzeichnis wählen"
Browse.ulFlags = BIF_RETURNONLYFSDIRS
Liste = SHBrowseForFolder(Browse)
Pfad = String(1024, 0)
Ret = SHGetPathFromIDList(ByVal Liste, ByVal Pfad)
If Ret Then
VerzeichnisWählen = NullTrim(Pfad)
End If
End Function
Private Function NullTrim(a As String) As String
Dim zähler As Long, b As String
For zähler = 1 To Len(a)
b = Mid$(a, zähler, 1)
If (Asc(b) > 31) And (Asc(b) < 128) Then
NullTrim = NullTrim & b
End If
Next
NullTrim = Trim(NullTrim)
End Function