|
Global filename As String
Public actual_bitrate As Long
Public Type Id3
Title As String * 30
Artist As String * 30
Album As String * 30
sYear As String * 4
Comments As String * 30
Genre As Byte
End Type
Type MP3Info
Bitrate As Integer
Frequency As Long
Mode As String
Emphasis As String
MpegVersion As Integer
MpegLayer As Integer
Padding As String
CRC As String
Duration As Long
CopyRight As String
Original As String
PrivateBit As String
VBR As Boolean
Frames As Integer
End Type
Public GetMP3Info As MP3Info
Public id3Info As Id3
Public GenreArray() As String
Public Const sGenreMatrix = "Blues|Classic Rock|Country|" + _
"Dance|Disco|Funk|Grunge|Hip-Hop|Jazz|Metal|New Age|Oldies|" + _
"Other|Pop|R&B|Rap|Reggae|Rock|Techno|Industrial|" + _
"Alternative|Ska|Death Metal|Pranks|Soundtrack|Euro-Techno|" + _
"Ambient|Trip Hop|Vocal|Jazz+Funk|Fusion|Trance|Classical|" + _
"Instrumental|Acid|House|Game|Sound Clip|Gospel|Noise|" + _
"Alt. Rock|Bass|Soul|Punk|Space|Meditative|Instrumental Pop|" + _
"Instrumental Rock|Ethnic|Gothic|Darkwave|Techno-Industrial|" + _
"Electronic|Pop-Folk|Eurodance|Dream|Southern Rock|Comedy|" + _
"Cult|Gangsta Rap|Top 40|Christian Rap|Pop/Punk|Jungle|" + _
"Native American|Cabaret|New Wave|Phychedelic|Rave|Showtunes|" + _
"Trailer|Lo-Fi|Tribal|Acid Punk|Acid Jazz|Polka|Retro|" + _
"Musical|Rock & Roll|Hard Rock|Folk|Folk/Rock|National Folk|" + _
"Swing|Fast-Fusion|Bebob|Latin|Revival|Celtic|Blue Grass|" + _
"Avantegarde|Gothic Rock|Progressive Rock|Psychedelic Rock|" + _
"Symphonic Rock|Slow Rock|Big Band|Chorus|Easy Listening|" + _
"Acoustic|Humour|Speech|Chanson|Opera|Chamber Music|Sonata|" + _
"Symphony|Booty Bass|Primus|Porn Groove|Satire|Slow Jam|" + _
"Club|Tango|Samba|Folklore|Ballad|power Ballad|Rhythmic Soul|" + _
"Freestyle|Duet|Punk Rock|Drum Solo|A Capella|Euro-House|" + _
"Dance Hall|Goa|Drum & Bass|Club-House|Hardcore|Terror|indie|" + _
"Brit Pop|Negerpunk|Polsk Punk|Beat|Christian Gangsta Rap|" + _
"Heavy Metal|Black Metal|Crossover|Comteporary Christian|" + _
"Christian Rock|Merengue|Salsa|Trash Metal|Anime|JPop|Synth Pop"
Public Function GetId3(filename As String)
Dim Tag As String * 3
If filename = "" Then Exit Function
If filename = "*.mp3" Then Exit Function
Open filename For Binary As #1
Get #1, FileLen(filename) - 127, Tag
If Tag = "TAG" Then
Get #1, FileLen(filename) - 124, id3Info
Else
MsgBox "Diese MP3-Datei besitzt keinen ID3-Tag", _
vbInformation, "MP3-Info"
End If
Close #1
End Function
Public Function SaveId3(filename As String, MP3Info As Id3)
Dim Tag As String * 3
If filename = "" Then Exit Function
On Error GoTo ErrHandle
Open filename For Binary As #1
Get #1, FileLen(filename) - 127, Tag
If Tag = "TAG" Then
Put #1, FileLen(filename) - 124, MP3Info
Else
Put #1, FileLen(filename) - 127, "TAG"
Close #1
SaveId3 filename, MP3Info
End If
Close #1
ErrHandle:
If Err.Number = 75 Then
MsgBox "Datei ist schreibgeschützt.", vbExclamation, _
"MP3-Info"
Close #1
Else
If Err.Description = "" Then
Close #1
Else
MsgBox "Fehler: " & Err.Description, vbCritical, "MP3-Info"
Close #1
End If
End If
End Function
Public Function BinToDec(BinValue As String) As Long
Dim i As Integer
BinToDec = 0
For i = 1 To Len(BinValue)
If Mid(BinValue, i, 1) = 1 Then
BinToDec = BinToDec + 2 ^ (Len(BinValue) - i)
End If
Next i
End Function
Public Function ByteToBit(ByteArray) As String
Dim i As Integer, z As Integer
ByteToBit = ""
For z = 1 To 4
For i = 7 To 0 Step -1
If Int(ByteArray(z) / (2 ^ i)) = 1 Then
ByteToBit = ByteToBit & "1"
ByteArray(z) = ByteArray(z) - (2 ^ i)
Else
If ByteToBit <> "" Then
ByteToBit = ByteToBit & "0"
End If
End If
Next i
Next z
End Function
Public Function BinaryHeader(filename As String) As String
Dim ByteArray(4) As Byte
Dim XingH As String * 4
Dim FIO As Integer, n As Long
Dim i As Integer, x As Byte
Dim z As Integer
If filename = "" Then Exit Function
FIO% = FreeFile
Open filename For Binary Access Read As FIO%
n& = LOF(FIO%): If n& < 256 Then Close FIO%: Return
For i = 1 To 5000
Get #FIO%, i, x
If x = 255 Then
Get #FIO%, i + 1, x
If x > 249 And x < 252 Then
Headstart = i
Exit For
End If
End If
Next i
Get #1, Headstart + 36, XingH
If XingH = "Xing" Then
GetMP3Info.VBR = True
For z = 1 To 4 '
Get #1, Headstart + 43 + z, ByteArray(z)
Next z
Frames = BinToDec(ByteToBit(ByteArray))
GetMP3Info.Frames = Frames
Else
GetMP3Info.VBR = False
End If
For z = 1 To 4
Get #1, Headstart + z - 1, ByteArray(z)
Next z
Close FIO%
BinaryHeader = ByteToBit(ByteArray)
End Function
Public Function ReadMP3(filename As String) As MP3Info
If filename = "" Then Exit Function
bin = BinaryHeader(filename)
Version = Array(25, 0, 2, 1)
MpegVersion = Version(BinToDec(Mid(bin, 12, 2)))
Layer = Array(0, 3, 2, 1)
MpegLayer = Layer(BinToDec(Mid(bin, 14, 2)))
SMode = Array("Stereo", "Joint stereo", "Zwei-Kanal", _
"Ein-Kanal")
Mode = SMode(BinToDec(Mid(bin, 25, 2)))
Emph = Array("no", "50/15", "reserviert", "CCITT J 17")
Emphasis = Emph(BinToDec(Mid(bin, 31, 2)))
Select Case MpegVersion
Case 1
Freq = Array(44100, 48000, 32000)
Case 2 Or 25
Freq = Array(22050, 24000, 16000)
Case Else
Frequency = 0
Exit Function
End Select
Frequency = Freq(BinToDec(Mid(bin, 21, 2)))
If GetMP3Info.VBR = True Then
Temp = Array(, 12, 144, 144)
Bitrate = (FileLen(filename) * Frequency) / _
(Int(GetMP3Info.Frames)) / 1000 / Temp(MpegLayer)
Else
Dim LayerVersion As String
LayerVersion = MpegVersion & MpegLayer
Select Case Val(LayerVersion)
Case 11
Brate = Array(0, 32, 64, 96, 128, 160, 192, 224, 256, _
288, 320, 352, 384, 416, 448)
Case 12
Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 160, _
192, 224, 256, 320, 384)
Case 13
Brate = Array(0, 32, 40, 48, 56, 64, 80, 96, 112, 128, _
160, 192, 224, 256, 320)
Case 21 Or 251
Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 144, _
160, 176, 192, 224, 256)
Case 22 Or 252 Or 23 Or 253
Brate = Array(0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, _
112, 128, 144, 160)
Case Else
Bitrate = 1
Exit Function
End Select
Bitrate = Brate(BinToDec(Mid(bin, 17, 4)))
End If
NoYes = Array("Nein", "Ja")
Original = NoYes(Mid(bin, 30, 1))
CopyRight = NoYes(Mid(bin, 29, 1))
Padding = NoYes(Mid(bin, 23, 1))
PrivateBit = NoYes(Mid(bin, 24, 1))
YesNo = Array("yes", "no")
CRC = YesNo(Mid(bin, 16, 1))
ms = (FileLen(filename) * 8) / Bitrate
Duration = Int(ms / 1000)
With GetMP3Info
.Bitrate = Bitrate
.CRC = CRC
.Duration = Duration
.Emphasis = Emphasis
.Frequency = Frequency
.Mode = Mode
.MpegLayer = MpegLayer
.MpegVersion = MpegVersion
.Padding = Padding
.Original = Original
.CopyRight = CopyRight
.PrivateBit = PrivateBit
End With
End Function
Public Function CheckTag(filename As String)
Dim Tag As String * 3
If filename = "" Then Exit Function
Open filename For Binary As #1
Get #1, FileLen(filename) - 127, Tag
If Tag = "TAG" Then
CheckTag = True
Else
CheckTag = False
End If
Close #1
End Function
|
|