<%
'========================================================================
' MODULE:    cReadMP3.asp
' AUTHOR:   Terje Hauger
' HOME:       © www.u229.no/stuff/mp3/
' CREATED:  February 2006
'========================================================================
' COMMENT: This class should read all ID3 versions, included 2.4.
'                  Reference: http://id3lib.sourceforge.net/id3/develop.html
'========================================================================
' ROUTINES:

' - Public Property Let FilePath(s)
' - Public Property Get FilePath()
' - Public Property Get ID3Version()
' - Public Property Get Title()
' - Public Property Get Artist()
' - Public Property Get Album()
' - Public Property Get Year()
' - Public Property Get Comment()
' - Public Property Get TrackNumber()
' - Public Property Get Genre()
' - Public Property Get Composer()
' - Public Property Get OriginalArtist()
' - Public Property Get CopyRight()
' - Public Property Get Lyrics()
' - Public Property Get Publisher()
' - Public Property Get Size()
' - Public Property Get DateCreated()
' - Public Property Get DateLastAccessed()
' - Public Property Get DateLastModified()
' - Public Property Get ErrorMessage()

' - Private Sub Class_Initialize()
' - Public Function ReadMP3()
' - Private Sub ReadID3v2()
' - Private Sub ReadID3v3()
' - Private Sub ReadID3v4()
' - Private Sub ReadID3v1()
' - Private Sub ReadFrameName(sHeader, sValue)
' - Private Sub ReadFrameName20(sHeader, sValue)
' - Private Function BinToString(Binary)
' - Private Function GetSize(a, b, c, d)
' - Private Function ReadMP3Bytes()
' - Private Function LoadMP3()
' - Private Function GenreName(sID)
'========================================================================

' ADO.STREAM
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const adStateClosed = 0
Const adStateOpen = 1
' FSO
Const ForReading = 1                  '// Open a file for reading only. You can't write to this file.
Const TristateUseDefault = -2    '// Opens the file using the system default.

'========================================================================
Class cReadMP3
'========================================================================

'// MODULE VARIABLES
Private m_sID3Version              '// 1.0, 1.1, 2.2, 2.3 or 2.4
Private m_bytID3Header            '// The first 10 bytes of the mp3 file
Private m_bytID3                       '// The whole ID3 tag
Private m_lID3Length                 '// Length of the ID3 tag
Private m_lMajorVersion            '// Major version 
Private m_lRevisionVersion        '/ Revision version
Private m_arrMP3                       '// Byte array holding the mp3 file
Private m_lCounter                      '// A module counter
Private m_m_bytFrameHeader   '// Bytes identifying a single frame.
Private m_bytFrame                    '// Byte array holding a frame
Private m_lFrameLength             '// The length of a frame.

Private m_sFilePath
Private m_sTitle
Private m_sArtist
Private m_sAlbum
Private m_sYear
Private m_sComment
Private m_lTrackNumber
Private m_sGenre
Private m_sComposer
Private m_sOriginalArtist
Private m_sCopyRight
Private m_sLyrics
Private m_sPublisher

Private m_lMP3Size                           '// Size of file
Private m_sDateCreated                    '// Date Created on this disk
Private m_sDateLastAccessed          '// Date Last Accessed
Private m_sDateLastModified            '// Date Last Modified
Private m_sErrorMessage


'// MODULE PROPERTIES
Public Property Let FilePath(s)
    m_sFilePath = s
End Property
Public Property Get FilePath()
    FilePath = m_sFilePath
End Property
Public Property Get ID3Version()
    ID3Version = m_sID3Version
End Property
Public Property Get Title()
    Title = m_sTitle
End Property
Public Property Get Artist()
    Artist = m_sArtist
End Property
Public Property Get Album()
    Album = m_sAlbum
End Property
Public Property Get Year()
    Year = m_sYear
End Property
Public Property Get Comment()
    Comment = Replace(m_sComment, Chr(0), "")
End Property
Public Property Get TrackNumber()
    TrackNumber = m_lTrackNumber
End Property
Public Property Get Genre()
    Genre = m_sGenre
End Property
Public Property Get Composer()
    Composer = m_sComposer
End Property
Public Property Get OriginalArtist()
    OriginalArtist = m_sOriginalArtist
End Property
Public Property Get CopyRight()
    CopyRight = m_sCopyRight
End Property
Public Property Get Lyrics()
    Lyrics = m_sLyrics
End Property
Public Property Get Publisher()
    Publisher = m_sPublisher
End Property
Public Property Get Size()
    Size = m_lMP3Size
End Property
Public Property Get DateCreated()
    DateCreated = m_sDateCreated
End Property
Public Property Get DateLastAccessed()
    DateLastAccessed = m_sDateLastAccessed
End Property
Public Property Get DateLastModified()
    DateLastModified = m_sDateLastModified
End Property
Public Property Get ErrorMessage()
    ErrorMessage = m_sErrorMessage
End Property


'------------------------------------------------------------------------------------------------------------
' Comment:
'------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
    On Error Resume Next
    
    '// Set default
    m_sID3Version = "Unknown"

End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: Read the mp3 header.
'------------------------------------------------------------------------------------------------------------
Public Function ReadMP3()
    On Error Resume Next

    '---------------------------- Verify valid data

    If Len(m_sFilePath) = 0 Then m_sErrorMessage = "Missing Parameter: FilePath": Exit Function
    If Not (ReadMP3Bytes And LoadMP3) Then m_sErrorMessage = "Error opening file": Exit Function
    If m_lMP3Size <= 128 Then m_sErrorMessage = "Not a valid mp3 file.": Exit Function

    '---------------------------- Read the mp3 header

    '// First 10 bytes: I | D | 3 | Major | Revision | Flags | Size | Size | Size | Size
    m_bytID3Header = MidB(m_arrMP3, 1, 10)
    m_lCounter = CLng(m_lCounter)

    '// See if the ID3 identifier is in the first 3 bytes of the header
    If Not BinToString(MidB(m_bytID3Header, 1, 3)) = "ID3" Then
        '// If not, see if this file might be the old version 1
        Call ReadID3v1
        Exit Function
    End If

    '// Getting this far must mean we have a version 2+ mp3 file: Read the version info.
    m_lMajorVersion = CStr(AscB(MidB(m_bytID3Header, 4, 1)))
    m_lRevisionVersion = CStr(AscB(MidB(m_bytID3Header, 5, 1)))

    m_sID3Version = "ID3v2" & "." & m_lMajorVersion & "." & m_lRevisionVersion

    '// Get the size of the ID3 tag
    m_lID3Length = GetSize(MidB(m_bytID3Header, 7, 1), MidB(m_bytID3Header, 8, 1), _
        MidB(m_bytID3Header, 9, 1), MidB(m_bytID3Header, 10, 1)) + 10

    m_bytID3 = MidB(m_arrMP3, 1, m_lID3Length)

    '// Call the corresponding routine for this version
    Select Case m_lMajorVersion
        Case 2: Call ReadID3v2
        Case 3: Call ReadID3v3
        Case 4: Call ReadID3v4
        Case Else
    End Select

End Function

'------------------------------------------------------------------------------------------------------------
' Comment: Read ID3 version 2.2
'------------------------------------------------------------------------------------------------------------
Private Sub ReadID3v2()
    On Error Resume Next
                
    For m_lCounter = 11 To m_lID3Length

        m_m_bytFrameHeader = MidB(m_bytID3, m_lCounter, 3)

        '// Check if we have passed the information part: no need to do more parsing.
        If InStrB(m_m_bytFrameHeader, Chr(0)) > 0 Then Exit For

        '// Move the counter passed the 3 bytes holding the frame header
        m_lCounter = (m_lCounter + 3)
                
        '// Calculate the length of this frame
        m_lFrameLength = CLng(AscB(MidB(m_bytID3, m_lCounter, 1))) * 16384 + _
	    CLng(AscB(MidB(m_bytID3, m_lCounter + 1, 1))) * 128 + CLng(AscB(MidB(m_bytID3, m_lCounter + 2, 1)))

        '// Move the counter passed the 3 bytes holding the size
        m_lCounter = (m_lCounter + 3)
                
        '// Read in the bytes in this frame
        m_bytFrame = MidB(m_bytID3, m_lCounter, m_lFrameLength)
                
        '// Compare the frame header with the known headers that we want to read
        Call ReadFrameName20(BinToString(m_m_bytFrameHeader), BinToString(m_bytFrame))

        '// Finally move counter to the start of next frame
        m_lCounter = (m_lCounter + m_lFrameLength - 1)
    Next

End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: Read ID3 version 2.3
'------------------------------------------------------------------------------------------------------------
Private Sub ReadID3v3()
    On Error Resume Next

    Dim i, lExtHeaderLength

    i = 11

    '// This version introduced an extended header feature, which sucks.
    '// Check the flags byte to see if we have one.
    If CBool(AscB(MidB(m_bytID3Header, 5, 1)) And 4) Then
        '// Get it's size: should be 6 or 10 bytes
        lExtHeaderLength = GetSize(MidB(m_bytID3Header, 11, 1), MidB(m_bytID3Header, 12, 1), _
	    MidB(m_bytID3Header, 13, 1), MidB(m_bytID3Header, 14, 1))

        If lExtHeaderLength = 6 Or lExtHeaderLength = 10 Then
            '// Move the counter passed the extende header.
            i = (i + lExtHeaderLength) + 4
        End If
    End If
        
    For m_lCounter = i To m_lID3Length

        m_m_bytFrameHeader = MidB(m_bytID3, m_lCounter, 4)

        '// Simple check to see if we have passed the information part: no need to do more parsing.
        If InStrB(m_m_bytFrameHeader, Chr(0)) > 0 Then Exit For

        '// Move the counter passed the 4 bytes holding the frame header
        m_lCounter = (m_lCounter + 4)
                
        '// Calculate the length of this frame
        m_lFrameLength = GetSize(MidB(m_bytID3, m_lCounter, 1), MidB(m_bytID3, m_lCounter + 1, 1), _
	    MidB(m_bytID3, m_lCounter + 2, 1), MidB(m_bytID3, m_lCounter + 3, 1))

        '// Move the counter 4 bytes holding the size and 2 bytes holding flags
        m_lCounter = (m_lCounter + 6)
                
        '// Read in the bytes in this frame
        m_bytFrame = MidB(m_bytID3, m_lCounter, m_lFrameLength)
                
        '// Compare the frame header with the known headers that we want to read
        Call ReadFrameName(BinToString(m_m_bytFrameHeader), BinToString(m_bytFrame))

        '// Finally move the counter to the start of next frame
        m_lCounter = (m_lCounter + m_lFrameLength - 1)

    Next

End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: Read ID3 version 2.4
'------------------------------------------------------------------------------------------------------------
Private Sub ReadID3v4()
    On Error Resume Next

    '// There might be an extended header present even with this version (see above), and even a footer.
    '// I am not trying to support these features here. I think they are rarely used by any sane software.
    '// In short: I think this ID3 format sucks.
        
    For m_lCounter = 11 To m_lID3Length

        m_m_bytFrameHeader = MidB(m_bytID3, m_lCounter, 4)

        '// Simple check to see if we have passed the information part: no need to do more parsing.
        If InStrB(m_m_bytFrameHeader, Chr(0)) > 0 Then Exit For

        '// Move the counter passed the 4 bytes holding the frame header
        m_lCounter = (m_lCounter + 4)
                
        '// Calculate the length of this frame
        m_lFrameLength = GetSize(MidB(m_bytID3, m_lCounter, 1), MidB(m_bytID3, m_lCounter + 1, 1), _
	    MidB(m_bytID3, m_lCounter + 2, 1), MidB(m_bytID3, m_lCounter + 3, 1))

        '// Move the counter 4 bytes holding the size and 2 bytes holding flags
        m_lCounter = (m_lCounter + 6)
                
        '// Read in the bytes in this frame
        m_bytFrame = MidB(m_bytID3, m_lCounter, m_lFrameLength)
                
        '// Compare the frame header with the known headers that we want to read
        Call ReadFrameName(BinToString(m_m_bytFrameHeader), BinToString(m_bytFrame))

        '// Finally move the counter to the start of next frame
        m_lCounter = (m_lCounter + m_lFrameLength - 1)

    Next

End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: MP3 tag info is stored in the last 128 bytes.
'------------------------------------------------------------------------------------------------------------
Private Sub ReadID3v1()
    On Error Resume Next

    Dim byt128

    byt128 = MidB(m_arrMP3, m_lMP3Size - 127, 128)

    If Not BinToString(MidB(byt128, 1, 3)) = "TAG" Then Exit Sub

    m_sID3Version = "ID3v1.0"
    m_sTitle = BinToString(MidB(byt128, 4, 30))
    m_sArtist = BinToString(MidB(byt128, 34, 30))
    m_sAlbum = BinToString(MidB(byt128, 64, 30))
    m_sYear = BinToString(MidB(byt128, 94, 4))
    m_sComment = BinToString(MidB(byt128, 98, 30))
    m_sGenre = GenreName(CStr(AscB(MidB(byt128, 128, 1))))
    
    '// Get the track number if ID3 version is 1.1
    If AscB(MidB(byt128, 126, 1)) = 0 And AscB(MidB(byt128, 127, 1)) <> 0 Then
        m_sID3Version = "ID3v1.1"
        ' Comment field is in this case 28 bytes
        m_sComment = BinToString(MidB(byt128, 98, 28))
        m_lTrackNumber = AscB(MidB(byt128, 127, 1))
    End If

End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: For ID3 version 2.3 and 2.4
'------------------------------------------------------------------------------------------------------------
Private Sub ReadFrameName(sHeader, sValue)
    On Error Resume Next

    Select Case sHeader
        Case "TIT2": m_sTitle = sValue
        Case "TPE1": m_sArtist = sValue
        Case "TALB": m_sAlbum = sValue
        Case "TYER": m_sYear = sValue
        Case "COMM": m_sComment = sValue
        Case "TCON": m_sGenre = GenreName(sValue)
        Case "TRCK": m_lTrackNumber = sValue
        Case "TOPE": m_sOriginalArtist = sValue
        Case "TCOP": m_sCopyRight = sValue
        Case "TCOM": m_sComposer = sValue
        Case "USLT": m_sLyrics = sValue
        Case "TPUB": m_sPublisher = sValue
        Case "TDRC": m_sYear = sValue
        Case Else
    End Select

End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: For ID3 version 2.0
'------------------------------------------------------------------------------------------------------------
Private Sub ReadFrameName20(sHeader, sValue)
    On Error Resume Next

    Select Case sHeader
        Case "TT2": m_sTitle = sValue
        Case "TP1": m_sArtist = sValue
        Case "TAL": m_sAlbum = sValue
        Case "TYE": m_sYear = sValue
        Case "COM": m_sComment = sValue
        Case "TRK": m_lTrackNumber = sValue
	Case "TCO": m_sGenre = GenreName(sValue)
        Case "TOA": m_sOriginalArtist = sValue
        Case "WCP": m_sCopyRight = sValue
        Case "TCM": m_sComposer = sValue
        Case "USLT": m_sLyrics = sValue
        Case "TPB": m_sPublisher = sValue
        Case Else
    End Select

End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: Convert binary to string, but read only ascii > 31.
'------------------------------------------------------------------------------------------------------------
Private Function BinToString(Binary)
    On Error Resume Next

    Dim i, s, l

    For i = 1 To LenB(Binary)

        l = AscB(MidB(Binary, i, 1))

        If l > 31 Then s = s & Chr(l)

    Next

    BinToString = s

End Function

'------------------------------------------------------------------------------------------------------------
' Comment: Algorithm is taken from: http://id3lib.sourceforge.net/id3/id3v2com-00.html
'                  The size structure of a frame, or the whole ID3 tag, is stored in 4 bytes.
'------------------------------------------------------------------------------------------------------------
Private Function GetSize(a, b, c, d)
    On Error Resume Next

    GetSize = CLng(AscB(a)) * 2097152 + CLng(AscB(b)) * 16384 + CLng(AscB(c)) * 128 + CLng(AscB(d))

End Function

'------------------------------------------------------------------------------------------------------------
' Comment: Read mp3 file into byte array.
'------------------------------------------------------------------------------------------------------------
Private Function ReadMP3Bytes()
    On Error Resume Next

    Dim oStream

    If IsEmpty(oStream) Then Set oStream = Server.CreateObject("ADODB.Stream")

    With oStream

        If .State = adStateOpen Then .State = adStateClosed
        .Type = adTypeBinary
        .Open
        .LoadFromFile m_sFilePath
        m_arrMP3 = .Read
    End With

    oStream.Close
    Set oStream = Nothing

    m_lMP3Size = LenB(m_arrMP3)

    ReadMP3Bytes = (m_lMP3Size > 0 And Err.Number = 0)

End Function

'------------------------------------------------------------------------------------------------------------
' Comment: To get to the date values we also open the mp3 file with the FileSystemObject.
'------------------------------------------------------------------------------------------------------------
Private Function LoadMP3()
    On Error Resume Next

    Dim oFSO
    Dim oFile

    If IsEmpty(oFSO) Then Set oFSO = Server.CreateObject("Scripting.FileSystemObject")

    If Not oFSO.FileExists(m_sFilePath) Then
        Set oFSO = Nothing
        m_sErrorMessage = "File Not Found: " & m_sFilePath
        Exit Function
    End If

    Set oFile = oFSO.GetFile(m_sFilePath)

    '// Get the date properties
    m_sDateCreated = oFile.DateCreated
    m_sDateLastAccessed = oFile.DateLastAccessed
    m_sDateLastModified = oFile.DateLastModified

    '// Clean up
    Set oFile = Nothing: Set oFSO = Nothing
    
    '// Return a boolean
    LoadMP3 = (Err.Number = 0)

End Function

'------------------------------------------------------------------------------------------------------------
' Comment: Return the genre string from the genre id.
'------------------------------------------------------------------------------------------------------------
Private Function GenreName(sID)
    On Error Resume Next

    Dim i, t, s, g
    Dim sNumbers

    sNumbers = "0123456789"

    For i = 1 To Len(sID)
        t = Mid(sID, i, 1)

        If InStr(sNumbers, t) > 0 Then g = g & t
    Next

    If Len(g) = 0 Then GenreName = sID: Exit Function

    Select Case CInt(g)
        Case 34: s = "Acid"
        Case 74: s = "Acid Jazz"
        Case 73: s = "Acid Punk"
        Case 99: s = "Acoustic"
        Case 40: s = "Alt.Rock"
        Case 20: s = "Alternative"
        Case 26: s = "Ambient"
        Case 145: s = "Anime"
        Case 90: s = "Avant Garde"
        Case 116: s = "Ballad"
        Case 41: s = "Bass"
        Case 135: s = "Beat"
        Case 85: s = "Bebob"
        Case 96: s = "Big Band"
        Case 138: s = "Black Metal"
        Case 89: s = "Blue Grass"
        Case 0: s = "Blues"
        Case 107: s = "Booty Bass"
        Case 132: s = "Brit Pop"
        Case 65: s = "Cabaret"
        Case 88: s = "Celtic"
        Case 104: s = "Chamber Music"
        Case 102: s = "Chanson"
        Case 97: s = "Chorus"
        Case 136: s = "Christian Gangsta Rap"
        Case 61: s = "Christian Rap"
        Case 141: s = "Christian Rock"
        Case 1: s = "Classic Rock"
        Case 32: s = "Classical"
        Case 112: s = "Club"
        Case 128: s = "Club - House"
        Case 57: s = "Comedy"
        Case 140: s = "Contemporary Christian"
        Case 2: s = "Country"
        Case 139: s = "Crossover"
        Case 58: s = "Cult"
        Case 3: s = "Dance"
        Case 125: s = "Dance Hall"
        Case 50: s = "Darkwave"
        Case 22: s = "Death Metal"
        Case 4: s = "Disco"
        Case 55: s = "Dream"
        Case 127: s = "Drum & Bass"
        Case 122: s = "Drum Solo"
        Case 120: s = "Duet"
        Case 98: s = "Easy Listening"
        Case 52: s = "Electronic"
        Case 48: s = "Ethnic"
        Case 54: s = "Eurodance"
        Case 124: s = "Euro - House"
        Case 25: s = "Euro - Techno"
        Case 84: s = "Fast Fusion"
        Case 80: s = "Folk"
        Case 81: s = "Folk / Rock"
        Case 115: s = "Folklore"
        Case 119: s = "Freestyle"
        Case 5: s = "Funk"
        Case 30: s = "Fusion"
        Case 36: s = "Game"
        Case 59: s = "Gangsta Rap"
        Case 126: s = "Goa"
        Case 38: s = "Gospel"
        Case 49: s = "Gothic"
        Case 91: s = "Gothic Rock"
        Case 6: s = "Grunge"
        Case 79: s = "Hard Rock"
        Case 129: s = "Hardcore"
        Case 137: s = "Heavy Metal"
        Case 7: s = "Hip Hop"
        Case 35: s = "House"
        Case 100: s = "Humour"
        Case 131: s = "Indie"
        Case 19: s = "Industrial"
        Case 33: s = "Instrumental"
        Case 46: s = "Instrumental Pop"
        Case 47: s = "Instrumental Rock"
        Case 8: s = "Jazz"
        Case 29: s = "Jazz - Funk"
        Case 146: s = "JPop"
        Case 63: s = "Jungle"
        Case 86: s = "Latin"
        Case 71: s = "Lo - fi"
        Case 45: s = "Meditative"
        Case 142: s = "Merengue"
        Case 9: s = "Metal"
        Case 77: s = "Musical"
        Case 82: s = "National Folk"
        Case 64: s = "Native American"
        Case 133: s = "Negerpunk"
        Case 10: s = "New Age"
        Case 66: s = "New Wave"
        Case 39: s = "Noise"
        Case 11: s = "Oldies"
        Case 103: s = "Opera"
        Case 12: s = "Other"
        Case 75: s = "Polka"
        Case 134: s = "Polsk Punk"
        Case 13: s = "Pop"
        Case 62: s = "Pop / Funk"
        Case 53: s = "Pop / Folk"
        Case 109: s = "Pr0n Groove"
        Case 117: s = "Power Ballad"
        Case 23: s = "Pranks"
        Case 108: s = "Primus"
        Case 92: s = "Progressive Rock"
        Case 67: s = "Psychedelic"
        Case 93: s = "Psychedelic Rock"
        Case 43: s = "Punk"
        Case 121: s = "Punk Rock"
        Case 14: s = "R&B"
        Case 15: s = "Rap"
        Case 68: s = "Rave"
        Case 16: s = "Reggae"
        Case 76: s = "Retro"
        Case 87: s = "Revival"
        Case 118: s = "Rhythmic Soul"
        Case 17: s = "Rock"
        Case 78: s = "Rock 'n'Roll"
        Case 143: s = "Salsa"
        Case 114: s = "Samba"
        Case 110: s = "Satire"
        Case 69: s = "Showtunes"
        Case 21: s = "Ska"
        Case 111: s = "Slow Jam"
        Case 95: s = "Slow Rock"
        Case 105: s = "Sonata"
        Case 42: s = "Soul"
        Case 37: s = "Sound Clip"
        Case 24: s = "Soundtrack"
        Case 56: s = "Southern Rock"
        Case 44: s = "Space"
        Case 101: s = "Speech"
        Case 83: s = "Swing"
        Case 94: s = "Symphonic Rock"
        Case 106: s = "Symphony"
        Case 147: s = "Synth Pop"
        Case 113: s = "Tango"
        Case 18: s = "Techno"
        Case 51: s = "Techno - Industrial"
        Case 130: s = "Terror"
        Case 144: s = "Thrash Metal"
        Case 60: s = "Top 40"
        Case 70: s = "Trailer"
        Case 31: s = "Trance"
        Case 72: s = "Tribal"
        Case 27: s = "Trip Hop"
        Case 28: s = "Vocal"
        Case Else: s = ""
    End Select

    GenreName = s

End Function

'========================================================================
End Class
'========================================================================

%>