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