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