www.pudn.com > clsMP3Info.rar > clsMP3Info.cls, change:2009-02-12,size:36752b
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsMP3Info"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' MP3 info class version 1.5
' Written by Mike D Sutton of EDais
' and Norm Cook (normcook@cableone.net)
'
' E-Mail: EDais@mvps.org
' WWW: Http://www.mvps.org/EDais/
'
' Written: 16/10/2001
' Last edited: 19/08/2003
'
'Version history:
'----------------
' Version 1.5 (19/08/2003):
' .HeaderPos property now re-named to .HeaderOffset
' .FormatTime() method replaced by .FormattedTime property
' .LoadMP3() method now private, use .FileName Property Let instead
' Changed most of how the class works internally
'
' Added: Padding, GenreCount, FrameLength, ID3Present, ID3v2Present,
' ID3v2Size, ID3v2Offset, FormattedTime, PrivateBit, HeaderOffset,
' Title*, Artist*, Album*, Year*, Comment*, GenreID*, TrackNum*
' and GenreString* properties
' (* = ID3 tag information)
'
' IDFromGenreString() - Attempts to match a string to a genre
' RemovePreHeader() - Removes any pre-header detected before the main MPEG header
' RemoveTag() - Removes the ID3 tag from the file
' WriteTag() - Writes the ID3 tag information to the file
' IsHeader() - Tests a DWord value for MPEG header frame sync. bit pattern
' ValidHeader() - Attempts to interpret (and validate) an MPEG header block
' GetFileTimes() - Gets a file's creation, last access and last write times
' SetFileTimes() - Sets a file's creation, last access and last write times
' ClearTag() - Clears the internal ID3 tag details
' TrimNull() - Converts a null-terminated string to a VB string
' Min() - Returns the minimum of two DWord values
' FileExist() - Checks to see if the given file exists
' MakeID3String() - Converts a string to an ID3 compatible string
' FlipDWord() - Converts a DWord value from little to big endian (and visa-versa)
' SyncSafeDWord() - Converts a standard DWord to an ID3v2 'sync-safe' DWord
' SyncSafeWord() - Converts a standard Word to an ID3v2 'sync-safe' Word
' SyncSafeByte() - Converts a standard Byte to an ID3v2 'sync-safe' Byte
' DeSyncSafeDWord() - Converts an ID3v2 'sync-safe' DWord to a standard DWord
' DeSyncSafeWord() - Converts an ID3v2 'sync-safe' Word to a standard Word
' DeSyncSafeByte() - Converts an ID3v2 'sync-safe' Byte to a standard Byte
' GetGenreString() - Returns a genre string based on the given genre ID
'------------------------
' Version 1.0/1.1 (16/10/2001):
' Added: ValidMP3, FileName, FileSize, BitRate, Frequency, SongLength,
' NumFrames, isVBR, MPEGVer, Layers, Protected, ChannelMode,
' Copyrighted, Original, HeaderPos and Emphasis properties
'
' LoadMP3() - Parses the given MP3 file to extract its header
' FormatTime() - Format track time into HH:MM:SS (Or MM:SS)
' ValidHead() - Tests for MPEG header sync information
' ClearInfo() - Clears out all current information
'-----------------
'
'About:
' Retrieves information about an MPEG audio file header including
' its bit-rate, frequency, length etc.
'
'You use this code at your own risk, I don't accept any
' responsibility for anything nasty it may do to your machine!
'Feel free to re-use this code in your own applications (Yeah,
' like I could stop you anyway ;) However, please don't attempt
' to sell or re-distribute it without my written consent.
'Visit my site for any updates to this and more strange graphics
' related VB code, comments and suggestions always welcome!
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 GetFileTime Lib "kernel32" (ByVal hFile As Long, ByRef lpCreationTime As FileTime, ByRef lpLastAccessTime As FileTime, ByRef lpLastWriteTime As FileTime) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, ByRef lpCreationTime As FileTime, ByRef lpLastAccessTime As FileTime, ByRef lpLastWriteTime As FileTime) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
' Types
Private Type ID3Tag ' 128 bytes (+3)
tagID As String * 3
tagTitle As String * 30
tagArtist As String * 30
tagAlbum As String * 30
tagYear As String * 4
tagComments As String * 30 ' Only 28 chars with ID3 v1.1
tagGenre As Byte
' These fields are not part of the tag structure itself, but
' hold additional information relating to ID3 v1.1 tags
tagTrackNum As Byte ' Only used with ID3 v1.1 tags
tagID311 As Boolean ' Does this look like a ID3 v1.1 tag
End Type
Private Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type typFileTimes
ftCreationTime As FileTime
ftLastAccessTime As FileTime
ftLastWriteTime As FileTime
End Type
Private Type typID3v2Inf
iiID As String * 3
iiVersion As Integer
iiFlags As Byte
iiSize As Long
End Type
Private m_MPEGVer As Single
Private m_Layers As Long
Private m_Protected As Boolean
Private m_Private As Boolean
Private m_BitRate As Long
Private m_Frequency As Long
Private m_ChannelMode As String
Private m_Copyrighted As Boolean
Private m_Original As Boolean
Private m_Emphasis As String
Private m_ID3Present As Boolean
Private m_ID3v2Present As Boolean
Private m_Padding As Byte
Private m_ValidMP3 As Boolean
Private m_FileName As String
Private m_FileSize As Long
Private m_SongLength As Long
Private m_NumFrames As Long
Private m_FrameLength As Long
Private m_VBR As Boolean
Private m_HeaderOffset As Long
Private m_ActSize As Long
Private m_Tag As ID3Tag
Private m_ID3v2Size As Long
Private m_ID3v2Offset As Long
Public HeaderTest As Boolean
' Constants
Private Const FrameSync As Long = &HE0FF& ' Byte order reversed - Usually 0xFFE00000
Private Const ID3TagID As String * 3 = "TAG" ' ID3v1.x header ID
Private Const VBRHeadID As String * 4 = "Xing" ' VBR (Variable Bit-Rate) header ID
Private Const ID3v2HeadID As String * 3 = "ID3" ' ID3v2 header ID
Private Const ID3v2FootID As String * 3 = "3DI" ' ID3v2 footer ID
Private Const ID3v2Sig As Long = &H334449 ' ASCII "ID3"
Private Const NumGenre As Long = &H95
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = &H3
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
' Public interface to member variables
Public Property Get Filename() As String
Filename = m_FileName
End Property
Public Property Let Filename(ByVal inNew As String)
m_FileName = inNew
Call LoadMP3
End Property
Public Property Get ValidMP3() As Boolean
ValidMP3 = m_ValidMP3
End Property
Public Property Get Padding() As Byte
Padding = m_Padding
End Property
Public Property Get GenreCount() As Long
GenreCount = NumGenre
End Property
Public Property Get FrameLength() As Long
FrameLength = m_FrameLength
End Property
Public Property Get ID3Present() As Boolean
ID3Present = m_ID3Present
End Property
Public Property Get ID3v2Present() As Boolean
ID3v2Present = m_ID3v2Present
End Property
Public Property Get ID3v2Size() As Long
ID3v2Size = m_ID3v2Size
End Property
Public Property Get ID3v2Offset() As Long
ID3v2Offset = m_ID3v2Offset
End Property
Public Property Get FileSize() As Long
FileSize = m_FileSize
End Property
Public Property Get BitRate() As Long
BitRate = m_BitRate
End Property
Public Property Get Frequency() As Long
Frequency = m_Frequency
End Property
Public Property Get SongLength() As Long
SongLength = m_SongLength
End Property
Public Property Get FormattedTime() As String ' Format track time into HH:MM:SS (Or MM:SS)
FormattedTime = Format$(CDate(m_SongLength / 86400), IIf(m_SongLength > 3600, "h:nn:ss", "nn:ss"))
End Property
Public Property Get NumFrames() As Long
NumFrames = m_NumFrames
End Property
Public Property Get isVBR() As Boolean
isVBR = m_VBR
End Property
Public Property Get MPEGVer() As Single
MPEGVer = m_MPEGVer
End Property
Public Property Get Layers() As Byte
Layers = m_Layers
End Property
Public Property Get Protected() As Boolean
Protected = m_Protected
End Property
Public Property Get PrivateBit() As Boolean
PrivateBit = m_Private
End Property
Public Property Get ChannelMode() As String
ChannelMode = m_ChannelMode
End Property
Public Property Get Copyrighted() As Boolean
Copyrighted = m_Copyrighted
End Property
Public Property Get Original() As Boolean
Original = m_Original
End Property
Public Property Get HeaderOffset() As Long
HeaderOffset = m_HeaderOffset
End Property
Public Property Get Emphasis() As String
Emphasis = m_Emphasis
End Property
Public Property Get Title() As String
Title = TrimNull(m_Tag.tagTitle)
End Property
Public Property Let Title(ByVal inNew As String)
m_Tag.tagTitle = MakeID3String(inNew, 30)
End Property
Public Property Get Artist() As String
Artist = TrimNull(m_Tag.tagArtist)
End Property
Public Property Let Artist(ByVal inNew As String)
m_Tag.tagArtist = MakeID3String(inNew, 30)
End Property
Public Property Get Album() As String
Album = TrimNull(m_Tag.tagAlbum)
End Property
Public Property Let Album(ByVal inNew As String)
m_Tag.tagAlbum = MakeID3String(inNew, 30)
End Property
Public Property Get Year() As String
Year = TrimNull(m_Tag.tagYear)
End Property
Public Property Let Year(ByVal inNew As String)
If (Not (Left$(inNew, 4) Like "*[!0123456789]*")) Then _
m_Tag.tagYear = MakeID3String(inNew, 4) ' Validate as numeric only
End Property
Public Property Get Comment() As String
Comment = TrimNull(m_Tag.tagComments)
End Property
Public Property Let Comment(ByVal inNew As String)
' We'll store the full 30-char string, but the last two
' characters will be overwritten if a track number is set
m_Tag.tagComments = MakeID3String(inNew, 30)
End Property
Public Property Get GenreID() As Byte
GenreID = m_Tag.tagGenre
End Property
Public Property Let GenreID(ByVal inNew As Byte)
m_Tag.tagGenre = inNew
End Property
Public Property Get TrackNum() As Byte
TrackNum = m_Tag.tagTrackNum
End Property
Public Property Let TrackNum(ByVal inNew As Byte)
m_Tag.tagTrackNum = inNew
m_Tag.tagID311 = (inNew <> &H0)
End Property
Public Property Get GenreString() As String
GenreString = GetGenreString(m_Tag.tagGenre)
End Property
' Class event handlers
Private Sub Class_Initialize()
m_Tag.tagID = ID3TagID
HeaderTest = True ' By default, enable the header test
End Sub
' Public subs & functions
Public Function IDFromGenreString(ByVal inGenreString As String) As Byte
Dim TrimGenre As String
Dim LoopGenre As Long
TrimGenre = Trim$(inGenreString)
For LoopGenre = 0 To NumGenre ' Search known genre's for the given genre string
If (StrComp(TrimGenre, GetGenreString(LoopGenre), vbTextCompare) = 0) Then Exit For
Next LoopGenre
If (LoopGenre > NumGenre) Then _
IDFromGenreString = &HFF Else _
IDFromGenreString = LoopGenre
End Function
Public Function RemovePreHeader(Optional ByVal inRetainDate As Boolean = True) As Boolean
Dim FBuffer() As Byte, BufLen As Long
Dim FNum As Long, OldDate As Date
Dim OrigTimes As typFileTimes
If (FileExist(m_FileName) And (m_HeaderOffset <> 0)) Then
If (Not (FileLen(m_FileName)) = m_FileSize) Then
Me.Filename = m_FileName ' File has changed since we first read it, re-parse
If (m_HeaderOffset = 0) Then Exit Function
End If
If (inRetainDate) Then inRetainDate = GetFileTimes(m_FileName, OrigTimes)
BufLen = m_FileSize - m_HeaderOffset
If (BufLen < 1) Then Exit Function
ReDim FBuffer(BufLen - 1) As Byte
FNum = FreeFile() ' Open & read in the file
Open m_FileName For Binary Access Read Lock Read Write As #FNum
Seek #FNum, m_HeaderOffset + 1 ' Seek past header
Get #FNum, , FBuffer() ' Read file data
Close #FNum
' Delete the old file
Call Kill(m_FileName)
FNum = FreeFile()
Open m_FileName For Binary Access Write Lock Read Write As #FNum
Put #FNum, , FBuffer() ' Write new file data
Close #FNum
If (m_ID3v2Present And (m_ID3v2Offset = 0)) Then
m_ID3v2Present = False
m_ID3v2Offset = 0
m_ID3v2Size = 0
End If
If (inRetainDate) Then Call SetFileTimes(m_FileName, OrigTimes)
RemovePreHeader = True
End If
End Function
Public Function RemoveTag(Optional ByVal inRetainDate As Boolean = True) As Boolean
Dim FNum As Integer
Dim FBuffer() As Byte, BufLen As Long
Dim OrigTimes As typFileTimes
If (Not (m_ID3Present Or FileExist(m_FileName))) Then Exit Function
If (FileLen(m_FileName) <> m_FileSize) Then
Me.Filename = m_FileName ' File has changed since we last read it, re-parse
If (Not m_ID3Present) Then Exit Function
End If
If (inRetainDate) Then inRetainDate = GetFileTimes(m_FileName, OrigTimes)
BufLen = m_FileSize - 128
If (BufLen < 1) Then Exit Function
ReDim FBuffer(BufLen - 1) As Byte
FNum = FreeFile()
Open m_FileName For Binary Access Read Lock Read Write As #FNum
Get #FNum, , FBuffer() ' Read current file excluding ID3 tag
Close #FNum
Call Kill(m_FileName) ' Delete old file
FNum = FreeFile()
Open m_FileName For Binary Access Write Lock Read Write As #FNum
Put #FNum, , FBuffer() ' Write new file data
Close #FNum
m_ID3Present = False
If (inRetainDate) Then Call SetFileTimes(m_FileName, OrigTimes)
RemoveTag = True
End Function
Public Function WriteTag(Optional ByVal inRetainDate As Boolean = True) As Boolean
Dim FNum As Long
Dim TagBuf(127) As Byte
Dim OrigTimes As typFileTimes
' Copy first 128 bytes of tag into buffer
Call RtlMoveMemory(TagBuf(0), m_Tag, 128)
If (m_Tag.tagID311) Then ' Append track number if ID3 v1.1
TagBuf(125) = &H0 ' Clip comment string to 28 bytes
TagBuf(126) = m_Tag.tagTrackNum ' Inject track number
End If
If (inRetainDate) Then inRetainDate = GetFileTimes(m_FileName, OrigTimes)
FNum = FreeFile() ' Open & find the end of file
Open m_FileName For Binary Access Write Lock Read Write As FNum
Seek FNum, LOF(FNum) + IIf(m_ID3Present, -127, 1)
Put #FNum, , TagBuf() ' Write the tag
Close FNum
m_ID3Present = True
If (inRetainDate) Then Call SetFileTimes(m_FileName, OrigTimes)
WriteTag = True
End Function
' Private routines
Private Function LoadMP3() As Boolean
Dim FNum As Integer
Dim ReadPos As Long
Dim GetHeader As Long
Dim VBRHeader(11) As Byte
Dim CheckChars() As Byte
Dim NoHeader As Boolean
Dim ReadID3v2 As typID3v2Inf
Call ClearInfo(True)
FNum = FreeFile()
Open m_FileName For Binary Access Read Lock Write As FNum
m_FileSize = LOF(FNum)
If (m_FileSize > 128) Then ' Read in the last 128 bytes of the file
Get #FNum, m_FileSize - 127, m_Tag
m_ID3Present = (m_Tag.tagID = ID3TagID) ' Check for ID3 tag ID
If (m_ID3Present) Then ' Check to see if this looks like an ID3 v1.1 tag
CheckChars() = StrConv(Right$(m_Tag.tagComments, 2), vbFromUnicode)
m_Tag.tagID311 = (CheckChars(0) = &H0) And (CheckChars(1) > &H0)
m_Tag.tagTrackNum = IIf(m_Tag.tagID311, CheckChars(1), &H0)
Else: Call ClearTag
End If
End If
' Read first 10 bytes to check for ID3v2 header
Seek #FNum, 1
Get #FNum, , ReadID3v2
' Validate tag header ID
m_ID3v2Present = (ReadID3v2.iiID = ID3v2HeadID)
If (Not m_ID3v2Present) Then ' No ID3v2 tag found at the start of the file, have a look for the ID3v2.4+ footer at the end
m_ID3v2Offset = m_FileSize - IIf(m_ID3Present, 128, 0) - 9
If (m_ID3v2Offset > 1) Then
Seek #FNum, m_ID3v2Offset
Get #FNum, , ReadID3v2
m_ID3v2Present = (ReadID3v2.iiID = ID3v2FootID)
End If
If (m_ID3v2Present) Then m_ID3v2Offset = Seek(FNum) - 1 Else m_ID3v2Offset = 0
End If
If (m_ID3v2Present) Then ' Extract size of full ID3v2 tag - Aware of additional footer size defined in ID3v2.4
m_ID3v2Size = DeSyncSafeDWord(FlipDWord(ReadID3v2.iiSize)) + IIf(ReadID3v2.iiFlags And &H10, 20, 10)
If (m_ID3v2Offset = 0) Then ' Tag precedes audio data, offset read start position
ReadPos = m_ID3v2Size
Else ' Tag follows audio data, project tag start position
m_ID3v2Offset = m_ID3v2Offset - m_ID3v2Size
End If
End If
Do ' Scan until a valid header is found
Do ' Scan through the file looking for possible headers
ReadPos = ReadPos + 1
Seek #FNum, ReadPos
Get #FNum, , GetHeader
If (ReadPos >= (m_FileSize - 5)) Then
NoHeader = True
Exit Do
End If
If ((Not m_ID3v2Present) And HeaderTest) Then ' Check for embedded ID3v2 tag before the frame header
If ((GetHeader And &HFFFFFF) = ID3v2Sig) Then ' Found what looks like an ID3v2 pre-header
Seek #FNum, ReadPos
Get #FNum, , ReadID3v2
If ((ReadID3v2.iiVersion < &HFF) And (ReadID3v2.iiSize And &H80808080) = 0&) Then ' Look's valid
m_ID3v2Present = True
m_ID3v2Offset = ReadPos - 1
m_ID3v2Size = DeSyncSafeDWord(FlipDWord(ReadID3v2.iiSize)) + _
IIf(ReadID3v2.iiFlags And &H10, 20, 10)
ReadPos = ReadPos + m_ID3v2Size - 1
End If
End If
End If
Loop Until IsHeader(GetHeader)
Loop Until ValidHeader(GetHeader, ReadPos) Or NoHeader
If (NoHeader) Then
Call ClearInfo
Else ' Read in variable bitrate header
If (ReadPos < (m_FileSize - 48)) Then
Seek #FNum, ReadPos + 36
Get #FNum, , VBRHeader()
End If
End If
Close #FNum
If (NoHeader) Then Exit Function
m_VBR = Left$(StrConv(VBRHeader(), vbUnicode), 4) = VBRHeadID
If (m_VBR) Then
m_ValidMP3 = (VBRHeader(7) And &H1) = &H1
If (m_ValidMP3) Then ' FRAMES_FLAG
m_NumFrames = ((VBRHeader(8) And &H7F) * &H1000000) Or (VBRHeader(9) * &H10000) Or (VBRHeader(10) * &H100) Or VBRHeader(11)
If (VBRHeader(8) And &H80) Then m_NumFrames = Not ((Not m_NumFrames) And &H7FFFFFFF)
m_BitRate = (((m_FileSize / m_NumFrames) * m_Frequency) / (1000 * IIf(((GetHeader And &H1800) \ &H800) = &H3, 12, 144))) \ 12
m_SongLength = ((8 * m_ActSize) \ 1000) \ m_BitRate
End If
End If
LoadMP3 = True
End Function
Private Function IsHeader(ByRef inHead As Long) As Boolean ' Tests for MPEG header sync information
IsHeader = (inHead And FrameSync) = FrameSync
End Function
Private Function ValidHeader(ByVal inHead As Long, ByVal ReadPos As Long) As Boolean
Dim HeadVals(11) As Byte
Dim FlipHead As Long
' 32-bit MP3 frame header construction:
' 87654321 87654321 87654321 87654321
' AAAAAAAA AAABBCCD EEEEFFGH IIJJKLMM
' Test for valid sync. bits pattern (A)
If (Not IsHeader(inHead)) Then Exit Function
' Header byte order must be flipped, since it was interpreted as a
' little endian DWord - Remove frame sync. to avoid sign issues
FlipHead = FlipDWord(inHead And Not FrameSync)
HeadVals(0) = (FlipHead And &H180000) \ &H80000 ' MPEG version (B)
HeadVals(1) = (FlipHead And &H60000) \ &H20000 ' Layer description (C)
HeadVals(2) = (FlipHead And &H10000) \ &H10000 ' Protection bit (D)
HeadVals(3) = (FlipHead And &HF000&) \ &H1000& ' Bit-rate index (E)
HeadVals(4) = (FlipHead And &HC00&) \ &H400& ' Sample rate (F)
HeadVals(5) = (FlipHead And &H200&) \ &H200& ' Padding bit (G)
HeadVals(6) = (FlipHead And &H100&) \ &H100& ' Private bit (H)
HeadVals(7) = (FlipHead And &HC0&) \ &H40& ' Channel mode (I)
HeadVals(8) = (FlipHead And &H30&) \ &H10& ' Mode extension (J)
HeadVals(9) = (FlipHead And &H8&) \ &H8& ' Copyright bit (K)
HeadVals(10) = (FlipHead And &H4&) \ &H4& ' Original bit (L)
HeadVals(11) = FlipHead And &H3& ' Emphasis (M)
Select Case HeadVals(0) ' Select frequency based on MPEG version
Case 0: m_Frequency = Choose(HeadVals(4) + 1, 11025, 12000, 8000, 0) ' MPEG 2.5
Case 1: m_Frequency = 0 ' Reserved
Case 2: m_Frequency = Choose(HeadVals(4) + 1, 22050, 24000, 26000, 0) ' MPEG 2.0
Case 3: m_Frequency = Choose(HeadVals(4) + 1, 44100, 48000, 32000, 0) ' MPEG 1.0
End Select
If (m_Frequency = 0) Then Exit Function
If (HeadVals(0) = &H3) Then ' MPEG 1.0
Select Case HeadVals(1)
Case &H3: m_BitRate = Choose(HeadVals(3) + 1, 0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448, 0)
Case &H2: m_BitRate = Choose(HeadVals(3) + 1, 0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 284, 0)
Case &H1: m_BitRate = Choose(HeadVals(3) + 1, 0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 0)
End Select
Else ' MPEG 2.0, 2.5 or undefined
Select Case HeadVals(1)
Case &H3: m_BitRate = Choose(HeadVals(3) + 1, 0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256, 0)
Case &H2, &H1: m_BitRate = Choose(HeadVals(3) + 1, 0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160, 0)
End Select
End If
If (m_BitRate = 0) Then Exit Function
m_ActSize = m_FileSize - ReadPos - IIf(m_ID3Present, &H80, &H0)
m_NumFrames = m_ActSize \ ((m_BitRate * 144000) \ m_Frequency)
m_HeaderOffset = ReadPos - 1
m_SongLength = ((8 * m_ActSize) \ 1000) \ m_BitRate
m_MPEGVer = Choose(HeadVals(0) + 1, 2.5, 0, 2, 1)
m_Layers = Choose(HeadVals(1) + 1, 0, 3, 2, 1)
If ((m_MPEGVer = 0) Or (m_Layers = 0)) Then Exit Function
m_Padding = HeadVals(5)
m_Private = HeadVals(6)
If (m_Layers = 1) Then _
m_FrameLength = (12 * (m_BitRate * 1000&) \ m_Frequency + m_Padding) * 4 Else _
m_FrameLength = (144 * (m_BitRate * 1000&) \ m_Frequency) + m_Padding
m_ChannelMode = Choose(HeadVals(7) + 1, "Stereo", "Joint stereo", "Dual channel", "Single channel")
m_Protected = HeadVals(2) = &H0
m_Copyrighted = HeadVals(9) = &H1
m_Original = HeadVals(10) = &H1
m_Emphasis = Choose(HeadVals(11) + 1, "None", "50/15 ms", "Reserved", "CCIT j.17")
m_ValidMP3 = True
ValidHeader = True
End Function
Private Sub ClearInfo(Optional ByVal inLeaveFilename As Boolean = False) ' Clears out all current information
m_MPEGVer = 0
m_Layers = 0
m_Protected = False
m_BitRate = 0
m_Frequency = 0
m_ChannelMode = ""
m_Copyrighted = False
m_Original = False
m_ValidMP3 = False
m_FileSize = 0
m_SongLength = 0
m_NumFrames = 0
m_VBR = False
m_HeaderOffset = 0
m_Emphasis = ""
m_ID3Present = False
m_Padding = 0
m_FrameLength = 0
m_ActSize = 0
m_ID3v2Present = False
m_ID3v2Offset = 0
m_ID3v2Size = 0
If (Not (inLeaveFilename)) Then m_FileName = ""
Call ClearTag
End Sub
Private Function GetFileTimes(ByVal inFile As String, ByRef outFileTimes As typFileTimes) As Boolean
Dim hFile As Long
hFile = CreateFile(inFile, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
GetFileTimes = CBool(hFile)
If (GetFileTimes) Then Call GetFileTime(hFile, outFileTimes.ftCreationTime, _
outFileTimes.ftLastAccessTime, outFileTimes.ftLastWriteTime)
Call CloseHandle(hFile)
End Function
Private Function SetFileTimes(ByVal inFile As String, ByRef inFileTimes As typFileTimes) As Boolean
Dim hFile As Long
hFile = CreateFile(inFile, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
SetFileTimes = CBool(hFile)
If (SetFileTimes) Then Call SetFileTime(hFile, inFileTimes.ftCreationTime, _
inFileTimes.ftLastAccessTime, inFileTimes.ftLastWriteTime)
Call CloseHandle(hFile)
End Function
Private Sub ClearTag()
Dim BlankStruct As ID3Tag
m_Tag = BlankStruct ' Clear the internal ID3 tag
m_Tag.tagID = ID3TagID ' Re-set the tag header
End Sub
Private Function TrimNull(ByVal inString As String) As String
Dim NullPos As Long
NullPos = InStr(inString, vbNullChar)
If (NullPos) Then TrimNull = Left$(inString, NullPos - 1) Else TrimNull = inString
End Function
Private Function Min(ByVal inA As Long, ByVal inB As Long) As Long
Min = IIf(inA < inB, inA, inB)
End Function
Private Function FileExist(ByVal inFile As String) As Boolean
On Error Resume Next
FileExist = CBool(FileLen(inFile) + 1)
End Function
Private Function MakeID3String(ByVal inString As String, ByVal inLength As Long) As String
Dim TrimLength As Long
TrimLength = Min(Len(TrimNull(inString)), inLength)
MakeID3String = Left$(inString, TrimLength) & String$(inLength - TrimLength, vbNullChar)
End Function
Private Function FlipDWord(ByVal inDWord As Long) As Long
FlipDWord = (((inDWord And &HFF000000) \ &H1000000) And &HFF) Or _
(((inDWord And &HFF0000) \ &H10000) * &H100) Or _
(((inDWord And &HFF00&) \ &H100) * &H10000) Or _
((inDWord And &H7F) * &H1000000)
If (inDWord And &H80) Then FlipDWord = Not ((Not FlipDWord) And &H7FFFFFFF)
End Function
' Sync-safe integer conversion routines based on ID3v2 specifications section 6.2
Private Function SyncSafeDWord(ByVal inDWord As Long) As Long
Dim UseDWord As Long
UseDWord = inDWord And &HFFFFFFF ' Mask low 28-bits and shift bytes
SyncSafeDWord = (UseDWord And &H7F) Or ((UseDWord And &H3F80) * &H2) Or _
((UseDWord And &H1FC000) * &H4) Or ((UseDWord And &HFE00000) * &H8)
End Function
Private Function SyncSafeWord(ByVal inWord As Integer) As Integer
Dim UseWord As Long
UseWord = inWord And &H3FFF ' Mask low 14-bits and shift bytes
SyncSafeWord = (UseWord And &H7F) Or ((UseWord And &H3F80) * &H2)
End Function
Private Function SyncSafeByte(ByVal inByte As Byte) As Byte
SyncSafeByte = inByte And &H7F ' Mask low 7-bits
End Function
Private Function DeSyncSafeDWord(ByVal inDWord As Long) As Long
DeSyncSafeDWord = (inDWord And &H7F) Or ((inDWord And &H7F00) \ &H2) Or _
((inDWord And &H7F0000) \ &H4) Or ((inDWord And &H7F000000) \ &H8)
End Function
Private Function DeSyncSafeWord(ByVal inWord As Integer) As Integer
DeSyncSafeWord = (inWord And &H7F) Or ((inWord And &H7F00) \ &H2)
End Function
Private Function DeSyncSafeByte(ByVal inByte As Byte) As Byte
DeSyncSafeByte = inByte And &H7F
End Function
Private Function GetGenreString(ByVal inGenre As Byte) As String
Select Case inGenre ' Extracted from in_mp3.dll which ships with NullSoft's WinAMP v2.91
Case &H0: GetGenreString = "Blues"
Case &H1: GetGenreString = "Classic Rock"
Case &H2: GetGenreString = "Country"
Case &H3: GetGenreString = "Dance"
Case &H4: GetGenreString = "Disco"
Case &H5: GetGenreString = "Funk"
Case &H6: GetGenreString = "Grunge"
Case &H7: GetGenreString = "Hip-Hop"
Case &H8: GetGenreString = "Jazz"
Case &H9: GetGenreString = "Metal"
Case &HA: GetGenreString = "New Age"
Case &HB: GetGenreString = "Oldies"
Case &HC: GetGenreString = "Other"
Case &HD: GetGenreString = "Pop"
Case &HE: GetGenreString = "R&B"
Case &HF: GetGenreString = "Rap"
Case &H10: GetGenreString = "Reggae"
Case &H11: GetGenreString = "Rock"
Case &H12: GetGenreString = "Techno"
Case &H13: GetGenreString = "Industrial"
Case &H14: GetGenreString = "Alternative"
Case &H15: GetGenreString = "Ska"
Case &H16: GetGenreString = "Death Metal"
Case &H17: GetGenreString = "Pranks"
Case &H18: GetGenreString = "Soundtrack"
Case &H19: GetGenreString = "Euro-Techno"
Case &H1A: GetGenreString = "Ambient"
Case &H1B: GetGenreString = "Trip-Hop"
Case &H1C: GetGenreString = "Vocal"
Case &H1D: GetGenreString = "Jazz+Funk"
Case &H1E: GetGenreString = "Fusion"
Case &H1F: GetGenreString = "Trance"
Case &H20: GetGenreString = "Classical"
Case &H21: GetGenreString = "Instrumental"
Case &H22: GetGenreString = "Acid"
Case &H23: GetGenreString = "House"
Case &H24: GetGenreString = "Game"
Case &H25: GetGenreString = "Sound Clip"
Case &H26: GetGenreString = "Gospel"
Case &H27: GetGenreString = "Noise"
Case &H28: GetGenreString = "Rock"
Case &H29: GetGenreString = "Alt"
Case &H2A: GetGenreString = "Bass"
Case &H2B: GetGenreString = "Soul"
Case &H2C: GetGenreString = "Punk"
Case &H2D: GetGenreString = "Space"
Case &H2E: GetGenreString = "Meditative"
Case &H2F: GetGenreString = "Instrumental Pop"
Case &H30: GetGenreString = "Instrumental Rock"
Case &H31: GetGenreString = "Ethnic"
Case &H32: GetGenreString = "Gothic"
Case &H33: GetGenreString = "Darkwave"
Case &H34: GetGenreString = "Techno-Industrial"
Case &H35: GetGenreString = "Electronic"
Case &H36: GetGenreString = "Pop-Folk"
Case &H37: GetGenreString = "Eurodance"
Case &H38: GetGenreString = "Dream"
Case &H39: GetGenreString = "Southern Rock"
Case &H3A: GetGenreString = "Comedy"
Case &H3B: GetGenreString = "Cult"
Case &H3C: GetGenreString = "Gangsta Rap"
Case &H3D: GetGenreString = "Top 40"
Case &H3E: GetGenreString = "Christian Rap"
Case &H3F: GetGenreString = "Pop/Funk"
Case &H40: GetGenreString = "Jungle"
Case &H41: GetGenreString = "Native American"
Case &H42: GetGenreString = "Cabaret"
Case &H43: GetGenreString = "New Wave"
Case &H44: GetGenreString = "Psychedelic"
Case &H45: GetGenreString = "Rave"
Case &H46: GetGenreString = "Showtunes"
Case &H47: GetGenreString = "Trailer"
Case &H48: GetGenreString = "Lo-Fi"
Case &H49: GetGenreString = "Tribal"
Case &H4A: GetGenreString = "Acid Punk"
Case &H4B: GetGenreString = "Acid Jazz"
Case &H4C: GetGenreString = "Polka"
Case &H4D: GetGenreString = "Retro"
Case &H4E: GetGenreString = "Musical"
Case &H4F: GetGenreString = "Rock & Roll"
' Genre's added by Nullsoft; may be interpreted differently by other applications..
Case &H50: GetGenreString = "Hard Rock"
Case &H51: GetGenreString = "Folk"
Case &H52: GetGenreString = "Folk/Rock"
Case &H53: GetGenreString = "National Folk"
Case &H54: GetGenreString = "Swing"
Case &H55: GetGenreString = "Fast-Fusion"
Case &H56: GetGenreString = "Bebob"
Case &H57: GetGenreString = "Latin"
Case &H58: GetGenreString = "Revival"
Case &H59: GetGenreString = "Celtic"
Case &H5A: GetGenreString = "Bluegrass"
Case &H5B: GetGenreString = "Avantgarde"
Case &H5C: GetGenreString = "Gothic Rock"
Case &H5D: GetGenreString = "Progressive Rock"
Case &H5E: GetGenreString = "Psychedelic Rock"
Case &H5F: GetGenreString = "Symphonic Rock"
Case &H60: GetGenreString = "Slow Rock"
Case &H61: GetGenreString = "Big Band"
Case &H62: GetGenreString = "Chorus"
Case &H63: GetGenreString = "Easy Listening"
Case &H64: GetGenreString = "Acoustic"
Case &H65: GetGenreString = "Humour"
Case &H66: GetGenreString = "Speech"
Case &H67: GetGenreString = "Chanson"
Case &H68: GetGenreString = "Opera"
Case &H69: GetGenreString = "Chamber Music"
Case &H6A: GetGenreString = "Sonata"
Case &H6B: GetGenreString = "Symphony"
Case &H6C: GetGenreString = "Booty Bass"
Case &H6D: GetGenreString = "Primus"
Case &H6E: GetGenreString = "Porn Groove"
Case &H6F: GetGenreString = "Satire"
Case &H70: GetGenreString = "Slow Jam"
Case &H71: GetGenreString = "Club"
Case &H72: GetGenreString = "Tango"
Case &H73: GetGenreString = "Samba"
Case &H74: GetGenreString = "Folklore"
Case &H75: GetGenreString = "Ballad"
Case &H76: GetGenreString = "Power Ballad"
Case &H77: GetGenreString = "Rhythmic Soul"
Case &H78: GetGenreString = "Freestyle"
Case &H79: GetGenreString = "Duet"
Case &H7A: GetGenreString = "Punk Rock"
Case &H7B: GetGenreString = "Drum Solo"
Case &H7C: GetGenreString = "A Cappella"
Case &H7D: GetGenreString = "Euro-House"
Case &H7E: GetGenreString = "Dance Hall"
Case &H7F: GetGenreString = "Goa"
Case &H80: GetGenreString = "Drum & Bass"
Case &H81: GetGenreString = "Club-House"
Case &H82: GetGenreString = "Hardcore"
Case &H83: GetGenreString = "Terror"
Case &H84: GetGenreString = "Indie"
Case &H85: GetGenreString = "BritPop"
Case &H86: GetGenreString = "Negerpunk"
Case &H87: GetGenreString = "Polsk Punk"
Case &H88: GetGenreString = "Beat"
Case &H89: GetGenreString = "Christian Gangsta Rap"
Case &H8A: GetGenreString = "Heavy Metal"
Case &H8B: GetGenreString = "Black Metal"
Case &H8C: GetGenreString = "Crossover"
Case &H8D: GetGenreString = "Contemporary Christian"
Case &H8E: GetGenreString = "Christian Rock"
Case &H8F: GetGenreString = "Merengue"
Case &H90: GetGenreString = "Salsa"
Case &H91: GetGenreString = "Thrash Metal"
Case &H92: GetGenreString = "Anime"
Case &H93: GetGenreString = "JPop"
Case &H94: GetGenreString = "Synthpop"
Case Else: GetGenreString = vbNullString
End Select
End Function