Imports System Imports System.IO
Public Class Mp3ReadyID3v2 Private Const sGenreMatrix = "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|Alt. 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 Rap|Top 40|Christian Rap|" + _ "Pop/Punk|Jungle|Native American|Cabaret|New Wave|Phychedelic|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|Blue Grass|" + _ "Avantegarde|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|Rhythmic Soul|Freestyle|Duet|Punk Rock|Drum Solo|A Capella|Euro-House|" + _ "Dance Hall|Goa|Drum & Bass|Club-House|Hardcore|Terror|indie|Brit Pop|Negerpunk|Polsk Punk|" + _ "Beat|Christian Gangsta Rap|Heavy Metal|Black Metal|Crossover|Comteporary Christian|" + _ "Christian Rock|Merengue|Salsa|Trash Metal|Anime|JPop|Synth Pop"
Public Structure ID3v2Info Dim FilePath As String '文件路径 Dim FileName As String '文件名 Dim TRCK As String '音轨（曲号） Dim TIT2 As String '标题 Dim TPE1 As String '歌手 Dim TALB As String '专辑 Dim TYER As String '年代 Dim TCON As String '流派 Dim COMM As String '注释 Dim TCOM As String '作曲 Dim TOPE As String '原创 Dim TCOP As String '版权 Dim WXXX As String 'URL Dim TENC As String '编码 Dim ErrorStr As String '用于记录为什么失败 End Structure
Public Function ReadyID3v2(ByVal FilePath As String, ByRef mp3ID3v2Info As ID3v2Info) As Boolean Try If FilePath = "" Then '如用户指定文件，则退出 mp3ID3v2Info.ErrorStr = "没有指定文件路径！" Beep() ReadyID3v2 = False Exit Function End If If Not (File.Exists(FilePath)) Then '判断文件是否存在 mp3ID3v2Info.ErrorStr = "指定文件不存在！" Beep() ReadyID3v2 = False Exit Function End If Dim TFrameID As New String("", 4) '用于存放帧的标识 Dim TSize(3) As Byte '用于存放帧内容大小数组字节 Dim TFlags(1) As Byte Dim strTemp As String '用于临时变量 字符串 Dim FileNum As Integer '文件指针变量 Dim bytTemp As Byte '用于临时变量 字节 Dim ID3v2HeaderSize(3) As Byte '用于临时变量，存放标签大小的字节数组 Dim intID3v2HeaderSize As Integer '用于临时变量，存放标签大小的整形 mp3ID3v2Info.FilePath = FilePath '完整的文件路径 mp3ID3v2Info.FileName = Path.GetFileNameWithoutExtension(FilePath) '获取文件名，不包括扩展名 FileNum = FreeFile() '获取一个自由文件的指针 FileOpen(FileNum, FilePath, OpenMode.Binary, OpenAccess.Read) '以二进制打开文件 strTemp = Space(3) '用于获取“ID3”标记 FileGet(FileNum, strTemp) '读取文件 If strTemp <> "ID3" Then '判断该文件有没有ID3V2信息，如为ID3V2则有，否则没有 Beep() mp3ID3v2Info.ErrorStr = "此文件没有ID3v2信息！" FileClose() ReadyID3v2 = False Exit Function End If strTemp = Space(1) FileGet(FileNum, strTemp) '获取版本号 strTemp = Space(1) FileGet(FileNum, strTemp) '获取副版本叼 strTemp = Space(1) FileGet(FileNum, strTemp) '获取存放标记的字节 FileGet(FileNum, ID3v2HeaderSize) '获取表示标签大小的字节数组 intID3v2HeaderSize = ByteToLong(ID3v2HeaderSize) '计算出标签的大小 Do While Seek(FileNum) < intID3v2HeaderSize '如文件指针超出标签的位置时，退出文件的读取 FileGet(FileNum, TFrameID) '获取帧的标识（四个字符，如TIT2），您可以见附表有详细的 If Not TFrameID.Substring(0, 1) Like "[A-Z]" Then Exit Do '当没有帧时退出， FileGet(FileNum, TSize) '获取帧内容的大小（字节数组形式），不包括帧头，以便下面更好准确读取帧内容 Dim intSize As Integer = ByteToLong(TSize) '计算出帧内容的大小 FileGet(FileNum, TFlags) '读取存放标志 Dim intTemp As Integer = Seek(FileNum) '临时声明一个整形，用于存放临时文件指针的位置 If TFrameID = "COMM" Then '这里为什么，见ID3V2结构详解 Seek(FileNum, Seek(FileNum) + 5) intSize = intSize - 5 End If strTemp = Space(intSize) FileGet(FileNum, strTemp) '读取帧的内容（如歌手的名称呀“刘德华”） If (Not strTemp = Nothing) AndAlso TFrameID = "WXXX" Then '这里为什么，见ID3V2结构详解 Seek(FileNum, intTemp) Seek(FileNum, Seek(FileNum) + 2) intSize = intSize - 2 strTemp = Space(intSize) FileGet(FileNum, strTemp) End If If (Not strTemp = Nothing) AndAlso strTemp.Length > 0 AndAlso Asc(strTemp.Substring(0, 1)) = 0 Then '这里为什么，见ID3V2结构详解 Seek(FileNum, intTemp) Seek(FileNum, Seek(FileNum) + 1) intSize = intSize - 1 strTemp = Space(intSize) FileGet(FileNum, strTemp) End If Select Case TFrameID Case "TRCK" mp3ID3v2Info.TRCK = strTemp Case "TIT2" mp3ID3v2Info.TIT2 = strTemp Case "TPE1" mp3ID3v2Info.TPE1 = strTemp Case "TALB" mp3ID3v2Info.TALB = strTemp Case "TYER" mp3ID3v2Info.TYER = strTemp Case "TCON" '这里为什么，见ID3V2结构详解 Dim GenreArray() As String GenreArray = Split(sGenreMatrix, "|") If strTemp = Nothing Then Exit Select 'If strTemp.Length <= 0 Then Exit Select Dim strFisrt As String = strTemp.Substring(0, 1) If strFisrt Like "[A-Z]" Or strFisrt Like "[a-z]" Then mp3ID3v2Info.TCON = strTemp Else If strFisrt = "(" Then strTemp = strTemp.Substring(1, InStr(strTemp, ")") - 2) ElseIf Not strFisrt Like "[0-9]" Then strTemp = 12 End If If strTemp < 0 Or strTemp > 147 Then strTemp = 12 mp3ID3v2Info.TCON = GenreArray(strTemp) 'cboTCON.SelectedIndex = strTemp End If
Case "COMM" mp3ID3v2Info.COMM = strTemp Case "TCOM" mp3ID3v2Info.TCOM = strTemp Case "TOPE" mp3ID3v2Info.TOPE = strTemp Case "TCOP" mp3ID3v2Info.TCOP = strTemp Case "WXXX" mp3ID3v2Info.WXXX = strTemp Case "TENC" mp3ID3v2Info.TENC = strTemp End Select Loop FileClose() ReadyID3v2 = True Exit Function Catch ex As Exception FileClose() Beep() mp3ID3v2Info.ErrorStr = ex.Message ReadyID3v2 = False End Try End Function
' Private Enum eBitShiftDir ' eShiftLeft = 1 ' eShiftRight = 2 ' End Enum ' '长整形转换成字节 ' Public Sub LongToByte(ByVal val As Long, ByRef byteArray() As Byte)
' 'GS07312001 - Replaced with the Correct Implementation ' 'Dim byte1 As Byte ' 'Dim byte2 As Byte ' 'Dim byte3 As Byte ' 'Dim byte4 As Byte ' ' ' ' byte1 = val And 127 ' ' val = val / 128 ' ' ' ' byte2 = val And 127 ' ' val = val / 128 ' ' ' ' byte3 = val And 127 ' ' val = val / 128 ' ' ' ' byte4 = val And 127 ' ' ' ' ReDim byteArray(3) ' ' byteArray(0) = byte4 ' ' byteArray(1) = byte3 ' ' byteArray(2) = byte2 ' ' byteArray(3) = byte1
' Dim idx As Integer
' On Error GoTo ErrHandler
' For idx = 0 To 3 ' byteArray(idx) = ShiftBits(val, (3 - idx) * 7, eBitShiftDir.eShiftRight) And 127 ' Next idx
'NormalExit: ' On Error GoTo 0 ' Exit Sub
'ErrHandler: ' 'Raise the error back to the caller ' Err.Raise(Err.Number, "ID3v2Enums::LongToByte", Err.Description)
' End Sub ' Private Function ShiftBits(ByVal lValue As Long, ByVal lNumBitsToShift As Long, ByVal eDir As eBitShiftDir) As Long
' On Error GoTo ErrHandler
' Select Case eDir
' Case eBitShiftDir.eShiftLeft : ShiftBits = lValue * (2 ^ lNumBitsToShift)
' Case eBitShiftDir.eShiftRight : ShiftBits = lValue \ (2 ^ lNumBitsToShift)
' End Select
'NormalExit: ' On Error GoTo 0 ' Exit Function
'ErrHandler: ' Err.Raise(Err.Number, "Shift", Err.Description) ' Resume NormalExit
' End Function
'字节转换成长整形
'
Public Function ByteToLong(ByRef byteArray() As Byte) As Long '把字节数组转换成长整形数据，该函数主要用于计算标签的大小，与帧内容的大小
'GS07312001 - Replaced with a loop ' ByteToLong = byteArray(0) * (2 ^ 21) ' ByteToLong = ByteToLong + byteArray(1) * (2 ^ 14) ' ByteToLong = ByteToLong + byteArray(2) * (2 ^ 7) ' ByteToLong = ByteToLong + byteArray(3) * (2 ^ 0)
Dim idx As Integer
On Error GoTo ErrHandler
ByteToLong = 0 For idx = 0 To 3 ByteToLong = ByteToLong + (byteArray(idx) * (2 ^ ((3 - idx) * 7))) Next idx
NormalExit: On Error GoTo 0 Exit Function
ErrHandler: 'Raise the error back to the caller Err.Raise(Err.Number, "ID3v2Enums::ByteToLong", Err.Description)
End Function End Class
