MP3-Tag komplett lesen (ID3v1-Tag), Interpret und Songtitel trennen

MP3-Tag komplett lesen (ID3v1-Tag), sowie Interpret und Songtitel trennen: MP3Info, InStrRev
Dim CurrentTag As TagInfo
Type TagInfo
Tag As String * 3
Songname As String * 30
Artist As String * 30
Album As String * 30
year As String * 4
comment As String * 30
genre As String * 1
End Type
Type MP3Info
Bitrate As Variant
Frequency As Long
Mode As String
Emphasis As String
MpegVersion As Integer
MpegLayer As Integer
Padding As String
CRC As String
Duration As String
CopyRight As String
Original As String
PrivateBit As String
HasTag As Boolean
Tag As String
Songname As String
Artist As String
Album As String
year As String
comment As String
genre As Integer
Track As String
VBR As Boolean
Frames As Integer
FileLaenge As Long
End Type
Public GetMP3Info As MP3Info
Function ReadMP3(FileName$, ReadTag As Boolean, ReadHeader As Boolean) As MP3Info
Dim LayerVersion$
Clear_Output
bin = BinaryHeader(FileName$, ReadTag, ReadHeader) 'extract all 32 bits
On Error Resume Next
If ReadHeader = False Then Exit Function
Version = Array(25, 0, 2, 1) 'Mpegversion table
MpegVersion = Version(BinToDec(Mid(bin, 12, 2))) 'get Mpegversion from table
layer = Array(0, 3, 2, 1) 'layer table
MpegLayer = layer(BinToDec(Mid(bin, 14, 2))) 'get layer from table
SMode = Array("stereo", "joint stereo", "dual channel", "single channel") 'mode table
Mode = SMode(BinToDec(Mid(bin, 25, 2))) 'get mode from table
Emph = Array("no", "50/15", "reserved", "CCITT J 17") 'empasis table
Emphasis = Emph(BinToDec(Mid(bin, 31, 2))) 'get empasis from table
Select Case MpegVersion 'look for version to create right table
Case 1 'version 1
Freq = Array(44100, 48000, 32000)
Case 2 Or 25 'version 2 or 2.5
Freq = Array(22050, 24000, 16000)
Case Else
Frequency = 0
End Select
Frequency = Freq(BinToDec(Mid(bin, 21, 2))) 'look for frequency in table
If GetMP3Info.VBR = True Then 'check if variable bitrate
temp = Array(, 12, 144, 144) 'define to calculate correct bitrate
' Bitrate = (FileLen(FileName) * Frequency) / (Int(GetMP3Info.Frames)) / 1000 / temp(MpegLayer)
Bitrate = "V B R" 'Message to CellValue
Else 'if not variable bitrate
LayerVersion = MpegVersion & MpegLayer 'combine version and layer to string
Select Case Val(LayerVersion) 'look for the right bitrate table
Case 11 'Version 1, Layer 1
Brate = Array(0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448)
Case 12 'V1 L1
Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384)
Case 13 'V1 L3
Brate = Array(0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320)
Case 21 Or 251 'V2 L1 and 'V2.5 L1
Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256)
Case 22 Or 252 Or 23 Or 253 ''V2 L2 and 'V2.5 L2 etc...
Brate = Array(0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160)
Case Else
Bitrate = 0 'for variable bitrate VBR
End Select
Bitrate = Brate(BinToDec(Mid(bin, 17, 4)))
' NoYes = Array("no", "yes")
' PrivateBit = NoYes(Mid(bin, 24, 1))
' Original = NoYes(Mid(bin, 30, 1)) 'Set original bit
' CopyRight = NoYes(Mid(bin, 29, 1)) 'Set copyright bit
' Padding = NoYes(Mid(bin, 23, 1)) 'Get padding bit
' YesNo = Array("yes", "no") 'CRC table
' CRC = YesNo(Mid(bin, 16, 1)) 'Get CRC
ms = (FileLen(FileName) * 8) \ Bitrate 'calculate duration
Duration = Int(ms \ 1000)
min = Duration \ 60 'wandeln in Std, Min & Sek "00:00:00"
sec = Duration - (min * 60)
lblTotalTime = "00:" & Format(min, "0#") & ":" & Format(sec, "0#")
End If
FileLaenge = Format(FileLen(FileName) / 1024, "0#")
FIO& = FreeFile
Open FileName For Binary Access Read As FIO&
With CurrentTag
Get FIO&, FileLen(FileName) - 127, .Tag
Get FIO&, , .Songname
Get FIO&, , .Artist
End With
Close FIO
With GetMP3Info 'set values
.Bitrate = Bitrate
.Duration = lblTotalTime
.FileLaenge = FileLaenge
.Artist = RTrim(CurrentTag.Artist)
.Songname = RTrim(CurrentTag.Songname)
.Frames = .Frames
.HasTag = GetMP3Info.HasTag
.Mode = Mode
.Frequency = Frequency
' .MpegLayer = MpegLayer
' .MpegVersion = MpegVersion
' .CRC = CRC
' .Emphasis = Emphasis
' .Padding = Padding
' .Original = Original
' .CopyRight = CopyRight
' .PrivateBit = PrivateBit
End With
End Function
Function BinToDec(BinValue As String) As Long
'converts Binary string to decimal integer
BinToDec = 0
For i = 1 To Len(BinValue)
If Mid(BinValue, i, 1) = 1 Then
BinToDec = BinToDec + 2 ^ (Len(BinValue) - i)
End If
Next i
End Function
Function ByteToBit(ByteArray) As String
'convert 4*1 byte array to 4*8 bits
ByteToBit = ""
For z = 1 To 4
For i = 7 To 0 Step -1
If Int(ByteArray(z) / (2 ^ i)) = 1 Then
ByteToBit = ByteToBit & "1"
ByteArray(z) = ByteArray(z) - (2 ^ i)
Else
If ByteToBit <> "" Then
ByteToBit = ByteToBit & "0"
End If
End If
Next
Next z
End Function
Function BinaryHeader(FileName As String, ReadTag As Boolean, _
ReadHeader As Boolean) As String
Dim ByteArray(4) As Byte, XingH As String * 4
On Error Resume Next
FIO& = FreeFile
Open FileName For Binary Access Read As FIO&
n& = LOF(FIO&): If n& < 256 Then Close FIO&: Return
If ReadHeader = False Then GoTo 5: 'if we only want to read the IDTag goto 5
Dim x As Byte
'start check startposition for header
'if start position <>1 then id3v2 tag exists
For i = 1 To 5000 'check up to 5000 bytes for the header
Get #FIO&, i, x
If x = 255 Then 'header always start with 255 followed by 250 or 251
Get #FIO&, i + 1, x
If x > 249 And x < 252 Then
Headstart = i 'set header start position
Exit For
End If
End If
Next i
'start check for XingHeader
Get #FIO&, Headstart + 36, XingH
If XingH = "Xing" Then
GetMP3Info.VBR = True
For z = 1 To 4
Get #FIO&, Headstart + 43 + z, ByteArray(z) 'get framelength to array
Next z
Frames = BinToDec(ByteToBit(ByteArray)) 'calculate # of frames
GetMP3Info.Frames = Frames 'set frames
Else
GetMP3Info.VBR = False
End If
'start extract the first 4 bytes (32 bits) to an array
For z = 1 To 4
Get #FIO&, Headstart + z - 1, ByteArray(z)
Next z
5:
If ReadTag = False Then GoTo 10
Dim InBuf As String * 256
Get #FIO&, (n& - 255), InBuf
Close FIO
p = InStr(1, InBuf, "tag", 1)
If p = 0 Then
GetMP3Info.HasTag = False
Else
GetMP3Info.HasTag = True
End If
10:
Close FIO
BinaryHeader = ByteToBit(ByteArray)
End Function
Function Clear_Output() As MP3Info
With GetMP3Info
.Bitrate = 0
.Duration = vbNullString
.FileLaenge = 0
.HasTag = False
.Artist = vbNullString
.Songname = vbNullString
.Frames = 0
.Mode = vbNullString
.Frequency = 0
.MpegLayer = 0
.MpegVersion = 0
.CRC = vbNullString
.Emphasis = vbNullString
.Padding = vbNullString
.Original = vbNullString
.CopyRight = vbNullString
.PrivateBit = vbNullString
End With
End Function
 
Hier noch zwei Funktionen, wie man Interpret und Songtitel trennt:
Beispiel: Dateiname = "The Beatles - Yellow Submarine.wav"
Variable strText wäre der Dateiname; Variable strChar wäre der Bindestrich, der Interpret und Titel trennt.
'Interpret isolieren
Function GetLeft(strText As String, strChar As String) As String
Dim intPos As Integer
intPos = InStr(strText, strChar)
If intPos > 0 Then
GetLeft = Trim(Left(strText, intPos - 1))
Else
GetLeft = Trim(strText)
End If
End Function
'Titel isolieren
Function GetRight(strText As String, strChar As String) As String
Dim intPos As Integer
intPos = InStrRev(strText, strChar)
If intPos > 0 Then
GetRight = Trim(Right(strText, Len(strText) - intPos))
Else
GetRight = Trim(strText)
End If
End Function

Mehr Tipps: Monitor in den Standby-Mode schalten

Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt