网站运营优化 » VB » 用MCI命令做一个播放器

用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

  原作:thinkeasy

相关文章

发表留言


点击更换验证码