无外部控件制作多媒体播放器（三）
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 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
这是一个与上篇相联系的代码，对于一些没定义的函数，可在前面的文章中找到