求MP3文件播放的API函数

Question

本人想用API函数做一个MP3播放器，但对这方面的API函数还不甚了解，所以求教！还望大家不吝赐教！谢谢！

Answer 1

api函数sndPlaySound是用来播放音频文件的，但是播放不了mp3文件
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
    (ByVal lpszSoundName As String, ByVal uFlags As Long) As LongPrivate Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Private Const SND_LOOP = &H8
Private Const SND_NOSTOP = &H10Private Sub Form_Load()
'把（）中换成你自己的音频文件地址，可是绝对路径也可以是相对路径。但是放了MP3文件了，想放
'mp3文件用windows自带播放控件就可以了。
 sndPlaySound (App.Path & "\arabmusic.wav"), SND_ASYNC Or SND_NODEFAULT
End Sub

Answer 2

Private Sub playMP3() 
    Dim Str As String 
    Dim res As Long 
    Dim errorMsg As String * 500 
    
    Str = "open " & mediaFileName & " alias mp3 type mpegvideo" 
    res = mciSendString(Str, 0, 0, 0) 
    If res <> 0 Then 
        mciGetErrorString res, errorMsg, 500 
        MsgBox (errorMsg) 
        Exit Sub 
    End If 
    
    Str = "play mp3 from 0" 
    res = mciSendString(Str, 0, 0, 0) 
    If res <> 0 Then 
        mciGetErrorString res, errorMsg, 500 
        MsgBox (errorMsg) 
        Exit Sub 
    End If 
End Sub

Answer 3

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

Answer 4

一、新建一个类，类名为MP3PLAYER，复制以下代码：Option Explicit
'* **************************************************** *
'* 模块名称：MP3PLAYER.cls
'* 模块功能：MP3媒体播放类
'* 作者：lyserver
'* 联系方式：http://blog.csdn.net/lyserver
'* **************************************************** *
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrRetumString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As LongPublic Event Error(ByVal ErrNumber As Long, ByVal ErrDescription As String)
Public Event Progress(ByVal CurrentProgress As Long, ByVal TotalProgress As Long, ByVal ProgressInfo As String)Dim m_Playing As Boolean, m_Error As Boolean
Dim m_FileName As String, m_ShortName As String
Dim m_TotalTime As Long, m_Minutes As Long, m_Second As Long, m_idTimer As Long, m_lTimerProc As LongPrivate Sub Class_Initialize()
    m_lTimerProc = GetClassProcAddr(12)
End SubPrivate Sub Class_Terminate()
    Call CloseFile
End Sub'打开
Public Function OpenFile(ByVal FileName As String) As Boolean
    Dim strBuffer As String
    
    Call CloseFile
    strBuffer = String(255, vbNullChar)
    m_ShortName = GetShortName(FileName)
    ErrorHandler mciSendString("Open  " & m_ShortName, vbNullString, 0, 0)
    ErrorHandler mciSendString("Status " & m_ShortName & " Length", strBuffer, 255, 0)
    If Not m_Error Then
        m_TotalTime = Val(strBuffer)
        m_Minutes = m_TotalTime \ 60000
        m_Second = (m_TotalTime \ 1000) Mod 60
        m_FileName = FileName
        m_Playing = False
        OpenFile = True
    End If
End Function'关闭
Public Function CloseFile() As Boolean
    If Len(m_FileName) = 0 Then Exit Function
    Call Halt
    mciSendString "Close " & m_ShortName, vbNullString, 0, 0
    m_FileName = ""
    m_ShortName = ""
    m_Error = False
    CloseFile = True
End Function'播放
Public Function Play() As Boolean
    If Len(m_FileName) = 0 Then Exit Function
    Call Halt
    ErrorHandler mciSendString("Play " & m_ShortName, vbNullString, 0, 0)
    If Not m_Error Then
        m_idTimer = SetTimer(0, 0, 950, m_lTimerProc)
        m_Playing = True
        Play = True
    End If
End Function'跳转(支持绝对位置和百分比两种方式跳转)
Public Function Jump(ByVal nPosition As Double) As Boolean
    If nPosition < 1 Then nPosition = CLng(nPosition * m_TotalTime) '按百分比跳转
    If nPosition < 0 Or nPosition > m_TotalTime Then Exit Function
    ErrorHandler mciSendString("Play " & m_ShortName & " From " & nPosition, vbNullString, 0, 0)
    Jump = True
End Function'暂停
Public Function Pause() As Boolean
    If m_Playing Then
        ErrorHandler mciSendString("Pause " & m_ShortName, vbNullString, 0, 0)
        KillTimer 0, m_idTimer
    Else
        ErrorHandler mciSendString("Play " & m_ShortName, vbNullString, 0, 0)
        m_idTimer = SetTimer(0, 0, 950, m_lTimerProc)
    End If
    m_Playing = Not m_Playing
    Pause = (Not m_Error)
End Function'停止
Public Function Halt()
    If m_Playing Then
        KillTimer 0, m_idTimer
        mciSendString "Stop " & m_ShortName, vbNullString, 0, 0
    End If
    m_Playing = False
    Halt = (Not m_Error)
End Function'辅助函数，转换长文件名称为短文件名
Private Function GetShortName(ByVal szFileName As String) As String
    Dim strBuffer As String
    
    strBuffer = String(255, vbNullChar)
    GetShortPathName szFileName, strBuffer, 255
    GetShortName = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
End Function'辅助函数，处理错误信息
Private Sub ErrorHandler(ByVal dwError As Long)
    Static ErrNumber As Long
    Dim strError As String
    If dwError <> 0 And dwError <> ErrNumber Then
        strError = String(255, vbNullChar)
        mciGetErrorString dwError, strError, 255
        strError = Left(strError, InStr(strError, vbNullChar) - 1)
        RaiseEvent Error(dwError, strError)
        ErrNumber = m_Error
        m_Error = True
    End If
End Sub'辅助函数，获得类成员函数指针
Private Function GetClassProcAddr(ByVal Index As Long, Optional ParamCount As Long = 4, Optional HasReturnValue As Boolean) As Long
    Static lReturn As Long, pReturn As Long
    Static AsmCode(50) As Byte
    Dim i As Long, pThis As Long, pVtbl As Long, pFunc As Long    pThis = ObjPtr(Me)
    CopyMemory pVtbl, ByVal pThis, 4
    CopyMemory pFunc, ByVal pVtbl + (6 + Index) * 4, 4
    pReturn = VarPtr(lReturn)    For i = 0 To UBound(AsmCode)
        AsmCode(i) = &H90
    Next
    AsmCode(0) = &H55
    AsmCode(1) = &H8B: AsmCode(2) = &HEC
    AsmCode(3) = &H53
    AsmCode(4) = &H56
    AsmCode(5) = &H57
    If HasReturnValue Then
        AsmCode(6) = &HB8
        CopyMemory AsmCode(7), pReturn, 4
        AsmCode(11) = &H50
    End If
    For i = 0 To ParamCount - 1
        AsmCode(12 + i * 3) = &HFF
        AsmCode(13 + i * 3) = &H75
        AsmCode(14 + i * 3) = (ParamCount - i) * 4 + 4
    Next
    i = i * 3 + 12
    AsmCode(i) = &HB9
    CopyMemory AsmCode(i + 1), pThis, 4
    AsmCode(i + 5) = &H51
    AsmCode(i + 6) = &HE8
    CopyMemory AsmCode(i + 7), pFunc - VarPtr(AsmCode(i + 6)) - 5, 4
    If HasReturnValue Then
        AsmCode(i + 11) = &HB8
        CopyMemory AsmCode(i + 12), pReturn, 4
        AsmCode(i + 16) = &H8B
        AsmCode(i + 17) = &H0
    End If
    AsmCode(i + 18) = &H5F
    AsmCode(i + 19) = &H5E
    AsmCode(i + 20) = &H5B
    AsmCode(i + 21) = &H8B: AsmCode(i + 22) = &HE5
    AsmCode(i + 23) = &H5D
    AsmCode(i + 24) = &HC3
    GetClassProcAddr = VarPtr(AsmCode(0))
End Function'辅助函数，返回当前播放进度
Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    Dim strBuffer As String
    Dim TotalTime As Long, Minutes As Long, Second As Long
    
    strBuffer = String(100, vbNullChar)
    mciSendString "Status " & m_ShortName & " Position", strBuffer, 100, 0
    TotalTime = Val(strBuffer)
    Minutes = TotalTime \ 60000
    Second = (TotalTime \ 1000) Mod 60
    RaiseEvent Progress(TotalTime, m_TotalTime, Minutes & "：" & Second & " / " & m_Minutes & "：" & m_Second)
End Sub二、新建一个form，放置三个按钮，分别处理播放、暂停、停止，代码如下：Dim WithEvents m_Player As MP3PLAYERPrivate Sub Command1_Click()
    m_Player.Play
End SubPrivate Sub Command2_Click()
    m_Player.Pause
End SubPrivate Sub Command3_Click()
    m_Player.Halt
End SubPrivate Sub Form_Load()
    Set m_Player = New MP3PLAYER
    m_Player.OpenFile "F:\KuGou\s.h.e - 天亮了.mp3"
End SubPrivate Sub Form_Unload(Cancel As Integer)
    m_Player.CloseFile
    Set m_Player = Nothing
End SubPrivate Sub m_Player_Error(ByVal ErrNumber As Long, ByVal ErrDescription As String)
    Debug.Print ErrNumber, ErrDescription
End SubPrivate Sub m_Player_Progress(ByVal CurrentProgress As Long, ByVal TotalProgress As Long, ByVal ProgressInfo As String)
    Debug.Print CurrentProgress, TotalProgress, ProgressInfo
End Sub

Answer 5

ｌｓ　的　GetClassProcAddr 看来更完备一些
ｌｓ　把那个内嵌函数写成ｌｏｎｇ型数据，这样看起来函数能更精简和效率更高些
Private Function GetClassProcAddress(ByVal SinceCount As Long, ByVal ParamsCount As Long) As Long
Dim mePtr As Long
Dim jmpAddress As Long
mePtr = ObjPtr(Me)
CopyMemory jmpAddress, ByVal mePtr, 4
CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4
'CopyMemory jmpAddress, ByVal i + 1, 4        '这两句能把类中真正的函数地址找出来
'jmpAddress = i + jmpAddress + 5ReDim LinkProc(8)
LinkProc(0) = &H83EC8B55: LinkProc(1) = &HFC8BFFEC: LinkProc(2) = &H3308758D: LinkProc(3) = &HFCFFB1C9
LinkProc(4) = &HFF68A5F3: LinkProc(5) = &HB8FFFFFF: LinkProc(6) = &HFFFFFFFF: LinkProc(7) = &HC2C9D0FF: LinkProc(8) = &HFFCopyMemory ByVal VarPtr(LinkProc(1)) + 1, ParamsCount * 4, 1
CopyMemory ByVal VarPtr(LinkProc(3)) + 2, ParamsCount, 1
CopyMemory ByVal VarPtr(LinkProc(4)) + 3, mePtr
CopyMemory ByVal VarPtr(LinkProc(6)), jmpAddress
If ParamsCount = 0 Then CopyMemory ByVal (VarPtr(LinkProc(7)) + 3), &HC3, 1
LinkProc(8) = ParamsCount * 4
GetClassProcAddress = VarPtr(LinkProc(0))
End Function

Answer 6

PctGL你好!
楼主注意一下，刚才复制代码时，把以前有问题的那个复制上来了，你把最后一个函数修改如下就可以了：'辅助函数，返回当前播放进度
Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    Dim strBuffer As String
    Dim TotalTime As Long, Minutes As Long, Second As Long
    
    strBuffer = String(100, vbNullChar)
    mciSendString "Status " & m_ShortName & " Position", strBuffer, 100, 0
    TotalTime = Val(strBuffer)
    If TotalTime = m_TotalTime Then
        Call Halt
    Else
        Minutes = TotalTime \ 60000
        Second = (TotalTime \ 1000) Mod 60
        RaiseEvent Progress(TotalTime, m_TotalTime, Minutes & "：" & Second & " / " & m_Minutes & "：" & m_Second)
    End If
End Sub

Answer 7

或者修改如下：'辅助函数，返回当前播放进度
Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    Dim strBuffer As String
    Dim TotalTime As Long, Minutes As Long, Second As Long
    
    strBuffer = String(100, vbNullChar)
    mciSendString "Status " & m_ShortName & " Position", strBuffer, 100, 0
    TotalTime = Val(strBuffer)
    Minutes = TotalTime \ 60000
    Second = (TotalTime \ 1000) Mod 60
    RaiseEvent Progress(TotalTime, m_TotalTime, Minutes & "：" & Second & " / " & m_Minutes & "：" & m_Second)
    If TotalTime = m_TotalTime Then Call Halt
End Sub

Answer 8

lyserver！你简直要成我的偶像了。
拜谢！