怎样得到一个Wav文件的播放的时间

[xxfly]

怎样得到一个Wav文件的播放的时间

[griefforyou]

我的一个模块
Option Explicit
Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
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 mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" (ByVal wDeviceID As Long, ByVal uMessage As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Any) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Public Declare Function auxSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Public Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Declare Function GetWindowWord Lib "User32.dll" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Integer
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long


Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
Public Const GWW_HINSTANCE = (-6)

Public Type BrowseInfo

hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long

End Type

Public Const WM_MOUSEMOVE = &H200
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const MAX_TOOLTIP As Integer = 64

Type NOTIFYICONDATA

cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP

End Type

Public nfIconData As NOTIFYICONDATA

Public CurrentNum As Integer
Public FileName As String
Public ShortFileName As String
Public Opened As Boolean
Public Cancel As Boolean
Public ManStop As Boolean
Public MouseOut As Boolean
Public CurrentVolume As Integer
Public CurrentPosition As Long
Public TotalLength As Long
Public path As String
Public RandomPlay As Boolean
Public RepeatPlay As Boolean
Public FileListShow As Boolean
Public NoMoveCount As Long
Public Restart As Boolean
Public FormListLoaded As Boolean

Public Function BrowseForFolder(hWndOwner As Long, sPrompt As String) As String
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
With udtBI
.hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If
BrowseForFolder = sPath
End Function

Public Sub AddToList()
Dim FilesName() As String
Dim i As Integer
With frmFileList
If FileName <> "" Then
FilesName = Split(FileName, Chr(0))
If UBound(FilesName) > 0 Then
For i = 1 To UBound(FilesName())
.List1.AddItem FilesName(0) & "\" & FilesName(i)
Next
Else
.List1.AddItem FilesName(0)
End If
End If
End With
End Sub

[griefforyou]

Public Sub PlayNext(Optional Flag As Boolean = False)
On Error Resume Next
Dim num As Integer
Dim index As Integer
Randomize Timer

If RandomPlay = False Or Flag = True Then
If frmFileList.List1.ListCount > 0 And CurrentNum <= frmFileList.List1.ListCount Then
CurrentNum = CurrentNum + 1
If frmFileList.List1.List(CurrentNum) = "" Then CurrentNum = 0
play (frmFileList.List1.List(CurrentNum))
End If
Else
num = Fix(Rnd * frmFileList.List1.ListCount)
CurrentNum = num
play (frmFileList.List1.List(CurrentNum))
End If
frmMain.Label1.Caption = GetFileNameNoPath(frmFileList.List1.List(CurrentNum))
For index = 0 To frmFileList.List1.ListCount - 1
frmFileList.List1.Selected(index) = False
Next
frmFileList.List1.Selected(CurrentNum) = True
Opened = True
End Sub

Public Sub play(FileName As String)
Dim Cb As Long
Dim PlayStatus As String * 20
Dim ShortFileName As String
mciExecute "close all"
If Dir(FileName) = "" Then
MsgBox "文件" & FileName & "不存在!", vbInformation, "提示"
frmFileList.List1.RemoveItem frmFileList.List1.ListIndex
ManStop = False
Call PlayNext
Exit Sub
End If
ShortFileName = shortname(FileName)
mciExecute "open " & ShortFileName & " alias mp3"
mciSendString "status mp3 length", PlayStatus, Len(PlayStatus), Cb
TotalLength = Val(Left(PlayStatus, 9))
Call ShowTime(frmMain.Label3, TotalLength)
Call SetVolumeTo(CurrentVolume)
mciExecute "play mp3"
frmMain.Label1.Caption = GetFileNameNoPath(FileName)
frmMain.Caption = "MyMp3-" & GetFileNameNoPath(FileName)
Opened = True
End Sub

Public Sub ShowTime(Object As Control, Length As Long)
Dim Min, Sec As Integer
Min = Fix(Length / 60000)
Object.Caption = ""
If Min < 10 Then
Object.Caption = "0" & Min
Else
Object.Caption = Min
End If
Sec = Fix((Length Mod 60000) / 1000)
Object.Caption = Object.Caption & ":"
If Sec < 10 Then
Object.Caption = Object.Caption & "0" & Sec
Else
Object.Caption = Object.Caption & Sec
End If
End Sub

Public Function GetCurrentVolume()
Dim Cb As Long
Dim PlayStatus As String * 20
mciSendString "status mp3 volume", PlayStatus, Len(PlayStatus), Cb
GetCurrentVolume = Val(Left(PlayStatus, 4))
End Function

Public Sub SetVolumeTo(newVolume As Integer, Optional channel As String = " ")
Dim Buffer As String * 32
mciSendString "setaudio mp3" & channel & "volume to " & newVolume, Buffer, 32, 0
End Sub

Public Sub SeekToPosition(newPosition As Long)
Dim Buffer As String * 32
mciSendString "seek mp3 to " & newPosition, Buffer, 32, 0
mciSendString "play mp3", Buffer, 32, 0
End Sub

Public Function GetFileNameNoPath(sFullPathFileName As String) As String
Dim pos As Integer
Dim DifFilename As String
If sFullPathFileName = "" Then Exit Function
DifFilename = StrReverse(sFullPathFileName)
pos = InStr(1, DifFilename, "\")
If pos <> -1 Then
GetFileNameNoPath = Right(sFullPathFileName, pos - 1)
Else
GetFileNameNoPath = sFullPathFileName
End If
End Function

Function shortname(LongPath As String) As String
Dim ShortPath As String
Dim pos As String
Const MAX_PATH = 260
Dim Ret&
ShortPath = Space$(MAX_PATH)
Ret& = GetShortPathName(LongPath, ShortPath, MAX_PATH)
If Ret& Then
pos = InStr(1, ShortPath, " ")
shortname = Left$(ShortPath, pos - 2)
End If
End Function

[griefforyou]

这里处理时间

Public Sub play(FileName As String)
Dim Cb As Long
Dim PlayStatus As String * 20
Dim ShortFileName As String
mciExecute "close all"
If Dir(FileName) = "" Then
MsgBox "文件" & FileName & "不存在!", vbInformation, "提示"
frmFileList.List1.RemoveItem frmFileList.List1.ListIndex
ManStop = False
Call PlayNext
Exit Sub
End If
ShortFileName = shortname(FileName)
mciExecute "open " & ShortFileName & " alias mp3"
'得到时间长度
mciSendString "status mp3 length", PlayStatus, Len(PlayStatus), Cb
TotalLength = Val(Left(PlayStatus, 9))
'显示时间
Call ShowTime(frmMain.Label3, TotalLength)
Call SetVolumeTo(CurrentVolume)
mciExecute "play mp3"
frmMain.Label1.Caption = GetFileNameNoPath(FileName)
frmMain.Caption = "MyMp3-" & GetFileNameNoPath(FileName)
Opened = True
End Sub

'将以秒为单位的时间转成普通的格式
Public Sub ShowTime(Object As Control, Length As Long)
Dim Min, Sec As Integer
Min = Fix(Length / 60000)
Object.Caption = ""
If Min < 10 Then
Object.Caption = "0" & Min
Else
Object.Caption = Min
End If
Sec = Fix((Length Mod 60000) / 1000)
Object.Caption = Object.Caption & ":"
If Sec < 10 Then
Object.Caption = Object.Caption & "0" & Sec
Else
Object.Caption = Object.Caption & Sec
End If
End Sub

[nik_Amis]

up

[griefforyou]

'关键就在这里,得到时间长度
mciSendString "status mp3 length", PlayStatus, Len(PlayStatus), Cb
TotalLength = Val(Left(PlayStatus, 9))