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