Attribute VB_Name = "asfInfo"
'****************************************************************************
'人人為我，我為人人
'枕善居收藏整理
'發(fā)布日期：2007/03/15
'描    述：網(wǎng)頁搜索音樂播放器  Ver 1.1.0
'網(wǎng)    站：http://www.Mndsoft.com/  (VB6源碼博客)
'網(wǎng)    站：http://www.VbDnet.com/   (VB.NET源碼博客,主要基于.NET2005)
'e-mail  ：Mndsoft@163.com
'e-mail  ：Mndsoft@126.com
'OICQ    ：88382850
'          如果您有新的好的代碼別忘記給枕善居哦!
'****************************************************************************

'ASF格式的幾個(gè)與音樂信息相關(guān)的對(duì)象
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對(duì)象標(biāo)識(shí)
Private Type GUID
    dwData1 As Long
    wData2 As Integer
    wData3 As Integer
    abData4(7) As Byte
End Type
'音樂類型，我自己定義的，不是標(biāo)準(zhǔn)喲
Private Enum MediaType
    mciMIDI = 1
    mciMP3 = 2
    mciASF = 4
    mciVIDEO = 8
    mciWAVE = 16
End Enum

'ASF對(duì)象標(biāo)識(shí)結(jié)構(gòu)
Private Type ObjHeader
  ID As GUID
  Size(1) As Long
End Type
'ASF文件頭對(duì)象結(jié)構(gòu)
Private Type ASFHeader
    HeaderInfo As ObjHeader
    NumOfHeader As Long
    Reserved1 As Byte
    Reserved2 As Byte
End Type
'ASF內(nèi)容描述結(jié)構(gòu)
Private Type ContentDescription
    TitleLength As Integer
    AuthorLength As Integer
    CopyrightLength As Integer
    DescriptionLength As Integer
    RatingLength As Integer
End Type
'ASF描述標(biāo)簽結(jié)構(gòu)
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 '這里可以取到視頻格式信息，因?yàn)樽约簺]這個(gè)目的，就沒寫了
                            .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