i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Option Explicit
Private Declare Function SetEndOfFile _
Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function CreateFile _
Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function SetFilePointer _
Lib "kernel32" _
(ByVal hFile As Long, ByVal lDistanceToMove As Long, _
lpDistanceToMoveHigh As Long, _
ByVal dwMoveMethod As Long) As Long
Private Declare Function CloseHandle _
Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA ' 318 Bytes
dwFileAttributes As Long
ftCreationTime As FileTime
ftLastAccessTime As FileTime
ftLastWriteTime As FileTime
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved¯ As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
Private Type MP3Tag
FullName As String ' Filename and filepath of MP3 file
FileName As String ' Name of MP3 file
Path As String ' Path of MP3 file
title As String * 30
artist As String * 30
album As String * 30
Year As String * 4
Comment As String * 30
Genre As String * 20
TagPresent As Boolean
MPEGVersion As String * 3 ' Version 1.0, 2.0 or 3.0
Layer As String * 1 ' Layer 1, 2 or 3
Protection As Boolean ' 0=CRC is present, 1=Not Protected
BitRate As String * 3 ' Recording bitrate
SampleRate As String * 5 ' Sampling Frequency
Padding As Integer ' 0=Frame is not padded, 1=(32bits for Layer 1, 8bits for Layer 2/3)
PrivateBit As Integer ' Not used. Do what you want with it
ChannelMode As String * 12 ' 00=Stereo, 01=Joint Stereo, 10=Dual Channel Stereo, 11=Mono
ModeExtension As String * 2 ' Used only for Joint Stereo
Copyright As Boolean ' Is file copyrighted?
Original As Boolean ' Is file on original media?
Emphasis As String * 8 ' Emphasis setting (usually none (00))
FrameLength As Integer ' Calculated from BitRate, SampleRate and Padding
TotalFrames As Long ' Filelength/Framelength
PlayTime As Single ' Calculated from TotalFrames, SampleRate and Stereo?
ValidHeader As Boolean ' True=Valid Header found, False=Not an MP3 file
End Type
Private Const ERROR_NO_MORE_FILES = 18& ' 18
Private Const GENERIC_WRITE = &H40000000 ' 1073741824
Private Const FILE_ATTRIBUTE_NORMAL = &H8000000 ' 134217728
Private Const OPEN_ALWAYS = &H3 ' 3
Private Const FILE_BEGIN = &H0 ' 0
Private Const INVALID_HANDLE_VALUE = &HFFFF ' -1
Private Win32FindData As WIN32_FIND_DATA
Private MyMP3 As MP3Tag
Public Function ReadMP3Info()
If FileExists(MyMP3.FullName) = False Then ReadMP3Info = -1: Exit Function
ReadTag
ReadHeader
End Function
Private Function ReadTag()
Dim MyFileNumber As Integer
Dim Tag As String * 128
With MyMP3
.title = ""
.artist = ""
.album = ""
.Year = ""
.Comment = ""
.Genre = ""
.TagPresent = False
End With
MyFileNumber = FreeFile
Open (MyMP3.FullName) For Binary As MyFileNumber
Get MyFileNumber, FileLen(MyMP3.FullName) - 127, Tag
Close MyFileNumber
If Left(Tag, 3) = "TAG" Then
With MyMP3
.TagPresent = True
.title = Mid(Tag, 4, 30)
.artist = Mid(Tag, 34, 30)
.album = Mid(Tag, 64, 30)
.Year = Mid(Tag, 94, 4)
.Comment = Mid(Tag, 98, 30)
.Genre = GetGenre(Asc(IIf(Mid(Tag, 128, 1) = "", Chr(255), Mid(Tag, 128, 1))))
End With
End If
End Function
Public Function ReadHeader() As String
Dim StartOfHeader As Long
Dim Header As String
Dim MyFileNumber As Integer
Dim x
StartOfHeader = FindFrameHeader()
If StartOfHeader = -2 Then ReadHeader = -2: Exit Function
If MyMP3.FrameLength <= 0 Then
MyMP3.TotalFrames = 0
Else
MyMP3.TotalFrames = Int(FileLen(MyMP3.FullName) / MyMP3.FrameLength)
End If
End Function
I have a code for reading v2 but not for writing (I never got that far). I'm gonna take a look into the code and clean it up, did it four years ago and I've got atleast one bug report for it.
Some updates to the file. I hugely improved the tag processing speed and fixed a few bugs, although I still haven't tested how it works with unsynchronized tags because I don't have any myself.
Also now processes UTF-8, UTF-16BE and UTF-16LE correctly.
Compatible with the downloadable sample project that I linked to in my last post.
I figured out a major bug in the code that prevents reading all tags properly, which I've fixed, but there are also other issues that needs further attention, so I'm not posting an updated code until I'm much more certain the code works properly.
And I have issues with filenames that have Unicode in them... *sigh* not too surprising, but is surely one of those things that just have to be fixed in a general purpose class.
Reply With Quote
