这段代码中，如何控制音乐播放时长？

代码是我们论坛示例中的，如果更换其它音乐时，却无法调节播放时间长度，求帮助，感谢！

目前只重复滴滴滴的声音

'Sound APIs
Private Declare Function apiPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" _
                                      (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

'AVI APIs
Private Declare Function apimciSendString Lib "Winmm.dll" Alias "mciSendStringA" _
                                          (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
                                           ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Declare Function apimciGetErrorString Lib "Winmm.dll" _
                                              Alias "mciGetErrorStringA" (ByVal dwError As Long, _
                                                                          ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

Function fPlayStuff(ByVal strFilename As String, _
                    Optional intPlayMode As Integer) As Long
'MUST pass a filename _with_ extension
'Supports Wav, AVI, MID type files
    Dim lngRet As Long
    Dim strTemp As String

    Select Case LCase(fGetFileExt(strFilename))
    Case "wav":
        If Not IsMissing(intPlayMode) Then
            lngRet = apiPlaySound(strFilename, intPlayMode)
        Else
            MsgBox "Must specify play mode."
            Exit Function
        End If
    Case "avi", "mid":
        strTemp = String$(256, 0)
        lngRet = apimciSendString("play " & strFilename, strTemp, 255, 0)
    End Select
    fPlayStuff = lngRet
End Function
Function fStopStuff(ByVal strFilename As String)
'Stops a multimedia playback
    Dim lngRet As Long
    Dim strTemp As String
    Select Case LCase(fGetFileExt(strFilename))
    Case "Wav":
        lngRet = apiPlaySound(0, pcsASYNC)
    Case "avi", "mid":
        strTemp = String$(256, 0)
        lngRet = apimciSendString("stop " & strFilename, strTemp, 255, 0)
    End Select
    fStopStuff = lngRet
End Function

Private Function fGetFileExt(ByVal strFullPath As String) As String
    Dim intPos As Integer, intLen As Integer
    intLen = Len(strFullPath)
    If intLen Then
        For intPos = intLen To 1 Step -1
            'Find the last \
            If Mid$(strFullPath, intPos, 1) = "." Then
                fGetFileExt = Mid$(strFullPath, intPos + 1)
                Exit Function
            End If
        Next intPos
    End If
End Function

Function fGetError(ByVal lngErrNum As Long) As String
' Translate the error code to a string
    Dim lngx As Long
    Dim strErr As String

    strErr = String$(256, 0)
    lngx = apimciGetErrorString(lngErrNum, strErr, 255)
    strErr = left$(strErr, Len(strErr) - 1)
    fGetError = strErr
End Function
Function fatest()
    Dim a As Long
    a = fPlayStuff("C:\winnt\clock.avi")
    'a = fStopStuff("C:\winnt\clock.avi")
End Function

Private Sub Form_Load()
    Me.TimerInterval = 1000
End Sub

Private Sub Form_Timer()
    Call fPlayStuff(CurrentProject.Path & "\WAV\报警声音.wav", 1)
End Sub

点击下载此附件