2013-08-20 12:34

' Qmp3 Component to read mp3 header info, read/write id3 tags v 1.x, |
' Play and Stop. I took inspiration from the "info.bas" file by      |
' grog, and the mp3 example from sm0oth2003 <sm0oth@elitehaven.net>  |
' See help file for details.                                         |
' Thanks to Tamas Szekeres for the binaryheader bugfix               |

'|~~~~~~~~~~~~~~~~~~~~~~~~~~~~|
'|Dreadsoft® Corporation      |
'|(manco un diritto riservato)|
'|http://dreadsoft.too.it     |
'|dreadsoft@yahoo.it          |
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~|

     $TYPECHECK ON
     $IFNDEF __WIN32API				   'windows 32 definitions
      DECLARE FUNCTION mciSendString LIB "winmm.dll" ALIAS "mciSendStringA" _
       (BYVAL lpstrCommand AS STRING, BYVAL lpstrReturnString AS STRING, _
       BYVAL uReturnLength AS LONG, BYVAL hwndCallback AS LONG) AS LONG
     $ENDIF
'________________________________________________________________________
     FUNCTION fitlength (FitTag AS STRING, FitLen AS INTEGER) AS STRING
      IF LEN(fittag) < fitlen THEN
       fittag = fittag + STRING$( fitlen - LEN(fittag), CHR$(0))
      ELSEIF LEN(fittag) > fitlen THEN
       fittag = LEFT$(fittag, fitlen)
      END IF
      result = fittag
     END FUNCTION


     DEFINT mp3x, mp3y, mp3z
     DIM mp3h AS LONG

     TYPE Qmp3 EXTENDS QOBJECT

      filename AS STRING
'-----------------  Tags
      Title AS STRING
      Artist AS STRING
      Album AS STRING
      Year AS STRING
      Comment AS STRING
      Track AS BYTE
      Genre AS STRING
      genreid AS BYTE
'-----------------  Header
      Version AS STRING
      Layer AS STRING
      Protection AS STRING
      Bitrate AS INTEGER
      Frequency AS INTEGER
      Padding AS STRING
      Channels AS STRING
      IntensityStereo AS STRING
      MS_Stereo AS STRING
      Copyright AS STRING
      Original AS STRING
      Emphasis AS STRING
'-----------------  Play/Stop
      ALIAS AS STRING


      genreslist AS QSTRINGLIST
      genrescb AS QCOMBOBOX


      FUNCTION HeaderStart AS INTEGER
       DIM bb AS BYTE
       DIM hs AS QFILESTREAM
       hs.OPEN (mp3.filename, 2)
       hs.position = 0

       mp3x = 0
       DO
        bb = hs.readbyte
        IF bb =  256 THEN
         bb = hs.readbyte
         IF bb > 223 THEN
          hs.CLOSE
          result = mp3x
          EXIT DO
         END IF
        END IF
        INC(mp3x)
       LOOP UNTIL mp3x = 3071
       hs.CLOSE
      END FUNCTION

'----------------------------------------------------------|
'----------------------------------------------------------|

      FUNCTION ReadHeader AS INTEGER
       IF Qmp3.filename = "" THEN
        SHOWMESSAGE "Please, give me a file name"
        EXIT FUNCTION
       END IF

       DIM rb AS BYTE
       DIM tempbin AS STRING
       DIM binaryheader AS STRING

       DIM hr AS QFILESTREAM
       hr.OPEN (mp3.filename, 2)
       hr.position = Qmp3.headerstart
       binaryheader = ""

       FOR mp3x = 1 TO 4
        rb = hr.readbyte
        tempbin = BIN$(rb)
        IF LEN(tempbin) < 8 THEN
         tempbin = STRING$(8 - LEN(tempbin), "0") + tempbin
        END IF
        binaryheader = binaryheader + tempbin
       NEXT

       binaryheader = INSERT$("_", binaryheader, 12)
       binaryheader = INSERT$("_", binaryheader, 15)
       binaryheader = INSERT$("_", binaryheader, 18)
       binaryheader = INSERT$("_", binaryheader, 20)
       binaryheader = INSERT$("_", binaryheader, 25)
       binaryheader = INSERT$("_", binaryheader, 28)
       binaryheader = INSERT$("_", binaryheader, 30)
       binaryheader = INSERT$("_", binaryheader, 32)
       binaryheader = INSERT$("_", binaryheader, 35)
       binaryheader = INSERT$("_", binaryheader, 38)
       binaryheader = INSERT$("_", binaryheader, 40)
       binaryheader = INSERT$("_", binaryheader, 42)
       hr.CLOSE

'_____________________________________________ Mpeg Version
       SELECT CASE FIELD$(binaryheader, "_", 2)
       CASE "00"
        Qmp3.version = "Mpeg 2.5"
       CASE "01"
        Qmp3.version = "???"
       CASE "10"
        Qmp3.version = "Mpeg 2"
       CASE "11"
        Qmp3.version = "Mpeg 1"
       END SELECT

'_____________________________________________ Layer
       SELECT CASE FIELD$(binaryheader, "_", 3)
       CASE "00"
        Qmp3.Layer = "???"
       CASE "01"
        Qmp3.Layer = "III"
       CASE "10"
        Qmp3.Layer = "II"
       CASE "11"
        Qmp3.Layer = "I"
       END SELECT

'_____________________________________________ Protection bit
       SELECT CASE FIELD$(binaryheader, "_", 4)
       CASE "0"
        Qmp3.Protection = "Yes"
       CASE "1"
        Qmp3.Protection = "No"
       END SELECT

'_____________________________________________ Bitrate
       DIM bitseries AS QSTRINGLIST

       IF Qmp3.layer = "I" THEN bitseries.additems _
        "32", "64", "96", "128", "160", "192", "224", "256", _
        "288", "320", "352", "384", "416", "448"

       IF Qmp3.layer = "II" THEN bitseries.additems _
        "32", "48", "56", "64", "80", "96", "112", "128", _
        "160", "192", "224", "256", "320", "320", "384"


       IF Qmp3.layer = "III" OR Qmp3.Layer = "???" THEN
        IF Qmp3.version = "Mpeg 2" THEN
         bitseries.additems _
          "8", "16", "24", "32", "64", "80", "56", "64", "128", _
          "160", "112", "128", "256", "320"
        ELSEIF Qmp3.version = "Mpeg 2.5" THEN
         bitseries.additems _
          "8", "16", "24", "32", "64", "80", "56", "64", "128", _
          "160", "112", "128", "256", "320"
        ELSEIF Qmp3.version = "Mpeg 1" THEN
         bitseries.additems _
          "32", "40", "48", "56", "64", "80", "96", "112", "128", _
          "160", "192", "224", "256", "320"
        ELSEIF Qmp3.version = "???" THEN
         Qmp3.bitrate = 999
        END IF
       END IF



       SELECT CASE FIELD$(binaryheader, "_", 5)
       CASE "0000"
        Qmp3.bitrate = 0
       CASE "0001"
        Qmp3.bitrate = VAL(bitseries.item(0))
       CASE "0010"
        Qmp3.bitrate = VAL(bitseries.item(1))
       CASE "0011"
        Qmp3.bitrate = VAL(bitseries.item(2))
       CASE "0100"
        Qmp3.bitrate = VAL(bitseries.item(3))
       CASE "0101"
        Qmp3.bitrate = VAL(bitseries.item(4))
       CASE "0110"
        Qmp3.bitrate = VAL(bitseries.item(5))
       CASE "0111"
        Qmp3.bitrate = VAL(bitseries.item(6))
       CASE "1000"
        Qmp3.bitrate = VAL(bitseries.item(7))
       CASE "1001"
        Qmp3.bitrate = VAL(bitseries.item(8))
       CASE "1010"
        Qmp3.bitrate = VAL(bitseries.item(9))
       CASE "1011"
        Qmp3.bitrate = VAL(bitseries.item(10))
       CASE "1100"
        Qmp3.bitrate = VAL(bitseries.item(11))
       CASE "1101"
        Qmp3.bitrate = VAL(bitseries.item(12))
       CASE "1110"
        Qmp3.bitrate = VAL(bitseries.item(13))
       CASE "1111"
        Qmp3.bitrate = 999
       END SELECT

       IF Qmp3.Layer = "???" THEN Qmp3.bitrate = 999

'_____________________________________________ Sampling Frequency
       SELECT CASE FIELD$(binaryheader, "_", 6)
       CASE "00"
        IF Qmp3.Version = "Mpeg 1"   THEN Qmp3.Frequency = 44100
        IF Qmp3.Version = "Mpeg 2"   THEN Qmp3.Frequency = 22050
        IF Qmp3.Version = "Mpeg 2.5" THEN Qmp3.Frequency = 11025
       CASE "01"
        IF Qmp3.Version = "Mpeg 1"   THEN Qmp3.Frequency = 48000
        IF Qmp3.Version = "Mpeg 2"   THEN Qmp3.Frequency = 24000
        IF Qmp3.Version = "Mpeg 2.5" THEN Qmp3.Frequency = 12000
       CASE "10"
        IF Qmp3.Version = "Mpeg 1"   THEN Qmp3.Frequency = 32000
        IF Qmp3.Version = "Mpeg 2"   THEN Qmp3.Frequency = 16000
        IF Qmp3.Version = "Mpeg 2.5" THEN Qmp3.Frequency =  8000
       CASE "11"
        Qmp3.frequency = 0
       CASE ELSE
        Qmp3.frequency = 0
       END SELECT
'_____________________________________________ Padding
       SELECT CASE FIELD$(binaryheader, "_", 7)
       CASE "0"
        Qmp3.padding = "No"
       CASE "1"
        Qmp3.padding = "Yes"
       END SELECT

'_____________________________________________ Channels
       SELECT CASE FIELD$(binaryheader, "_", 9)
       CASE "00"
        Qmp3.Channels = "Stereo"
       CASE "01"
        Qmp3.Channels = "Joint Stereo"
       CASE "10"
        Qmp3.Channels = "Dual Channel"
       CASE "11"
        Qmp3.Channels = "Mono"
       END SELECT

'_____________________________________________ Stereo Mode
       SELECT CASE FIELD$(binaryheader, "_", 10)
       CASE "00"
        Qmp3.IntensityStereo = "Off"
        Qmp3.MS_Stereo = "Off"
       CASE "01"
        Qmp3.IntensityStereo = "On"
        Qmp3.MS_Stereo = "Off"
       CASE "10"
        Qmp3.IntensityStereo = "Off"
        Qmp3.MS_Stereo = "On"
       CASE "11"
        Qmp3.IntensityStereo = "On"
        Qmp3.MS_Stereo = "On"
       END SELECT

'_____________________________________________ Copyright
       SELECT CASE FIELD$(binaryheader, "_", 11)
       CASE "0"
        Qmp3.Copyright = "No"
       CASE "1"
        Qmp3.Copyright = "Yes"
       END SELECT

'_____________________________________________ Original
       SELECT CASE FIELD$(binaryheader, "_", 12)
       CASE "0"
        Qmp3.Original = "No"
       CASE "1"
        Qmp3.Original = "Yes"
       END SELECT

'_____________________________________________ Emphasis
       SELECT CASE FIELD$(binaryheader, "_", 13)
       CASE "00"
        Qmp3.Emphasis = "None"
       CASE "01"
        Qmp3.Emphasis = "50/15 ms"
       CASE "10"
        Qmp3.Emphasis = "???"
       CASE "11"
        Qmp3.Emphasis = "CCIT J.17"
       END SELECT
      END FUNCTION


'----------------------------------------------------------|
' Returns 1 if file is already tagged, zero otherwise      |
'----------------------------------------------------------|
      FUNCTION IsTagged(itfs AS QFILESTREAM) AS INTEGER
       DIM tmp3ead AS STRING
       itfs.position = itfs.size - 128
       tmp3ead = itfs.readstr(3)
       tmp3ead = UCASE$(tmp3ead)

       IF LEFT$(tmp3ead, 3) = "TAG" THEN
        result = 1
       ELSE
        result = 0
       END IF
      END FUNCTION
'----------------------------------------------------------|
      SUB SelectGenre
       Qmp3.genreid = Qmp3.genrescb.itemindex
      END SUB
'----------------------------------------------------------|
      CONSTRUCTOR
       genreslist.additems "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", "Alternative 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", "Top", "Christian Rap", _
        "Pop/Funk", "Jungle", "Native US", "Cabaret", "New Wave", "Psychadelic", "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", "Bluegrass", "Avantgarde", "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", _
        "Rhytmic Soul", "Freestyle", "Duet", "Punk Rock", "Drum Solo", "Acapella", "Euro-House", _
        "Dance Hall","Goa", "Drum & Bass", "Club-House", "Hardcore", "Terror", "Indie", _
        "BritPop", "Negerpunk", "Polsk Punk", "Beat", "Christian Gangsta", "Heavy Metal", _
        "Black Metal", "Crossover", "Contemporary C", "Christian Rock", "Merengue", "Salsa", _
        "Thrash Metal", "Anime", "JPop", "SynthPop"

       WITH genrescb
        .style = 2
        .dropdowncount = 20
        .onchange = Qmp3.SelectGenre
       END WITH
      END CONSTRUCTOR
'----------------------------------------------------------|
' Loads genres into genrescb                               |
'----------------------------------------------------------|
      SUB loadlist
       DIM gltc AS INTEGER
       DIM gltcy AS INTEGER
       gltcy = Qmp3.genreslist.itemcount

       gltc = 0
       DO
        Qmp3.genrescb.additems (Qmp3.genreslist.item(gltc))
        INC(gltc)
       LOOP UNTIL gltc = gltcy
      END SUB
'----------------------------------------------------------|
      SUB readtags
       IF Qmp3.filename = "" THEN
        SHOWMESSAGE "Please, give me a file name"
        EXIT SUB
       END IF
       DIM tagstream AS QFILESTREAM
       tagstream.OPEN (Qmp3.filename, 0)
       tagstream.position = tagstream.size - 128 + 3

       IF Qmp3.Istagged(tagstream) = 1 THEN
        WITH Qmp3
         .title = tagstream.readstr(30) - CHR$(0)
         .title = LEFT$(.Title, LEN(Qmp3.Title) - 1)
         .Artist = tagstream.readstr(30) - CHR$(0)
         .Artist = LEFT$(.Artist, LEN(.Artist) - 1)
         .Album = tagstream.readstr(30) - CHR$(0)
         .Album = LEFT$(.Album, LEN(.Album) - 1)
         .year = tagstream.readstr(4) - CHR$(0)
         .year = LEFT$(.year, LEN(.year) - 1)
         .comment = tagstream.readstr(29) - CHR$(0)
         .comment = LEFT$(.comment, LEN(.comment) - 1)
         .track = tagstream.readbyte(1)
         .genreid = tagstream.readbyte(1)
         .genre = .genreslist.item(.genreid)
        END WITH
       ELSE
        SHOWMESSAGE "It seems it isn't a tagged file"
       END IF
       tagstream.CLOSE
      END SUB

      SUB writetags
       IF Qmp3.filename = "" THEN
        SHOWMESSAGE "Please, give me a file name"
        EXIT SUB
       END IF

       DIM wtagstream AS QFILESTREAM
       wtagstream.OPEN (Qmp3.filename, 2)

       IF Qmp3.Istagged(tagstream) = 0 THEN
        wtagstream.position = tagstream.size - 128
        wtagstream.writestr("TAG", 3)
       END IF


       wtagstream.position = wtagstream.size - 128 + 3
       wtagstream.writestr(fitlength (Qmp3.title, 30), 30)
       wtagstream.writestr(fitlength (Qmp3.artist, 30), 30)
       wtagstream.writestr(fitlength (Qmp3.album, 30), 30)
       wtagstream.writestr(fitlength (Qmp3.year, 4), 4)
       wtagstream.writestr(fitlength (Qmp3.comment, 29), 29)
       wtagstream.writebyte(Qmp3.track)
       wtagstream.writebyte(Qmp3.genreid)
       wtagstream.CLOSE
      END SUB

      SUB Stop
       mp3h = MciSendString("Stop " + Qmp3.ALIAS, 0,0, 0)
       mp3h = MciSendString("Close " + Qmp3.ALIAS, 0,0, 0)
      END SUB

      SUB Play
       Qmp3.Stop
       DIM t3s AS STRING
       t3s = Qmp3.filename
       t3s = RIGHT$(t3s, LEN(t3s) - rinstr(t3s, "\"))
       t3s = LEFT$(t3s, LEN(t3s) - 4)
       Qmp3.ALIAS = t3s
       DIM mp3h AS LONG
       mp3h = MciSendString ("Open " + CHR$(34) + Qmp3.filename +  CHR$(34) + _
        " Alias " + Qmp3.ALIAS, 0, 0, 0 )
       mp3h = MciSendstring ("Play " + Qmp3.ALIAS, 0, 0, 0)
      END SUB
     END TYPE

2013-08-20 12:34