*/
Are you blogging on PH? Get your free blog.
*/

View \MP3Tagmodule.bas

MP3 Property Page 1.0

Submitted By: JJProgrammer1
Rating: (Not rated) (Rate It)


Attribute VB_Name = "MP3TagModule"
OPTION Explicit

Public TYPE MP3TagInfo
  mTitle AS STRING * 30
  mArtist AS STRING * 30
  mAlbum AS STRING * 30
  mYear AS STRING * 4
  mComment AS STRING * 30
  mGenre AS STRING * 30
  mEncodedBy AS STRING * 30
END TYPE

'ID3v1 Types
Private TYPE ID3v1Tag
    Identifier(2) AS Byte
    Title(29) AS Byte
    Artist(29) AS Byte
    Album(29) AS Byte
    SongYear(3) AS Byte
    Comment(29) AS Byte
    Genre AS Byte
END TYPE

'ID3v2 Types
Private TYPE ID3v2Header
    Identifier(2) AS Byte
    Version(1) AS Byte
    Flags AS Byte
    Size(3) AS Byte
END TYPE

Private TYPE ID3v2ExtendedHeader
    Size(3) AS Byte
END TYPE

Private TYPE ID3v2FrameHeader
    FrameID(3) AS Byte
    Size(3) AS Byte
    Flags(1) AS Byte
END TYPE
Global MP3Filename AS STRING

Public TYPE VBRinfo
  VBRrate AS STRING
  VBRlength AS STRING
END TYPE

Public TYPE MP3Info
  BITRATE AS STRING
  channels AS STRING
  COPYRIGHT AS STRING
  CRC AS STRING
  EMPHASIS AS STRING
  freq AS STRING
  LAYER AS STRING
  length AS STRING
  MPEG AS STRING
  ORIGINAL AS STRING
  Size AS STRING
END TYPE
Public MyTag AS MP3TagInfo
Public GenreName(1 TO 148) AS STRING
Public GenreNumber(1 TO 148) AS STRING
Global accMP3Info AS MP3Info
Global mp3file AS STRING
Private MP3Length AS LONG

Public SUB GetMP3Info(BYVAL lpMP3File AS STRING, ByRef lpMP3Info AS MP3Info)
  DIM Buf AS STRING * 4096
  DIM infoStr AS STRING * 3
  DIM lpVBRinfo AS VBRinfo
  DIM tmpByte AS Byte
  DIM tmpNum AS Byte
  DIM i AS INTEGER
  DIM designator AS Byte
  DIM baseFreq AS SINGLE
  DIM vbrBytes AS LONG
 
  OPEN lpMP3File FOR BINARY AS #1
    GET #1, 1, Buf
  CLOSE #1
 
  FOR i = 1 TO 4092
    IF ASC(Mid(Buf, i, 1)) = &HFF THEN
      tmpByte = ASC(Mid(Buf, i + 1, 1))
      IF Between(tmpByte, &HF2, &HF7) OR Between(tmpByte, &HFA, &HFF) THEN
        EXIT FOR
      END IF
    END IF
  NEXT i
  IF i = 4093 THEN
   ' MsgBox "Not a MP3 file...", vbCritical, "Error..."
  ELSE
    infoStr = Mid(Buf, i + 1, 3)
    'Getting info from 2nd byte(MPEG,Layer type and CRC)
    tmpByte = ASC(Mid(infoStr, 1, 1))
   
    'Getting CRC info
    IF ((tmpByte MOD 16) MOD 2) = 0 THEN
      lpMP3Info.CRC = "Yes"
    ELSE
      lpMP3Info.CRC = "No"
    END IF
   
    'Getting MPEG type info
    IF Between(tmpByte, &HF2, &HF7) THEN
      lpMP3Info.MPEG = "MPEG 2.0"
      designator = 1
    ELSE
      lpMP3Info.MPEG = "MPEG 1.0"
      designator = 2
    END IF
   
    'Getting layer info
    IF Between(tmpByte, &HF2, &HF3) OR Between(tmpByte, &HFA, &HFB) THEN
      lpMP3Info.LAYER = "layer 3"
    ELSE
      IF Between(tmpByte, &HF4, &HF5) OR Between(tmpByte, &HFC, &HFD) THEN
        lpMP3Info.LAYER = "layer 2"
      ELSE
        lpMP3Info.LAYER = "layer 1"
      END IF
    END IF
   
    'Getting info from 3rd byte(Frequency, Bit-rate)
    tmpByte = ASC(Mid(infoStr, 2, 1))
   
    'Getting frequency info
    IF Between(tmpByte MOD 16, &H0, &H3) THEN
      baseFreq = 22.05
    ELSE
      IF Between(tmpByte MOD 16, &H4, &H7) THEN
        baseFreq = 24
      ELSE
        baseFreq = 16
      END IF
    END IF
    lpMP3Info.freq = baseFreq * designator * 1000 & " Hz"
   
    'Getting Bit-rate
    tmpNum = tmpByte  16 MOD 16
    IF designator = 1 THEN
      IF tmpNum < &H8 THEN
        lpMP3Info.BITRATE = tmpNum * 8
      ELSE
        lpMP3Info.BITRATE = 64 + (tmpNum - 8) * 16
      END IF
    ELSE
      IF tmpNum <= &H5 THEN
        lpMP3Info.BITRATE = (tmpNum + 3) * 8
      ELSE
        IF tmpNum <= &H9 THEN
          lpMP3Info.BITRATE = 64 + (tmpNum - 5) * 16
        ELSE
          IF tmpNum <= &HD THEN
            lpMP3Info.BITRATE = 128 + (tmpNum - 9) * 32
          ELSE
            lpMP3Info.BITRATE = 320
          END IF
        END IF
      END IF
    END IF
    ON ERROR RESUME NEXT
    MP3Length = FileLen(lpMP3File)  (VAL(lpMP3Info.BITRATE) / 8)  1000
    IF Mid(Buf, i + 36, 4) = "Xing" THEN
      vbrBytes = ASC(Mid(Buf, i + 45, 1)) * &H10000
      vbrBytes = vbrBytes + (ASC(Mid(Buf, i + 46, 1)) * &H100&)
      vbrBytes = vbrBytes + ASC(Mid(Buf, i + 47, 1))
      GetVBRrate lpMP3File, vbrBytes, lpVBRinfo
      lpMP3Info.BITRATE = lpVBRinfo.VBRrate
      lpMP3Info.length = lpVBRinfo.VBRlength
    ELSE
      lpMP3Info.BITRATE = lpMP3Info.BITRATE & " Kbps"
      lpMP3Info.length = MP3Length & " seconds"
    END IF
   
    'Getting info from 4th byte(Original, Emphasis, Copyright, Channels)
    tmpByte = ASC(Mid(infoStr, 3, 1))
    tmpNum = tmpByte MOD 16
   
   
    'Getting Copyright bit
    IF tmpNum  8 = 1 THEN
      lpMP3Info.COPYRIGHT = " Yes"
      tmpNum = tmpNum - 8
    ELSE
      lpMP3Info.COPYRIGHT = " No"
    END IF
   
    'Getting Original bit
    IF (tmpNum  4) MOD 2 THEN
      lpMP3Info.ORIGINAL = " Yes"
      tmpNum = tmpNum - 4
    ELSE
      lpMP3Info.ORIGINAL = " No"
    END IF
   
    'Getting Emphasis bit
    SELECT CASE tmpNum
      CASE 0
        lpMP3Info.EMPHASIS = " None"
      CASE 1
        lpMP3Info.EMPHASIS = " 50/15 microsec"
      CASE 2
        lpMP3Info.EMPHASIS = " invalid"
      CASE 3
        lpMP3Info.EMPHASIS = " CITT j. 17"
    END SELECT
   
    'Getting channel info
    tmpNum = (tmpByte  16)  4
    SELECT CASE tmpNum
      CASE 0
        lpMP3Info.channels = " Stereo"
      CASE 1
        lpMP3Info.channels = " Joint Stereo"
      CASE 2
        lpMP3Info.channels = " 2 Channel"
      CASE 3
        lpMP3Info.channels = " Mono"
    END SELECT
  END IF
  lpMP3Info.Size = FileLen(lpMP3File) & " bytes"
END SUB

Private SUB GetVBRrate(BYVAL lpMP3File AS STRING, BYVAL byteRead AS LONG, ByRef lpVBRinfo AS VBRinfo)
  DIM i AS LONG
  DIM ok AS Boolean

  i = 0
  byteRead = byteRead - &H39
  DO
    IF byteRead > 0 THEN
      i = i + 1
      byteRead = byteRead - 38 - Deljivo(i)
    ELSE
      ok = True
    END IF
  LOOP UNTIL ok
  lpVBRinfo.VBRlength = Trim(str(i)) & " seconds"
  lpVBRinfo.VBRrate = Trim(str(INT(8 * FileLen(lpMP3File) / (1000 * i)))) & " Kbit (VBR)"
END SUB

Private FUNCTION Deljivo(BYVAL Num AS LONG) AS Byte
  IF Num MOD 3 = 0 THEN
    Deljivo = 1
  ELSE
    Deljivo = 0
  END IF
END FUNCTION

Public FUNCTION Between(BYVAL accNum AS Byte, BYVAL accDown AS Byte, BYVAL accUp AS Byte) AS Boolean
  IF accNum >= accDown AND accNum <= accUp THEN
    Between = True
  ELSE
    Between = False
  END IF
END FUNCTION



Public FUNCTION ReadID3v1(BYVAL strFile AS STRING, ByRef OutTag AS MP3TagInfo) AS Boolean
    DIM FileNo AS INTEGER, fp AS LONG, i AS INTEGER
    DIM RdTag AS ID3v1Tag
   
    ON LOCAL ERROR GOTO Failed
   
    FileNo = FREEFILE
    OPEN strFile FOR BINARY AS #FileNo
        fp = LOF(FileNo) - 127
        IF fp > 0 THEN
            GET #FileNo, fp, RdTag
            IF GetStringValue(RdTag.Identifier, 3, 0) = "TAG" THEN
                'An ID3v1 tag is present.
                OutTag.mTitle = Trim$(GetStringValue(RdTag.Title, 30, 0))
                OutTag.mArtist = Trim$(GetStringValue(RdTag.Artist, 30, 0))
                OutTag.mAlbum = Trim$(GetStringValue(RdTag.Album, 30, 0))
                OutTag.mYear = Trim$(GetStringValue(RdTag.SongYear, 4, 0))
                OutTag.mComment = Trim$(GetStringValue(RdTag.Comment, 30, 0))
                FOR i = 1 TO 148
                    IF GenreNumber(i) = RdTag.Genre THEN EXIT FOR
                NEXT i
                IF i < 149 THEN
                  OutTag.mGenre = GenreName(i)
                END IF
                        ReadID3v1 = True
                    END IF
                END IF
    CLOSE #FileNo
    EXIT FUNCTION
   
Failed:
    CLOSE #FileNo
    ReadID3v1 = False
END FUNCTION

Public FUNCTION WriteID3v1(BYVAL mp3file AS STRING, ByRef OutTag AS MP3TagInfo) AS Boolean
    DIM MP3Size AS LONG
    DIM locArtist AS STRING * 30
    DIM locTitle AS STRING * 30
    DIM locAlbum AS STRING * 30
    DIM locYear AS STRING * 4
    DIM locComment AS STRING * 30
    DIM locGenre AS STRING * 1
    DIM i AS INTEGER

    ON LOCAL ERROR GOTO Failed
   
    MP3Size = FileLen(mp3file)
  With OutTag
        locTitle = .mTitle
        locArtist = .mArtist
        locAlbum = .mAlbum
        locYear = .mYear
        locComment = .mComment
        FOR i = 1 TO 148
          IF .mGenre = "" THEN EXIT FOR
          IF Trim(.mGenre) = GenreName(i) THEN GOTO TagIt
        NEXT i
        locGenre = CHR$(255)
TagIt:
        IF i < 149 THEN locGenre = CHR$(GenreNumber(i)) ELSE locGenre = CHR$(255)
  END With
  OPEN mp3file FOR BINARY AS #1
    PUT #1, MP3Size + 1 - 128, "TAG" & locTitle & locArtist & locAlbum & locYear & locComment & locGenre
  CLOSE #1

    WriteID3v1 = True
    EXIT FUNCTION
   
Failed:
    CLOSE #1
    WriteID3v1 = False
END FUNCTION

Public FUNCTION ReadID3v2(BYVAL strFile AS STRING, ByRef OutTag AS MP3TagInfo) AS Boolean
    DIM FileNo AS INTEGER, fp AS LONG
    DIM RdHeader AS ID3v2Header, RdExtHeader AS ID3v2ExtendedHeader, RdFrameHeader AS ID3v2FrameHeader
    DIM FrameID AS STRING, FrameSize AS LONG, TextEncoding AS Byte, RdData() AS Byte, RdString AS STRING
    DIM bGotArtist AS Boolean, bGotTitle AS Boolean, bGotAlbum AS Boolean, bGotGenre AS Boolean, bGotEnc AS Boolean
   
    ON LOCAL ERROR GOTO Failed
   
    'Reads the ID3v2 tag of an mp3 file, if there is one.
    FileNo = FREEFILE
    fp = 1
    OPEN strFile FOR BINARY AS #FileNo
        'Read the header.
        GET #FileNo, fp, RdHeader
       
        IF GetStringValue(RdHeader.Identifier, 3, 0) = "ID3" THEN
            fp = LOC(FileNo) + 1
           
            'An ID3v2 tag is present.
            IF GetBit(6, RdHeader.Flags) THEN
                'There is an extended header present. Just read its size to jump over it.
                GET #FileNo, , RdExtHeader
                fp = fp + GetLongValue(RdExtHeader.Size)
            END IF
           
            DO
                GET #FileNo, fp, RdFrameHeader
                FrameID = GetStringValue(RdFrameHeader.FrameID, 4, 0)
                FrameSize = GetLongValue(RdFrameHeader.Size)
                IF NOT FrameSize < 2 THEN
                    IF FrameID = "TPE1" OR FrameID = "TIT2" OR FrameID = "TALB" OR FrameID = "TCON" OR FrameID = "TENC" THEN
                        GET #FileNo, , TextEncoding
                        REDIM RdData(FrameSize - 2)
                        GET #FileNo, , RdData
                        RdString = GetStringValue(RdData, UBOUND(RdData) + 1, TextEncoding)
                        SELECT CASE FrameID
                        CASE "TPE1"
                            'Artist frame.
                            OutTag.mArtist = RdString
                            bGotArtist = True
                        CASE "TIT2"
                            'Title frame.
                            OutTag.mTitle = RdString
                            bGotTitle = True
                        CASE "TALB"
                            'Album frame.
                            OutTag.mAlbum = RdString
                            bGotAlbum = True
                        CASE "TCON"
                            'Genre
                            OutTag.mGenre = RdString
                            bGotGenre = True
                        CASE "TENC"
                            'Encoded By
                            OutTag.mEncodedBy = RdString
                            bGotGenre = True
                        END SELECT
                    END IF
                END IF
                'Seek to the next frame. The value + 10 is the frame header itself.
                fp = fp + 10 + FrameSize
            LOOP WHILE NOT FrameSize = 0 AND NOT fp > 10 + GetLongValue(RdHeader.Size)
            IF bGotArtist OR bGotTitle OR bGotAlbum OR bGotGenre OR bGotEnc THEN ReadID3v2 = True
        END IF
    CLOSE #FileNo
    EXIT FUNCTION
   
Failed:
    CLOSE #FileNo
    ReadID3v2 = False
END FUNCTION

Public FUNCTION WriteID3v2(BYVAL strFile AS STRING, ByRef OutTag AS MP3TagInfo) AS Boolean
    DIM FileNo AS INTEGER, fp AS LONG
    DIM AudioData() AS Byte, AudioSize AS LONG, TagSize AS LONG
    DIM Header AS ID3v2Header, WrHeader AS ID3v2Header
   
    ON LOCAL ERROR GOTO Failed
   
    TagSize = LEN(OutTag.mArtist) + LEN(OutTag.mTitle) + LEN(OutTag.mAlbum) + LEN(OutTag.mGenre) + LEN(OutTag.mEncodedBy)
    IF NOT LEN(OutTag.mArtist) = 0 THEN TagSize = TagSize + 11
    IF NOT LEN(OutTag.mTitle) = 0 THEN TagSize = TagSize + 11
    IF NOT LEN(OutTag.mAlbum) = 0 THEN TagSize = TagSize + 11
    IF NOT LEN(OutTag.mGenre) = 0 THEN TagSize = TagSize + 11
    IF NOT LEN(OutTag.mEncodedBy) = 0 THEN TagSize = TagSize + 11
   
    'Writes the ID3v2 tag of an mp3 file.
    FileNo = FREEFILE
    fp = 1
    OPEN strFile FOR BINARY AS #FileNo
        AudioSize = LOF(FileNo)
        'Check for an existing header.
        GET #FileNo, fp, Header
        IF GetStringValue(Header.Identifier, 3, 0) = "ID3" THEN
            AudioSize = AudioSize - GetLongValue(Header.Size)
        END IF
        'Save the existing audio data.
        REDIM AudioData(AudioSize - 1)
        GET #FileNo, LOF(FileNo) - AudioSize + 1, AudioData
    CLOSE #FileNo
    KILL strFile
    OPEN strFile FOR BINARY AS #FileNo
        'Create the ID3 tag.
        '1) Create the header.
        SetStringValue WrHeader.Identifier, "ID3", 3
        WrHeader.Version(0) = 3
        SetLongValue WrHeader.Size, TagSize
        PUT #FileNo, , WrHeader
        '2) Create the frames.
        WriteFrame FileNo, "TPE1", OutTag.mArtist
        WriteFrame FileNo, "TIT2", OutTag.mTitle
        WriteFrame FileNo, "TALB", OutTag.mAlbum
        WriteFrame FileNo, "TCON", OutTag.mGenre
        WriteFrame FileNo, "TENC", OutTag.mEncodedBy
        '3) Append the audio data.
        PUT #FileNo, , AudioData
    CLOSE #FileNo
   
    WriteID3v2 = True
    EXIT FUNCTION
   
Failed:
    CLOSE #FileNo
    WriteID3v2 = False
END FUNCTION

Private SUB WriteFrame(BYVAL FileNo AS INTEGER, BYVAL strFrameHeader AS STRING, BYVAL strFrameData AS STRING)
    DIM FrameHeader AS ID3v2FrameHeader, EncData AS Byte, FrameData() AS Byte
   
    IF NOT LEN(strFrameData) = 0 THEN
        SetStringValue FrameHeader.FrameID, strFrameHeader, 4
        SetLongValue FrameHeader.Size, LEN(strFrameData) + 1
        PUT #FileNo, , FrameHeader
        REDIM FrameData(LEN(strFrameData) - 1)
        SetStringValue FrameData, strFrameData, LEN(strFrameData)
        PUT #FileNo, , EncData
        PUT #FileNo, , FrameData
    END IF
END SUB

'Synchsafe integers are integers that keep its highest bit (bit 7) zeroed, making seven bits
'out of eight available. Thus a 32 bit synchsafe integer can store 28 bits of information.
Private FUNCTION GetLongValue(ByRef SyncsafeInt() AS Byte) AS LONG
    DIM i AS INTEGER, j AS INTEGER, BitNr AS INTEGER
   
    FOR i = 3 TO 0 STEP -1
        'Loop through the 4 bytes.
        FOR j = 0 TO 6
            'Loop through the 7 significant bits per byte.
            IF GetBit(j, SyncsafeInt(i)) THEN
                GetLongValue = GetLongValue + 2 ^ BitNr
            END IF
            BitNr = BitNr + 1
        NEXT j
    NEXT i
END FUNCTION

Private SUB SetLongValue(ByRef SyncsafeInt() AS Byte, BYVAL Value AS LONG)
    DIM i AS INTEGER, ByteNr AS INTEGER, BitNr AS INTEGER
   
    ByteNr = 3
    FOR i = 0 TO 27
        'Loop through the 28 bits of an synchsafe integer.
        IF Value AND 2 ^ i THEN
            'This bit is set.
            SetBit BitNr, SyncsafeInt(ByteNr), True
        END IF
        BitNr = BitNr + 1
        IF BitNr MOD 7 = 0 THEN
            'The next byte begins.
            ByteNr = ByteNr - 1
            BitNr = 0
        END IF
    NEXT i
END SUB

Private FUNCTION GetStringValue(ByRef StringData() AS Byte, BYVAL StringLength AS INTEGER, BYVAL EncodingFormat AS Byte) AS STRING
    DIM i AS INTEGER
   
    FOR i = 0 TO StringLength - 1
        IF EncodingFormat = 0 OR EncodingFormat = 3 THEN
            'Clear text, null terminated.
            IF StringData(i) = 0 THEN EXIT FUNCTION
            GetStringValue = GetStringValue & CHR$(StringData(i))
        ELSEIF EncodingFormat = 1 THEN
            'UNICODE text with BOM, double-null terminated.
            IF i >= 2 AND i MOD 2 = 0 THEN
                IF StringData(i) = 0 THEN EXIT FUNCTION
                GetStringValue = GetStringValue & CHR$(StringData(i))
            END IF
        ELSEIF EncodingFormat = 2 THEN
            'UNICODE text without BOM, double-null terminated.
            IF i MOD 2 = 0 THEN
                IF StringData(i) = 0 THEN EXIT FUNCTION
                GetStringValue = GetStringValue & CHR$(StringData(i))
            END IF
        END IF
        IF NOT EncodingFormat = 1 OR i >= 2 THEN
        END IF
    NEXT i
END FUNCTION

Private SUB SetStringValue(ByRef StringData() AS Byte, BYVAL Value AS STRING, BYVAL StringLength AS INTEGER)
    DIM i AS INTEGER
   
    FOR i = 0 TO StringLength - 1
        StringData(i) = ASC(MID$(Value, i + 1, 1))
    NEXT i
END SUB

'Bit Nr. 0 is the last bit, bit 7 the first bit.
Private SUB SetBit(BYVAL BitNr AS INTEGER, ByRef SrcData AS Byte, BYVAL BitState AS Boolean)
    DIM Pattern AS Byte
   
    IF BitState THEN
        'set a bit to 1
        Pattern = 2 ^ BitNr
        SrcData = SrcData OR Pattern
    ELSE
        'set a bit to 0
        Pattern = 255 - 2 ^ BitNr
        SrcData = SrcData AND Pattern
    END IF
END SUB

Private FUNCTION GetBit(BYVAL BitNr AS Byte, BYVAL SrcData AS Byte) AS Boolean
    DIM Pattern AS Byte
   
    Pattern = 2 ^ BitNr
    IF SrcData AND Pattern THEN GetBit = True
END FUNCTION

Public SUB GetGenreData()
DIM genrestring$, Genre AS Variant, x AS INTEGER, t AS INTEGER
genrestring$ = "123,A Cappella,34,Acid,74,Acid Jazz,73,Acid Punk,99,Acoustic,20,Alternative Rock,40,Alternative,26,Ambient,145,Anime,90,Avantgarde,116,Ballad,41,Bass,135,Beat,85,Bebob,96,Big Band,138,Black Metal,89,Bluegrass,0,Blues,107,Booty Bass,132,BritPop,65,Cabaret,88,Celtic,104,Chamber Music,102,Chanson,97,Chorus,136,Christian Gangsta Rap,61,Christian Rap,141,Christian Rock,32,Classical,1,Classic Rock,112,Club,128,Club-House,57,Comedy,140,Contemporary Christian,2,Country,139,Crossover,58,Cult,3,Dance,125,Dance Hall,50,Darkwave,22,Death Metal,4,Disco,55,Dream,127,Drum & Bass,122,Drum Solo,120,Duet,98,Easy Listening,52,Electronic,48,Ethnic,54,Eurodance,124,Euro-House,25,Euro-Techno,"
genrestring$ = genrestring$ & "84,Fast-Fusion,80,Folk,115,Folklore,81,Folk/Rock,119,Freestyle,5,Funk,30,Fusion,36,Game,59,Gangsta Rap,126,Goa,38,Gospel,49,Gothic,91,Gothic Rock,6,Grunge,129,Hardcore,79,Hard Rock, 137,Heavy Metal,7,Hip-Hop,35,House,100,Humour,131,Indie,19,Industrial,33,Instrumental,46,Instrumental Pop,47,Instrumental Rock,8,Jazz,29,Jazz+Funk, 146,JPop,63,Jungle,86,Latin,71,Lo-Fi,45,Meditative,142,Merengue,9,Metal,77,Musical,82,National Folk,64,Native American,133,Negerpunk,10,New Age,66,New Wave,39,Noise,11,Oldies,103,Opera,12,Other,75,Polka,134,Polsk Punk,13,Pop,53,Pop-Folk,62,Pop/Funk,109,Porn Groove,117,Power Ballad,23,Pranks,108,Primus,92,Progressive Rock,67,Psychedelic,"
genrestring$ = genrestring$ & "93,Psychedelic Rock,43,Punk,121,Punk Rock,15,Rap,68,Rave,14,R&B,16,Reggae,76,Retro,87,Revival,118,Rhythmic Soul,17,Rock,78,Rock & Roll,143,Salsa,114,Samba,110,Satire,69,Showtunes,21,Ska,111,Slow Jam, 95,Slow Rock,105,Sonata,42,Soul,37,Sound Clip,24,Soundtrack,56,Southern Rock,44,Space,101,Speech,83,Swing,94,Symphonic Rock,106,Symphony,147,Synthpop,113,Tango,18,Techno,51,Techno-Industrial,130,Terror,144,Thrash Metal,60,Top 40,70,Trailer,31,Trance,72,Tribal,27,Trip-Hop,28,Vocal,"
Genre = readin(genrestring$, -1, ",")
FOR x = 1 TO UBOUND(Genre) + 1 STEP 2
   t = t + 1
   GenreNumber(t) = Genre(x - 1)
   GenreName(t) = Genre(x)
NEXT x
END SUB
FUNCTION readin(BYVAL Sourcestring AS STRING, entry AS INTEGER, Optional Delimiter AS STRING = ";") AS Variant
'Reads delimited data from Sourcestring
'syntax: value = Readin(a$,2) - reads 2nd entry in data string a$
'if Entry is < 0 then all data is returned in array
'if Entry is 0 then next data value is read
STATIC x AS INTEGER
DIM item AS STRING, temp AS STRING, t AS INTEGER, z AS INTEGER
DIM RetArray AS Variant
IF entry < 0 THEN
  RetArray = Empty
  IF StrComp(LEFT$(Sourcestring, LEN(Delimiter)), Delimiter, vbBinaryCompare) = 0 THEN  'strip leading delimiter
       Sourcestring = MID$(Sourcestring, LEN(Delimiter) + 1, LEN(Sourcestring))
       
    END IF
    DO                                              ' loop to check for trailing delimiter(s)
     IF StrComp(RIGHT$(Sourcestring, LEN(Delimiter)), Delimiter, vbBinaryCompare) = 0 THEN  ' does the string have trailing delimiter?
        Sourcestring = LEFT$(Sourcestring, LEN(Sourcestring) - LEN(Delimiter))   ' strip trailing delimiter
       
     ELSE: EXIT DO
     END IF
     LOOP
  t = 0
  z = 1
  DO              'get number of entries in t
    x = INSTR(z, Sourcestring, Delimiter)
    IF x = 0 THEN EXIT DO
    t = t + 1
    z = x + 1
  LOOP
  REDIM RetArray(t) 'dim array to t
  t = 0
  z = 1
 
getentry:
  temp = ""
  DO                                'Extract entries
        x = x + 1
        item = MID$(Sourcestring, x, 1)
        IF item = Delimiter OR item = "" THEN EXIT DO
        temp = temp + item
        IF x = LEN(Sourcestring) THEN x = 0: EXIT DO
  LOOP
    RetArray(t) = temp
    x = INSTR(z, Sourcestring, Delimiter)
   
    IF x = 0 THEN GOTO leave
    t = t + 1
    z = x + 1
    GOTO getentry
leave:
    readin = RetArray
EXIT FUNCTION
END IF
IF entry = 1 THEN x = 0   'if entry = 1 then x is reset to 0
t = 0                     'if entry is 0 then x retains current value
z = 1
IF entry > 1 THEN          'if entry is 1 then skip following loop
  DO UNTIL t = entry - 1   'Skip all entries before specified entry
    x = INSTR(z, Sourcestring, Delimiter)
    t = t + 1
    z = x + 1
  LOOP
END IF
Start:
t = t + 1
DO                                'Extract specified entry
  x = x + 1
  item = MID$(Sourcestring, x, 1)
  IF item = Delimiter OR item = "" THEN EXIT DO
  temp = temp + item
  IF x = LEN(Sourcestring) THEN x = 0: EXIT DO
LOOP
IF entry > 0 AND t <> entry THEN
  temp = "": GOTO Start
ELSE: readin = temp
END IF
END FUNCTION
Private FUNCTION ReplaceBadString(BYVAL strData AS STRING) AS STRING
    DIM tmpstr AS STRING
    tmpstr = strData
    'Replace invalid signs.
    tmpstr = Replace(tmpstr, "~", "_", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "?", "'", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "`", "'", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "{", "(", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "[", "(", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "]", ")", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "}", ")", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "?", "?", , , vbTextCompare)
    'Cut out invalid signs.
    tmpstr = Replace(tmpstr, "/", "", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "\", "", , , vbTextCompare)
    tmpstr = Replace(tmpstr, ":", "", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "*", "", , , vbTextCompare)
    tmpstr = Replace(tmpstr, """", "", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "<", "", , , vbTextCompare)
    tmpstr = Replace(tmpstr, ">", "", , , vbTextCompare)
    tmpstr = Replace(tmpstr, "|", "", , , vbTextCompare)
     ReplaceBadString = tmpstr
END FUNCTION
 Private FUNCTION Replace(BYVAL StrOriginal AS STRING, BYVAL StrFind AS STRING, BYVAL StrReplace AS STRING, Optional BYVAL intOPMode AS INTEGER, Optional Updated AS INTEGER, Optional method AS INTEGER = vbTextCompare) AS STRING

  '*******************************************************************************
  '
  ' DESCRIPTION
  '     Replace a string or specific character(s) within a string. This routine
  '     can also be used to strip characters.
  '
  ' ARGUMENTS
  '     StrOriginal    = String to work on.
  '
  '     StrFind     defines string to search for.
 
  '     StrReplace     = New character (or string) to substitute.
  '
  '     intOPMode  = Sets operation by defining the "replace" mode and "compare"
  '                  mode. Valid parameters are:
  '
  '                  BinaryCompare (Case sensitive. Default if not specified.)
  '                  TextCompare (Not case sensitive)
  '                  DataBaseCompare (Microsoft Access data compare)
  '
  '    Updated = Optional. Returns positive if string was modified. Value is number
  '                  of replacements made.
  '
  ' RETURNS
  '     Returns new string.
  '
  ' DEPENDENCIES
  '     None
  '
  ' REMARKS
  '     To strip a string of character(s), set StrReplace to vbNullString or "".
  '
  '*******************************************************************************
 
  ON LOCAL ERROR RESUME NEXT
 
  DIM intOldLen AS INTEGER
  DIM intNewLen AS INTEGER
  DIM intSPos AS LONG
  DIM intN AS INTEGER
 
  intNewLen = LEN(StrReplace)
  intOldLen = LEN(StrFind)
   
  intSPos = 1
 Updated = 0
   
 
    DO
      intSPos = INSTR(intSPos, StrOriginal, StrFind, intOPMode)
      IF intSPos THEN
        StrOriginal = Left(StrOriginal, intSPos - 1) & StrReplace & Mid(StrOriginal, intSPos + intOldLen)
        intSPos = intSPos + intNewLen
       Updated = Updated + 1
      END IF
    LOOP WHILE intSPos
 
  Replace = StrOriginal
 
END FUNCTION
Public FUNCTION GetTagInfo(MP3Filename AS STRING, TmpTag AS MP3TagInfo) AS Boolean
DIM MP3Size AS LONG
 
  IF NOT FileExists(MP3Filename) THEN EXIT FUNCTION
  MP3Size = FileLen(MP3Filename)
  IF ReadID3v1(MP3Filename, TmpTag) THEN GetTagInfo = True
  IF ReadID3v2(MP3Filename, TmpTag) THEN GetTagInfo = True

END FUNCTION
Public FUNCTION FileExists(BYVAL filename AS STRING) AS Boolean
    IF NOT filename > "" THEN
        FileExists = False
        EXIT FUNCTION
    END IF
    ON ERROR RESUME NEXT
    FileExists = Dir$(filename) <> ""
END FUNCTION
 Public FUNCTION GetEncoder(BYVAL filename AS STRING) AS STRING
DIM OUTPUT$, encoder AS STRING
ON ERROR RESUME NEXT
OUTPUT$ = ShellExecuteCapture("EncSpotDOS " & CHR$(34) & filename & CHR$(34))
encoder = MID$(OUTPUT$, INSTR(OUTPUT$, "Encoder") + 21, 30)
GetEncoder = MID$(encoder, 1, INSTR(1, encoder, vbCr))
END FUNCTION

corner