'用MCI命令来实现多媒体的播放功能
　　'下面的内容几乎有播放器软件的各种功能，你只是引用这些函数就能做出一个播放器来
　　'
　　Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
　　Public Declare Function mciGetDeviceID Lib "winmm.dll" Alias "mciGetDeviceIDA" (ByVal lpstrName As String) As Long
　　Public Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
　　Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
　　Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
　　Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
　　Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
　　Enum PlayTypeName
　　File = 1
　　CDAudio = 2
　　VCD = 3
　　RealPlay = 4
　　End Enum
　　Dim PlayType As PlayTypeName
　　Enum AudioSource
　　AudioStereo = 0 ' "stereo"
　　AudioLeft = 1 '"left"
　　AudioRight = 2 '"right"
　　End Enum
　　Dim hWndMusic As Long
　　Dim prevWndproc As Long
　　'=======================================================
　　'打开MCI设备，urlStr为网址,传值代表成功与否
　　'=======================================================
　　Public Function OpenURL(urlStr As String, Optional hwnd As Long) As Boolean
　　OpenMusic = False
　　Dim MciCommand As String
　　Dim DriverID As String
　　CloseMusic
　　'MCI命令
　　DriverID = GetDriverID(urlStr)
　　If DriverID = "RealPlayer" Then
　　PlayType = RealPlay
　　Exit Function
　　End If
　　MciCommand = "open " & urlStr & " type " & DriverID & " alias NOWMUSIC"
　　If DriverID = "AVIVideo" Or DriverID = "MPEGVideo" Or DriverID = "MPEGVideo2" Then
　　If hwnd <> 0 Then
　　MciCommand = MciCommand + " parent " & hwnd & " style child"
　　hWndMusic = GetWindowHandle
　　prevWndproc = GetWindowLong(hWndMusic, -4)
　　SetWindowLong hWndMusic, -4, AddressOf WndProc
　　Else
　　MciCommand = MciCommand + " style overlapped "
　　End If
　　End If
　　RefInt = mciSendString(MciCommand, vbNull, 0, 0)
　　mciSendString "set NOWMUSIC time format milliseconds", vbNullString, 0, 0
　　If RefInt = 0 Then OpenMusic = True
　　End Function
　　'=======================================================
　　'打开MCI设备，FILENAME为文件名,传值代表成功与否
　　'=======================================================
　　Public Function OpenMusic(FileName As String, Optional hwnd As Long) As Boolean
　　OpenMusic = False
　　Dim ShortPathName As String * 255
　　Dim RefShortName As String
　　Dim RefInt As Long
　　Dim MciCommand As String
　　Dim DriverID As String
　　CloseMusic
　　'获取短文件名
　　GetShortPathName FileName, ShortPathName, 255
　　RefShortName = Left(ShortPathName, InStr(1, ShortPathName, Chr(0)) - 1)
　　'MCI命令
　　DriverID = GetDriverID(RefShortName)
　　If DriverID = "RealPlayer" Then
　　PlayType = RealPlay
　　Exit Function
　　End If