| 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 |
|
zurück