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

无外部控件制作多媒体播放器利用MCI指令制作播放器，简单实用，很适合于做为自己软件的一个附带功能或背景音乐，正是基于这点需求，我准备分几个部分来写：1、MCI指令的简单使用；

2、媒体播放的进度控制与音量调节；

3、音乐信息的读取，包括MP3（ID3V1&ID3V2）与ASF（WMA&WMV）等；

4、音乐列表的建立与保存（M3U格式）本来主要是想写播放音乐的，举个播放视频的例子，没什么别的意思，只是感觉播放音乐实在是简单，没什么可写，同时也是为了说明，MCI放视频也是可以的。PrivateConstWS_CHILD=&H40000000

PrivateDeclareFunctionmciSendStringLib"winmm.dll"Alias"mciSendStringA"(ByVallpstrCommandAsString,ByVallpstrReturnStringAsString,ByValuReturnLengthAsLong,ByValhwndCallbackAsLong)AsLong

PrivateDeclareFunctionGetShortPathNameLib"kernel32"Alias"GetShortPathNameA"(ByVallpszLongPathAsString,ByVallpszShortPathAsString,ByValcchBufferAsLong)AsLong

PrivateDeclareFunctionSetWindowPosLib"user32"(ByValhWndAsLong,ByValhWndInsertAfterAsLong,ByValxAsLong,ByValyAsLong,ByValcxAsLong,ByValcyAsLong,ByValwFlagsAsLong)AsLong

PrivateFunctionShortName(LNameAsString)AsString

'取得短文件名

DimsAsString,iAsLong

i=512

s=Space$(i)

GetShortPathNameLName,s,i

ShortName=Left$(s,InStr(1,s,vbNullChar)-1)

EndFunctionPrivateFunctionPlayMCI(CmdAsString,OptionalReturnStrAsString)AsLong

'播放MCI

DimsAsString

s=Space$(256)

PlayMCI=mciSendString(Cmd,s,256,0)

ReturnStr=Left$(s,InStr(1,s,vbNullChar)-1)

EndFunctionPrivateFunctionShowVideo(strFileNameAsString,hwdAsLong,xAsLong,yAsLong,wAsLong,hAsLong)AsLong

DimiAsLong,sAsString

IfDir(strFileName,vbHiddenOrvbReadOnlyOrvbSystem)=vbNullStringOrstrFileName=vbNullStringThenExitFunction

i=PlayMCI("open"""&ShortName(strFileName)&"""aliasSongparent"&hwd&"style"&WS_CHILD&"WAIT")

Ifi<>0ThenExitFunction

i=PlayMCI("STATUSSongWINDOWHANDLEWAIT",s)

Ifi<>0ThenGoTofail

i=Val(s)

Ifi=0ThenGoTofail

SetWindowPosi,0,x,y,w,h,0

PlayMCI"playSong"

ShowVideo=i

'若成功返回视频窗口的句柄

ExitFunction

fail:

PlayMCI"closeSong"

EndFunctionPrivateSubcmdPlay_Click()

i=ShowVideo("h:\1.wmv",Me.hWnd,0,0,100,100)

Flag(1)AsByte

EndType为了组织音乐信息的方便，我还定义了一个自己的结构，以便于使用：'音乐类型

PrivateEnumMediaType

mciMIDI=1

mciMP3=2

mciASF=4

mciVIDEO=8

mciWAVE=16

EndEnum

'装载音乐信息的结构

PrivateTypeMusicInfo

FileNameAsString

MusicTypeAsMediaType

TitleAsString

ArtistAsString

AlbumAsString

YearAsString

LyricsAsString

WriterAsString

ComposerAsString

BitsAsString

SampleAsString

LengthAsLong

EndType'我习惯于用代码说明问题，所以还是看看代码吧PrivateFunctionGetMusicInfo(udtInfoAsMusicInfo)AsBoolean

DimstrFileNameAsString,a()AsString,iAsLong

WithudtInfo

strFileName=Dir(.FileName,vbNormalOrvbHiddenOrvbReadOnlyOrvbSystemOrvbArchive)

IfstrFileName=vbNullStringThenExitFunction

.MusicType=GetMCIType(strFileName)

If.MusicTypeAndmciMP3Then

GetMusicInfo=GetMP3Info(udtInfo)

ElseIf.MusicTypeAndmciASFThen

GetMusicInfo=GetASFInfo(udtInfo)

EndIf

EndWith

EndFunction

PrivateFunctionGetMCIType(strFileNameAsString)AsMediaType

DimextAsString

IfstrFileName<>vbNullStringThen

ext=LCase$(Mid$(strFileName,InStrRev(strFileName,".")))

SelectCaseext

Case".mpg",".mpeg",".avi",".mpe",".mpa",".m1v",".ifo",".vob"

GetMCIType=mciVIDEO

Case".mp3"

GetMCIType=mciMP3

Case".wav",".snd",".aif",".au",".aifc",".aiff"

GetMCIType=mciWAVE

Case".asf",".wma",".wm",".wmd"

GetMCIType=mciASF

Case".wmv"

GetMCIType=mciASFOrmciVIDEO

Case".mid",".midi",".rmi"

GetMCIType=mciMIDI

EndSelect

EndIf

EndFunction

PrivateFunctionGetMP3Info(udtInfoAsMusicInfo)AsBoolean

DimFreeNoAsLong,n(1)AsByte,b()AsByte,TmpInfoAsMusicInfo

DimPowerAsLong,vAsLong,jAsLong,TaghAsMp3ID3V2Tag

Dimid3AsMp3ID3V1,sAsString,PosAsLong,id32AsMp3ID3V2

DimszAsLong,s1AsString

TmpInfo=udtInfo

OnErrorGoToexitg

FreeNo=FreeFile

OpenTmpInfo.FileNameForBinaryAs#FreeNo

WithTmpInfo

Pos=LOF(FreeNo)-127

IfPos>0Then

Get#FreeNo,Pos,id3

IfUCase$(id3.Header)="TAG"Then

s=Trim$(Replace$(id3.Title,vbNullChar,vbNullString))

IfLen(s)>0Then

s=Replace$(s,"-",vbNullString)

s=Replace$(s,"——",vbNullString)

s=Replace$(s,".mp3",vbNullString,,,vbTextCompare)

.Title=s

EndIf

s=Trim$(Replace$(id3.Artist,vbNullChar,vbNullString))

IfLen(s)>0Then

.Title=Replace$(.Title,s,vbNullString)

.Artist=s

EndIf

s=Trim$(Replace$(id3.Album,vbNullChar,vbNullString))

IfLen(s)>0Then.Album=s

s=Trim$(Replace$(id3.Year,vbNullChar,vbNullString))

IfLen(s)>0Then.Year=s

EndIf

EndIf

Get#FreeNo,1,id32

Ifid32.Header="ID3"Then

sz=(id32.Size(1)And&H7F)*&H400+(id32.Size(2)And&H7F)*&H80+(id32.Size(3)And&H7F)

Pos=sz+10

s1=String(4,vbNullChar)

Get#FreeNo,,Tagh

DoWhileNot(Tagh.Tag=s1OrSeek(FreeNo)>sz+10)

j=Tagh.Size(1)*&H10000+Tagh.Size(2)*&H100+Tagh.Size(3)

Ifj>0Then

ReDimb(j-1)

Get#FreeNo,,b

s=StrConv(b,vbUnicode)

s=Trim$(Replace$(s,vbNullChar,""))

SelectCaseTagh.Tag

Case"TIT2"

.Title=s

Case"TPE1"

.Artist=s

Case"TALB"

.Album=s

Case"TCOM"

.Composer=s

Case"TEXT"

.Writer=s

Case"TYER"

.Year=s

Case"USLT"

s=Replace$(s,"

","")

IfLCase$(Left$(s,3))="chi"Then

.Lyrics=Mid$(s,4)

ElseIfLCase$(Left$(s,3))="eng"Then

.Lyrics=Mid$(s,4)

Else

.Lyrics=s

EndIf

EndSelect

EndIf

Get#FreeNo,,Tagh

Loop

Else

Pos=1

EndIf

Get#FreeNo,Pos,n

sz=Pos

IfNot(n(0)=&HFFAndn(1)>=&HFAAndn(1)<=&HFF)Then

DoWhileNot(n(0)=&HFFAndn(1)=&HFB)

Pos=Pos+1

IfSeek(FreeNo)-sz>8192ThenGoToexitg

Get#FreeNo,Pos,n

Loop

EndIf

Get#FreeNo,,n

v=0

Forj=4To7

Power=2^j

If(n(0)AndPower)=PowerThenv=v+Power

Next

v=v\16

.Bits=Trim$(Mid$("14432032

48

56

64

80

96

112128160192224256320",v*4+1,4))&"Kbps"

v=0

Forj=2To3

Power=2^j

If(n(0)AndPower)=PowerThenv=v+Power

Next

v=v\4

.Sample=Trim$(Mid$("444832??",v*3+1,3))&"KHz"

EndWith

udtInfo=TmpInfo

GetMP3Info=True

exitg:

Close#FreeNo

EndFunctionASF全名为高级系统格式，是MS大力推宠的一种媒体格式，并已得到广泛支持。其最主要的分支就是用于音频的WMA与视频的WMV，当然还有ASF自身。

在下面地址可下载到ASF格式的说明文档：

/windows/windowsmedia/format/asfspec.aspxASF格式由一个个不同功能的ASF对象组成，每个对象都有一个GUID做标识，你只需识别对象后，按对象格式读结构，就能找到你要的信息。

媒体信息内容都在ASF头部对象ASF_Header_Object中，头部对象又包含若干子对象，其中与媒体信息有关的对象也就三个：ASF_Codec_List_Object、ASF_Content_Description_Object、ASF_Extended_Content_Description_Object,本文也就是针对这三个对象的读写。'ASF格式的几个与音乐信息相关的对象

PrivateConstASF_Header_Object="{75B22630-668E-11CF-A6D9-00AA0062CE6C}"

PrivateConstASF_Codec_List_Object="{86D15240-311D-11D0-A3A4-00A0C90348F6}"

PrivateConstASF_Content_Description_Object="{75B22633-668E-11CF-A6D9-00AA0062CE6C}"

PrivateConstASF_Extended_Content_Description_Object="{D2D0A440-E307-11D2-97F0-00A0C95EA850}"

'GUID对象标识

PrivateTypeGUID

dwData1AsLong

wData2AsInteger

wData3AsInteger

abData4(7)AsByte

EndType

'音乐类型，我自己定义的，不是标准哟

PrivateEnumMediaType

mciMIDI=1

mciMP3=2

mciASF=4

mciVIDEO=8

mciWAVE=16

EndEnum

'装载音乐信息的结构

PrivateTypeMusicInfo

FileNameAsString

MusicTypeAsMediaType

TitleAsString

ArtistAsString

AlbumAsString

YearAsString

LyricsAsString

WriterAsString

ComposerAsString

BitsAsString

SampleAsString

LengthAsLong

EndType

'ASF对象标识结构

PrivateTypeObjHeader

IDAsGUID

Size(1)AsLong

EndType

'ASF文件头对象结构

PrivateTypeASFHeader

HeaderInfoAsObjHeader

NumOfHeaderAsLong

Reserved1AsByte

Reserved2AsByte

EndType

'ASF内容描述结构

PrivateTypeContentDescription

TitleLengthAsInteger

AuthorLengthAsInteger

CopyrightLengthAsInteger

DescriptionLengthAsInteger

RatingLengthAsInteger

EndType

'ASF描述标签结构

PrivateTypeDescriptorValue

TypeAsInteger

LengthAsInteger

EndTypePrivateFunctionGetASFInfo(udtInfoAsMusicInfo)AsBoolean

DimasfhAsASFHeader,boAsObjHeader,TmpInfoAsMusicInfo

DimfdAsContentDescription,dvAsDescriptorValue,gdAsGUID

Dima()AsString,b()AsByte,PosAsLong,FreeNoAsInteger,eflAsInteger

DimsAsString,iAsLong,kAsInteger,lAsLong,jAsLong

DimenAsString,vlAsString

OnErrorGoTofail

FreeNo=FreeFile

Pos=1

OpenudtInfo.FileNameForBinaryAs#FreeNo

TmpInfo=udtInfo

WithTmpInfo

Get#FreeNo,Pos,asfh

s=GUIDToStr(asfh.HeaderInfo.ID)

Ifs<>ASF_Header_ObjectThenGoTofail

Pos=Pos+Len(asfh)

Forl=1Toasfh.NumOfHeader

Get#FreeNo,Pos,bo

s=GUIDToStr(bo.ID)

SelectCases

CaseASF_Codec_List_Object

Get#FreeNo,,gd

Get#FreeNo,,i

Forj=1Toi

Get#FreeNo,,dv

ReDimb(dv.Length*2-1)

Get#FreeNo,,b

Get#FreeNo,,efl

ReDimb(efl*2-1)

Get#FreeNo,,b

en=b

en=Trim$(Replace$(en,vbNullChar,""))

Ifdv.Type=2Then

IfInStr(1,en,",")>0Then

a=Split(en,",")

IfInStr(1,a(0),"kbps",vbTextCompare)>0Then

.Bits=Val(a(0))&"Kbps"

EndIf

IfInStr(1,a(1),"khz",vbTextCompare)>0Then

.Sample=Val(a(1))&"KHz"

EndIf

EndIf

ElseIfdv.Type=1Then'这里可以取到视频格式信息，因为自己没这个目的，就没写了

.MusicType=.MusicTypeOrmciVIDEO

EndIf

Get#FreeNo,,efl

ReDimb(efl-1)

Get#FreeNo,,b

Next

CaseASF_Content_Description_Object

Get#FreeNo,,fd

ReDimb(fd.TitleLength-1)

Get#FreeNo,,b

en=b

en=Trim$(Replace$(en,vbNullChar,""))

.Title=en

ReDimb(fd.AuthorLength-1)

Get#FreeNo,,b

en=b

en=Trim$(Replace$(en,vbNullChar,""))

.Artist=en

IfVal(.Year)<1900OrVal(.Year)>2100Then

ReDimb(fd.CopyrightLength-1)

Get#FreeNo,,b

en=b

en=Trim$(Replace$(en,vbNullChar,""))

a=Split(en,"")

Fori=0ToUBound(a)

IfVal(a(i))>0Then

.Year=Val(a(i))

ExitFor

EndIf

Next

EndIf

CaseASF_Extended_Content_Description_Object

Get#FreeNo,,k

Forj=1Tok

Get#FreeNo,,efl

ReDimb(efl-1)

Get#FreeNo,,b

en=b

en=LCase$(Trim$(Replace$(en,vbNullChar,"")))

Get#FreeNo,,dv

SelectCasedv.Type

Case0,1

ReDimb(dv.Length-1)

Get#FreeNo,,b

vl=b

vl=Trim$(Replace$(vl,vbNullChar,""))

SelectCaseen

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)

EndSelect

Case2,3

ReDimb(3)

Get#FreeNo,,b

Case4

ReDimb(7)

Get#FreeNo,,b

Case5

ReDimb(1)

Get#FreeNo,,b

EndSelect

Next

EndSelect

Pos=Pos+bo.Size(0)

Next

EndWith

udtInfo=TmpInfo

GetASFInfo=True

fail:

Close#FreeNo

EndFunctionPrivateSubCommand1_Click()

DimiAsLong,infAsMusicInfo,sAsString

inf.FileName=Text1.Text

IfGetMusicInfo(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="无法取音乐信息"

EndIf

MsgBoxs

EndSub这是一个与上篇相联系的代码，对于一些没定义的函数，可在前面的文章中找到

音乐文件列表也是个不容忽视的问题，自己定个格式当然可以，但好在大家熟悉的M3U格式并不复杂，MediaPlayer或WinAmp都支持它，通用性也好，比起wpl要简易得多，所以我就来介绍一下M3U格式文件的制作与读写M3U是文本文件，以#EXTM3U开头，每个音乐条目占1-2行，当存在扩展信息时，首行采用#EXTINF:开头，第二行才是文件名；当没有扩展信息时，只是简单的一行，就是文件名；文件名可包含路径，也可不包含，不包含时音乐文件应该是与M3U文件在同一目录下。整个格式就这么简单，下面是读取函数，与保存函数，读取时返回的是一个M3U集合，每个集合项目为一首音乐信息的字符串，想获取这个串的具体内容，可用GetM3UInfo函数返回MusicInfo结构。保存函数不太完善，需传入一个M3U集合，因使用集合传递M3U字串信息，每个条目只能添加删除，不能直接修改。若有兴趣，可采取类封装MusicInfo结构，并提供修改功能。PrivateFunctionLoadM3UFile(strFileNameAsString)AsCollection

Dima()AsString,s1AsString,sAsString,iAsLong,FileLine()AsString

DimblnAddOKAsBoolean,strFilePathAsString,colTempAsCollection,LineNumAsLong

OnErrorGoTofail

SetcolTemp=NewCollection

IfDir(strFileName)=vbNullStringThenGoTofail

strFilePath=Left$(strFileName,InStrRev(strFileName,"\"))

OpenstrFileNameForBinaryAs#1

s=Input(LOF(1),1)

Close

Ifs=vbNullStringThenGoTofail

i=InStr(1,s,"#EXTM3U",vbTextCompare)

Ifi=0ThenGoTofail

Ifi>1Thens=Mid$(s,i)

s=Trim$(Replace$(s,vbCrLf&vbCrLf,vbCrLf))

FileLine=Split(s,vbCrLf)

DoWhileLineNum<=UBound(FileLine)

s=Trim$(FileLine(LineNum))

Ifs<>vbNullStringThen

blnAddOK=False

IfUCase$(Left$(s,8))<>"#EXTINF:"Then

IfInStr(1,s,":\")=0Then

s=strFilePath&s

IfDir(s,vbNormalOrvbHiddenOrvbReadOnlyOrvbSystemOrvbArchive)<>vbNullStringThenblnAddOK=True

Else

IfDir(s,vbNormalOrvbHiddenOrvbReadOnlyOrvbSystemOrvbArchive)<>vbNullStringThen

blnAddOK=True

Else

s=strFilePath&Mid$(s,InStrRev(s,"\")+1)

IfDir(s,vbNormalOrvbHiddenOrvbReadOnlyOrvbSystemOrvbArchive)<>vbNullStringThenblnAddOK=True

EndIf

EndIf

IfblnAddOKThen

IfGetMCIType(s)>0Then

colTemp.Adds,s

EndIf

EndIf

Else

s=Mid$(s,9)

LineNum=LineNum+1

s1=Trim$(FileLine(LineNum))

Ifs1<>vbNullStringThen

IfInStr(1,s1,":\")=0Then

s1=strFilePath&s1

IfDir(s1,vbNormalOrvbHiddenOrvbReadOnlyOrvbSystemOrvbArchive)<>vbNullStringThenblnAddOK=True

Else

IfDir(s1,vbNormalOrvbHiddenOrvbReadOnlyOrvbSystemOrvbArchive)<>vbNullStringThen

blnAddOK=True

Else

s1=strFilePath&Mid$(s1,InStrRev(s1,"\")+1)

IfDir(s1,vbNormalOrvbHiddenOrvbReadOnlyOrvbSystemOrvbArchive)<>vbNullStringThenblnAddOK=True

EndIf

EndIf

IfblnAddOKThen

IfGetMCIType(s1)>0Then

colTemp.Adds&vbCrLf&s1,s1

EndIf

EndIf

EndIf

EndIf

EndIf

LineNum=LineNum+1

Loop

fail:

Set