网页功能: 加入收藏 设为首页 网站搜索  
MCI命令详解
发表日期:2002-09-13作者:李立华[原创] 出处:  

MCI命令详解

'用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

  MciCommand = "open " & RefShortName & " 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

Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

  If Msg = &H202 Then

  MsgBox "OK"

  End If

  WndProc = CallWindowProc(prevWndproc, hwnd, Msg, wParam, lParam)

End Function

'=======================================================

'根据文件名,确定设备

'=======================================================

Public Function GetDriverID(ff As String) As String

  Select Case UCase(Right(ff, 3))

   Case "MID", "RMI", "IDI"

    GetDriverID = "Sequencer"

   Case "WAV"

    GetDriverID = "Waveaudio"

   Case "ASF", "ASX", "IVF", "LSF", "LSX", "P2V", "WAX", "WVX", ".WM", "WMA", "WMX", "WMP"

    GetDriverID = "MPEGVideo2"

   Case ".RM", "RAM", ".RA"

    GetDriverID = "RealPlayer"

   Case Else

    GetDriverID = "MPEGVideo"

   End Select

End Function

'======================================================

'播放文件

'======================================================

Public Function PlayMusic() As Boolean

  Dim RefInt As Long

  PlayMusic = False

  RefInt = mciSendString("play NOWMUSIC", vbNull, 0, 0)

  If RefInt = 0 Then PlayMusic = True

End Function

'======================================================

'获取媒体的长度

'======================================================

Public Function GetMusicLength() As Long

  Dim RefStr As String * 80

  mciSendString "status NOWMUSIC length", RefStr, 80, 0

  GetMusicLength = Val(RefStr)

End Function

'======================================================

'获取当前播放进度

'======================================================

Public Function GetMusicPos() As Long

  Dim RefStr As String * 80

  mciSendString "status NOWMUSIC position", RefStr, 80, 0

  GetMusicPos = Val(RefStr)

End Function

'======================================================

'获取媒体的当前进度

'======================================================

Public Function SetMusicPos(Position As Long) As Boolean

  Dim RefInt As Long

  SetMusicPos = False

  RefInt = mciSendString("seek NOWMUSIC to " & Position, vbNull, 0, 0)

  If RefInt = 0 Then SetMusicPos = True

End Function

'======================================================

'暂停播放

'======================================================

Public Function PauseMusic() As Boolean

  Dim RefInt As Long

  PauseMusic = False

  RefInt = mciSendString("pause NOWMUSIC", vbNull, 0, 0)

  If RefInt = 0 Then PauseMusic = True

End Function

'======================================================

'关闭媒体

'======================================================

Public Function CloseMusic() As Boolean

  Dim RefInt As Long

  CloseMusic = False

  RefInt = mciSendString("close NOWMUSIC", vbNull, 0, 0)

  If RefInt = 0 Then CloseMusic = True

End Function

'======================================================

'设置声道

'======================================================

Public Function SetAudioSource(sAudioSource As AudioSource) As Boolean

  Dim RefInt As Long

  Dim strSource As String

  Select Case sAudioSource

    Case 1: strSource = "left"

    Case 2: strSource = "right"

    Case 0: strSource = "stereo"

  End Select

  SetAudioSource = False

  RefInt = mciSendString("setaudio NOWMUSIC source to " & strSource, vbNull, 0, 0)

  If RefInt = 0 Then SetAudioSource = True

End Function

'======================================================

'全屏播放

'======================================================

Public Function PlayFullScreen() As Boolean

  Dim RefInt As Long

  PlayFullScreen = False

  RefInt = mciSendString("play NOWMUSIC fullscreen", vbNull, 0, 0)

  If RefInt = 0 Then PlayFullScreen = True

End Function

'=====================================================

'设置声音大小

'=====================================================

Public Function SetVolume(Volume As Long) As Boolean

  Dim RefInt As Long

  SetVolume = False

  RefInt = mciSendString("setaudio NOWMUSIC volume to " & Volume, vbNull, 0, 0)

  If RefInt = 0 Then SetVolume = True

End Function

'=====================================================

'设置播放速度

'=====================================================

Public Function SetSpeed(Speed As Long) As Boolean

  Dim RefInt As Long

  SetSpeed = False

  RefInt = mciSendString("set NOWMUSIC speed " & Speed, vbNull, 0, 0)

  If RefInt = 0 Then SetSpeed = True

End Function

'====================================================

'静音True为静音,FALSE为取消静音

'====================================================

Public Function SetAudioOnOff(AudioOff As Boolean) As Boolean

  Dim RefInt As Long

  Dim OnOff As String

  SetAudioOff = False

  If AudioOff Then OnOff = "off" Else OnOff = "on"

  RefInt = mciSendString("setaudio NOWMUSIC " & OnOff, vbNull, 0, 0)

  If RefInt = 0 Then SetAudioOff = True

End Function

'====================================================

'是否有画面True为有,FALSE为取消

'====================================================

Public Function SetWindowShow(WindowOff As Boolean) As Boolean

  Dim RefInt As Long

  Dim OnOff As String

  SetWindowShow = False

  If WindowOff Then OnOff = "show" Else OnOff = "hide"

  RefInt = mciSendString("window NOWMUSIC state " & OnOff, vbNull, 0, 0)

  If RefInt = 0 Then SetWindowShow = True

End Function

'====================================================

'获得当前媒体的状态是不是在播放

'====================================================

Public Function IsPlaying() As Boolean

  Dim sl As String * 255

  mciSendString "status NOWMUSIC mode", sl, Len(sl), 0

  If Left(sl, 7) = "playing" Or Left(sl, 2) = "播放" Then

    IsPlaying = True

  Else

    IsPlaying = False

  End If

End Function

'====================================================

'获得播放窗口的handle

'====================================================

Public Function GetWindowHandle() As Long

  Dim RefStr As String * 160

  mciSendString "status NOWMUSIC window handle", RefStr, 80, 0

  GetWindowHandle = Val(RefStr)

End Function

'====================================================

'获取DeviceID

'====================================================

Public Function GetDeviceID() As Long

  GetDeviceID = mciGetDeviceID("NOWMUSIC")

End Function

 

我来说两句】 【加入收藏】 【返加顶部】 【打印本页】 【关闭窗口
中搜索 MCI命令详解
本类热点文章
  颜色转换函数(RGB、HSB、CMYK、Lab)
  颜色转换函数(RGB、HSB、CMYK、Lab)
  MCI命令详解
  MCI命令详解
  在VB中显示动画鼠标图标
  不装RealPlayer播放RM文件
  不装RealPlayer播放RM文件
  在VB6.0中播放GIF动画
  怎样检查声卡的存在
  用VB实现队列播放MP3
  怎样在VB中播放Flash动画
  制作自己的MP3播放器
最新分类信息我要发布 
最新招聘信息

关于我们 / 合作推广 / 给我留言 / 版权举报 / 意见建议 / 广告投放  
Copyright ©2003-2024 Lihuasoft.net webmaster(at)lihuasoft.net
网站编程QQ群   京ICP备05001064号 页面生成时间:0.00484