musicinfo.bas

mp3播放器软件

Attribute VB_Name = "musicInfo"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/03/15
'描    述：网页搜索音乐播放器  Ver 1.1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Private Type Mp3ID3V1
    Header As String * 3
    title As String * 30
    Artist As String * 30
    Album As String * 30
    Year As String * 4
    Comment As String * 30
    Genre As String * 1
End Type

'ID3V2是后来出现的，可扩展性很强，写在文件头部，采用标签组格式，分两部分，一是标签组的总头部，一是每个子标签的头部，分别定义如下：

Private Type Mp3ID3V2
    Header As String * 3
    Ver As Byte
    Revision As Byte
    Flag As Byte
    Size(3) As Byte
End Type

Private Type Mp3ID3V2Tag
    Tag As String * 4
    Size(3) As Byte
    Flag(1) As Byte
End Type

'为了组织音乐信息的方便，我还定义了一个自己的结构，以便于使用：

'音乐类型
Private Enum MediaType
    mciMIDI = 1
    mciMP3 = 2
    mciASF = 4
    mciVIDEO = 8
    mciWAVE = 16
End Enum
'装载音乐信息的结构
Public Type musicTag
    FileName As String
    MusicType As MediaType
    title As String
    Artist As String
    Album As String
    Year As String
    Lyrics As String
    Writer As String
    Composer As String
    Bits As String
    Sample As String
    Length As Long
End Type

'取音乐信息
Public Function GetMusicInfo(udtInfo As musicTag) As Boolean
    Dim strFileName As String, a() As String, I As Long
    With udtInfo
        strFileName = Dir(.FileName, vbNormal Or vbHidden Or vbReadOnly Or vbSystem Or vbArchive)
        If strFileName = vbNullString Then Exit Function
        .MusicType = GetMCIType(strFileName)
        If .MusicType And 2 Then
            GetMusicInfo = GetMP3Info(udtInfo)
        ElseIf .MusicType And 4 Then
            GetMusicInfo = GetASFInfo(udtInfo)
        End If
    End With
End Function

Private Function GetMCIType(strFileName As String) As MediaType
    Dim ext As String
    If strFileName <> vbNullString Then
        ext = LCase$(Mid$(strFileName, InStrRev(strFileName, ".")))
        Select Case ext
            Case ".mpg", ".mpeg", ".avi", ".mpe", ".mpa", ".m1v", ".ifo", ".vob"
                GetMCIType = mciVIDEO
            Case ".mp3"
                GetMCIType = mciMP3
            Case ".wav", ".snd", ".aif", ".au", ".aifc", ".aiff"
                GetMCIType = mciWAVE
            Case ".asf", ".wma", ".wm", ".wmd"
                GetMCIType = mciASF
            Case ".wmv"
                GetMCIType = mciASF Or mciVIDEO
            Case ".mid", ".midi", ".rmi"
                GetMCIType = mciMIDI
        End Select
    End If
End Function


Private Function GetMP3Info(udtInfo As musicTag) As Boolean
    Dim FreeNo As Long, n(1) As Byte, b() As Byte, TmpInfo As musicTag
    Dim Power As Long, v As Long, j As Long, Tagh As Mp3ID3V2Tag
    Dim id3 As Mp3ID3V1, s As String, pos As Long, id32 As Mp3ID3V2
    Dim sz As Long, s1 As String
    TmpInfo = udtInfo
    On Error GoTo exitg
    FreeNo = FreeFile
    Open TmpInfo.FileName For Binary As #FreeNo
    With TmpInfo
        pos = LOF(FreeNo) - 127
        If pos > 0 Then
            Get #FreeNo, pos, id3
            If UCase$(id3.Header) = "TAG" Then
                s = Trim$(Replace$(id3.title, vbNullChar, vbNullString))
                If Len(s) > 0 Then
                    s = Replace$(s, "-", vbNullString)
                    s = Replace$(s, "——", vbNullString)
                    s = Replace$(s, ".mp3", vbNullString, , , vbTextCompare)
                    .title = s
                End If
                s = Trim$(Replace$(id3.Artist, vbNullChar, vbNullString))
                If Len(s) > 0 Then
                    .title = Replace$(.title, s, vbNullString)
                    .Artist = s
                End If
                s = Trim$(Replace$(id3.Album, vbNullChar, vbNullString))
                If Len(s) > 0 Then .Album = s
                s = Trim$(Replace$(id3.Year, vbNullChar, vbNullString))
                If Len(s) > 0 Then .Year = s
            End If
        End If
        Get #FreeNo, 1, id32
        If id32.Header = "ID3" Then
            sz = (id32.Size(1) And &H7F) * &H400 + (id32.Size(2) And &H7F) * &H80 + (id32.Size(3) And &H7F)
            pos = sz + 10
            s1 = String(4, vbNullChar)
            Get #FreeNo, , Tagh
            Do While Not (Tagh.Tag = s1 Or Seek(FreeNo) > sz + 10)
                j = Tagh.Size(1) * &H10000 + Tagh.Size(2) * &H100 + Tagh.Size(3)
                If j > 0 Then
                    ReDim b(j - 1)
                    Get #FreeNo, , b
                    s = StrConv(b, vbUnicode)
                    s = Trim$(Replace$(s, vbNullChar, ""))
                    Select Case Tagh.Tag
                    Case "TIT2"
                        .title = s
                    Case "TPE1"
                        .Artist = s
                    Case "TALB"
                        .Album = s
                    Case "TCOM"
                        .Composer = s
                    Case "TEXT"
                        .Writer = s
                    Case "TYER"
                        .Year = s
                    Case "USLT"
                        s = Replace$(s, "  ", " ")
                        If LCase$(Left$(s, 3)) = "chi" Then
                            .Lyrics = Mid$(s, 4)
                        ElseIf LCase$(Left$(s, 3)) = "eng" Then
                            .Lyrics = Mid$(s, 4)
                        Else
                            .Lyrics = s
                        End If
                    End Select
                End If
                Get #FreeNo, , Tagh
            Loop
        Else
            pos = 1
        End If
        Get #FreeNo, pos, n
        sz = pos
        If Not (n(0) = &HFF And n(1) >= &HFA And n(1) <= &HFF) Then
            Do While Not (n(0) = &HFF And n(1) = &HFB)
                pos = pos + 1
                If Seek(FreeNo) - sz > 8192 Then GoTo exitg
                Get #FreeNo, pos, n
            Loop
        End If
        Get #FreeNo, , n
            
        v = 0
        For j = 4 To 7
            Power = 2 ^ j
            If (n(0) And Power) = Power Then v = v + Power
        Next
        v = v \ 16
        .Bits = Trim$(Mid$("144 320 32  48  56  64  80  96  112 128 160 192 224 256 320 ", v * 4 + 1, 4)) & "Kbps"
        v = 0
        For j = 2 To 3
            Power = 2 ^ j
            If (n(0) And Power) = Power Then v = v + Power
        Next
        v = v \ 4
        .Sample = Trim$(Mid$("44 48 32 ?? ", v * 3 + 1, 3)) & "KHz"
    End With
    udtInfo = TmpInfo
    GetMP3Info = True
exitg:
    Close #FreeNo
End Function