无外部控件制作多媒体播放器（三）

ASF全名为高级系统格式，是MS大力推宠的一种媒体格式，并已得到广泛支持。其最主要的分支就是用于音频的WMA与视频的WMV，当然还有ASF自身。
在下面地址可下载到ASF格式的说明文档：
http://www.microsoft.com/windows/windowsmedia/format/asfspec.aspx

ASF格式由一个个不同功能的ASF对象组成，每个对象都有一个GUID做标识，你只需识别对象后，按对象格式读结构，就能找到你要的信息。
媒体信息内容都在ASF头部对象ASF_Header_Object中，头部对象又包含若干子对象，其中与媒体信息有关的对象也就三个：ASF_Codec_List_Object、ASF_Content_Description_Object、ASF_Extended_Content_Description_Object,本文也就是针对这三个对象的读写。

'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
'装载音乐信息的结构
Private Type MusicInfo
    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
'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

Private Function GetASFInfo(udtInfo As MusicInfo) As Boolean
    Dim asfh As ASFHeader, bo As ObjHeader, TmpInfo As MusicInfo
    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

Private Sub Command1_Click()
    Dim i As Long, inf As MusicInfo, s As String
    inf.FileName = Text1.Text
    If GetMusicInfo(inf) Then
        s = "文件：" & inf.FileName & vbCrLf
        s = s & "歌名：" & inf.Title & vbCrLf
        s = s & "唱片：" & inf.Album & vbCrLf
        s = s & "歌手：" & inf.Artist & vbCrLf
        s = s & "作词：" & inf.Writer & vbCrLf
        s = s & "作曲：" & inf.Composer & vbCrLf
        s = s & "年代：" & inf.Year & vbCrLf
        s = s & "采样：" & inf.Bits & vbCrLf
        s = s & "位率：" & inf.Sample & vbCrLf
        s = s & "歌词：" & inf.Lyrics
    Else
        s = "无法取音乐信息"
    End If
    MsgBox s
End Sub

这是一个与上篇相联系的代码，对于一些没定义的函数，可在前面的文章中找到
http://blog.csdn.net/homezj/archive/2005/04/15/349005.aspx