asfinfo.bas

mp3播放器软件

Attribute VB_Name = "asfInfo"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：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
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

'ASF格式的几个与音乐信息相关的对象
Private Const ASF_Header_Object = "{75B22630-668E-11CF-A6D9-00AA0062CE6C}"
Private Const ASF_Codec_List_Object = "{86D15240-311D-11D0-A3A4-00A0C90348F6}"
Private Const ASF_Content_Description_Object = "{75B22633-668E-11CF-A6D9-00AA0062CE6C}"
Private Const ASF_Extended_Content_Description_Object = "{D2D0A440-E307-11D2-97F0-00A0C95EA850}"
'GUID对象标识
Private Type GUID
    dwData1 As Long
    wData2 As Integer
    wData3 As Integer
    abData4(7) As Byte
End Type
'音乐类型，我自己定义的，不是标准哟
Private Enum MediaType
    mciMIDI = 1
    mciMP3 = 2
    mciASF = 4
    mciVIDEO = 8
    mciWAVE = 16
End Enum

'ASF对象标识结构
Private Type ObjHeader
  ID As GUID
  Size(1) As Long
End Type
'ASF文件头对象结构
Private Type ASFHeader
    HeaderInfo As ObjHeader
    NumOfHeader As Long
    Reserved1 As Byte
    Reserved2 As Byte
End Type
'ASF内容描述结构
Private Type ContentDescription
    TitleLength As Integer
    AuthorLength As Integer
    CopyrightLength As Integer
    DescriptionLength As Integer
    RatingLength As Integer
End Type
'ASF描述标签结构
Private Type DescriptorValue
    Type As Integer
    Length As Integer
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function StringFromCLSID Lib "ole32" (pclsid As GUID, lpsz As Long) As Long
Private Function GUIDToStr(ID As GUID) As String
    Dim s As String, I As Long, j As Long
    s = Space(38)
    j = StringFromCLSID(ID, I)
    If j = 0 Then
        CopyMemory ByVal StrPtr(s), ByVal I, 76
        GUIDToStr = s
    End If
End Function
Public Function GetASFInfo(udtInfo As musicTag) As Boolean
    Dim asfh As ASFHeader, bo As ObjHeader, TmpInfo As musicTag
    Dim fd As ContentDescription, dv As DescriptorValue, gd As GUID
    Dim a() As String, b() As Byte, pos As Long, FreeNo As Integer, efl As Integer
    Dim s As String, I As Long, k As Integer, l As Long, j As Long
    Dim en As String, vl As String
    
    On Error GoTo fail
    FreeNo = FreeFile
    pos = 1
    Open udtInfo.FileName For Binary As #FreeNo
    TmpInfo = udtInfo
    With TmpInfo
        Get #FreeNo, pos, asfh
        s = GUIDToStr(asfh.HeaderInfo.ID)
        If s <> ASF_Header_Object Then GoTo fail
        pos = pos + Len(asfh)
        For l = 1 To asfh.NumOfHeader
            Get #FreeNo, pos, bo
            s = GUIDToStr(bo.ID)
            Select Case s
                Case ASF_Codec_List_Object
                    Get #FreeNo, , gd
                    Get #FreeNo, , I
                    For j = 1 To I
                        Get #FreeNo, , dv
                        ReDim b(dv.Length * 2 - 1)
                        Get #FreeNo, , b
                        Get #FreeNo, , efl
                        ReDim b(efl * 2 - 1)
                        Get #FreeNo, , b
                        en = b
                        en = Trim$(Replace$(en, vbNullChar, ""))
                        If dv.Type = 2 Then
                            If InStr(1, en, ",") > 0 Then
                                a = Split(en, ",")
                                If InStr(1, a(0), "kbps", vbTextCompare) > 0 Then
                                    .Bits = Val(a(0)) & "Kbps"
                                End If
                                If InStr(1, a(1), "khz", vbTextCompare) > 0 Then
                                    .Sample = Val(a(1)) & "KHz"
                                End If
                            End If
                        ElseIf dv.Type = 1 Then '这里可以取到视频格式信息，因为自己没这个目的，就没写了
                            .MusicType = .MusicType Or mciVIDEO
                        End If
                        Get #FreeNo, , efl
                        ReDim b(efl - 1)
                        Get #FreeNo, , b
                    Next
                Case ASF_Content_Description_Object
                    Get #FreeNo, , fd
                    ReDim b(fd.TitleLength - 1)
                    Get #FreeNo, , b
                    en = b
                    en = Trim$(Replace$(en, vbNullChar, ""))
                    .title = en
                    ReDim b(fd.AuthorLength - 1)
                    Get #FreeNo, , b
                    en = b
                    en = Trim$(Replace$(en, vbNullChar, ""))
                    .Artist = en
                    If Val(.Year) < 1900 Or Val(.Year) > 2100 Then
                        ReDim b(fd.CopyrightLength - 1)
                        Get #FreeNo, , b
                        en = b
                        en = Trim$(Replace$(en, vbNullChar, ""))
                        a = Split(en, " ")
                        For I = 0 To UBound(a)
                            If Val(a(I)) > 0 Then
                                .Year = Val(a(I))
                                Exit For
                            End If
                        Next
                    End If
                Case ASF_Extended_Content_Description_Object
                    Get #FreeNo, , k
                    For j = 1 To k
                        Get #FreeNo, , efl
                        ReDim b(efl - 1)
                        Get #FreeNo, , b
                        en = b
                        en = LCase$(Trim$(Replace$(en, vbNullChar, "")))
                        Get #FreeNo, , dv
                        Select Case dv.Type
                            Case 0, 1
                                ReDim b(dv.Length - 1)
                                Get #FreeNo, , b
                                vl = b
                                vl = Trim$(Replace$(vl, vbNullChar, ""))
                                Select Case en
                                    Case "title"
                                        .title = vl
                                    Case "author"
                                        If .Artist = "" Then .Artist = vl
                                    Case "wm/albumartist"
                                        .Artist = vl
                                    Case "wm/writer"
                                        .Writer = vl
                                    Case "wm/composer"
                                        .Composer = vl
                                    Case "wm/albumtitle"
                                        .Album = vl
                                    Case "wm/lyrics"
                                        .Lyrics = Replace$(vl, "  ", " ")
                                    Case "wm/originalreleaseyear"
                                        If .Year = "" Then .Year = Val(vl)
                                    Case "wm/year"
                                        .Year = Val(vl)
                                End Select
                            Case 2, 3
                                ReDim b(3)
                                Get #FreeNo, , b
                            Case 4
                                ReDim b(7)
                                Get #FreeNo, , b
                            Case 5
                                ReDim b(1)
                                Get #FreeNo, , b
                        End Select
                    Next
            End Select
            pos = pos + bo.Size(0)
        Next
    End With
    udtInfo = TmpInfo
    GetASFInfo = True
fail:
    Close #FreeNo
End Function