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

[1] [2]  下一页