ک کلاس برای کار با فایلهای موسیقی
Imports System.IO
Imports System.Windows
Imports System.Windows.Forms
Public Class csMusicLibrary
'
'
'Title: cs Music Library Pro v1.0
'
'Description: A powerful class that plays most music files. Including mp3, wav,
'wma, and more. In fact, it should play any music format that you have the
'codec/driver installed for. Has many features available to build a complete
'feature rich music player.
'
'
'
'Notes: This code it based on the class modules I made for the classic Visual
'Basic versions. I did change and add features and fixed a few bugs. It is
'completely compatible for VB.Net. Actually, when the class is compiled, it
'should work with all .Net languages. You can also add COM Interop and use it
'for the Classic versions of Visual Basic.
'
'returns the short path name of a long path
Private Declare Function getShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Integer) As Integer
'
'
'api to send the commands to the mci device
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
'
'
'will store all the property values
Private _cStatus As String = Nothing
Private _DeviceName As String = Nothing
Private _dMS As Integer = Nothing
Private _dSec As Integer = Nothing
Private _endOfSong As Boolean = Nothing
Private _Filename As String = Nothing
Private _fDur As String = Nothing
Private _fPos As String = Nothing
Private _fTRemaining As String = Nothing
Private _isPlaying As Boolean = False
Private _lChanValue As Boolean = False
Private _lChanVol As Integer = Nothing
Private _bitrateBits As Integer = Nothing
Private _bitrateKB As Integer = Nothing
Private _playSpeed As Integer = Nothing
Private _posMS As Integer = Nothing
Private _posSec As Integer = Nothing
Private _rChanValue As Boolean = False
Private _rChanVol As Integer = Nothing
Private _tRemainingMS As Integer = Nothing
Private _tRemainingSec As Integer = Nothing
Private _volLevel As Integer = Nothing
Private _muteOutput As Boolean = False
'
'
'
Public Sub playMusic()
'open and play a music file
Try
'close the previous device and alias
mciSendString("close song", 0, 0, 0)
'let the command interface decide which device to use, just specify the
'alias. 'open the filename with the alias named song
mciSendString("open " & filename & " alias song", 0, 0, 0)
'tell the device to play
mciSendString("play song", 0, 0, 0)
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Public Function getLongFilename(ByVal sShortName As String) As String
'used to convert the short filename to the long filename
Dim sLongName As String = Nothing
Dim sTemp As String = Nothing
Dim iSlashPos As Integer = Nothing
Try
'add \ to short name to prevent Instr from failing
sShortName = sShortName & "\"
'start from 4 to ignore the "[Drive Letter]:\" characters
iSlashPos = InStr(4, sShortName, "\")
'pull out each string between \ character for conversion
While iSlashPos
sTemp = Dir(Left$(sShortName, iSlashPos - 1), _
vbNormal + vbHidden + vbSystem + vbDirectory)
If sTemp = "" Then
'error 52 - Bad File Name or Number
getLongFilename = ""
Exit Function
End If
sLongName = sLongName & "\" & sTemp
iSlashPos = InStr(iSlashPos + 1, sShortName, "\")
End While
'prefix with the drive letter
getLongFilename = Left$(sShortName, 2) & sLongName
sLongName = Nothing
sTemp = Nothing
iSlashPos = Nothing
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Function
Public ReadOnly Property endOfSong() As Boolean
'check if the song has ended. useful for repeat play, random play, ect.
Get
Dim thePos As Integer = Nothing
Dim theDur As Integer = Nothing
thePos = positionInSec
theDur = durationInSec
If thePos = 0 Then
Exit Property
ElseIf theDur = 0 Then
Exit Property
End If
If thePos >= theDur Then 'if the position equals the duration or higher
_endOfSong = True
Else
_endOfSong = False
End If
endOfSong = _endOfSong
thePos = Nothing
theDur = Nothing
_endOfSong = Nothing
End Get
End Property
Public ReadOnly Property deviceName() As String
'returns the current device being used to play the current song
Get
Dim theData As String = Space(128) '128 space buffer
mciSendString("sysinfo song installname", theData, 128, 0) 'retrieve the devicename
_DeviceName = theData
deviceName = _DeviceName
theData = Nothing
_DeviceName = Nothing
End Get
End Property
Public Property rightChannelMute() As Boolean
'set - mute just the right channel. True = mute, False = inMute
'get - check whether the right channel is muted or not
Get
rightChannelMute = _rChanValue
End Get
Set(ByVal Value As Boolean)
If Value = True Then
'mute the right channel
mciSendString("setaudio song right off", 0, 0, 0)
_rChanValue = Value
Else
'unmute the right channel
mciSendString("setaudio song right on", 0, 0, 0)
_rChanValue = Value
End If
End Set
End Property
Public Property leftChannelMute() As Boolean
'set - mute just the left channel. True = mute, False = unMute
'get - check whether the left channel is muted or not
Get
leftChannelMute = _lChanValue
End Get
Set(ByVal Value As Boolean)
If Value = True Then
'mute the left channel
mciSendString("setaudio song left off", 0, 0, 0)
_lChanValue = Value 'True
Else
'unmute the left channel
mciSendString("setaudio song left on", 0, 0, 0)
_lChanValue = Value 'False
End If
End Set
End Property
Public Property filename() As String
'set - the path and filename of the file to play
'get - the path and filename of the file
Get
filename = _Filename
End Get
Set(ByVal Value As String)
'put " and " at the beinning and end of the filename. the device
'could fail without these quotes, or you can convert the long filename
'to the short filename and not need the quotes
_Filename = Chr(34) + Trim(Value) + Chr(34) 'add quotes around the file
End Set
End Property
Public Function openPlaylist(ByVal thePath As String) As Collection
'open and load the specified m3u playlist
Dim sReader As StreamReader = New StreamReader(thePath)
Dim item As String = Nothing
Dim playLst As Collection = New Collection()
Try
item = sReader.ReadLine
Do While Not item Is Nothing
playLst.Add(item)
item = sReader.ReadLine
Loop
'copy to the main collection
openPlaylist = playLst
'clean up
playLst = Nothing
sReader = Nothing
item = Nothing
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Function
Public ReadOnly Property timeRemainingInMS() As Integer
'get the time remaining in milli-seconds
Get
_tRemainingMS = durationInMS - positionInMS
timeRemainingInMS = _tRemainingMS
_tRemainingMS = Nothing
End Get
End Property
Public ReadOnly Property timeRemainingInSec() As Integer
'get the time remaining in seconds
Get
_tRemainingSec = durationInSec - positionInSec
timeRemainingInSec = _tRemainingSec
_tRemainingSec = Nothing
End Get
End Property
Public ReadOnly Property formatTimeRemaining() As String
'get the time remaining in a user friendly format - ex. 3:50
Get
_fTRemaining = getThisTime(timeRemainingInMS)
formatTimeRemaining = _fTRemaining
_fTRemaining = Nothing
End Get
End Property
Private Function getLastBackSlash(ByVal path As String) As String
'used to find the last backslash in the path
Dim i As Integer = Nothing
Dim pos As Integer = Nothing
Dim lastslash As Integer = Nothing
Try
For i = 1 To Len(path)
pos = InStr(i, path, "\", vbTextCompare)
If pos <> 0 Then lastslash = pos
Next i
getLastBackSlash = Right(path, Len(path) - lastslash)
i = Nothing
pos = Nothing
lastslash = Nothing
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Function
Private Function rightLeft(ByVal source As String, ByVal token As String) As String
'used for getting Right/Left of a specified character in the string
Dim i As Integer = Nothing
Try
rightLeft = ""
For i = Len(source) To 1 Step -1
If Mid(source, i, 1) = token Then
rightLeft = Left(source, i - 1)
Exit Function
End If
Next i
i = Nothing
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Function
Public Function fileNoPathOrExt(ByVal srcItem As String) As String
'strip the path and extension from a file. returns only the filename
Dim noChar As String = Nothing
Dim noEnd As String = Nothing
Dim destItem As String = Nothing
Try
noChar = getLastBackSlash(srcItem)
noEnd = rightLeft(noChar, ".")
destItem = noEnd
fileNoPathOrExt = destItem
'clean up
noChar = Nothing
noEnd = Nothing
destItem = Nothing
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Function
Private Function noEndChar(ByVal srcList As Array) As String
'Take the ext. off the end of a file
Dim n As Integer = Nothing
Try
For n = 0 To srcList.Length - 1
noEndChar = Left(srcList.GetValue(n), 1)
Next
n = Nothing
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Function
Public Sub savePlaylist(ByVal pathSave As String, ByVal srcList As Collection)
'save a playlist to the specified external m3u file
Dim i As Integer = Nothing
Dim a As String = Nothing
Dim sWriter As StreamWriter = New StreamWriter(pathSave)
Try
For i = 0 To srcList.Count - 1
a = srcList.Item(i + 1)
sWriter.WriteLine(a)
Next
'copy the data to the file
sWriter.Flush()
a = Nothing
i = Nothing
sWriter = Nothing
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Public Property playSpeed() As Integer
'set - the playing speed of the song
'get - the playing speed of the song being played
'
'note: different sound cards will probably supports different speeds
Get
Dim rate As String = Space(128) 'buffer to receive the data
mciSendString("status song speed", rate, 128, 0)
_playSpeed = Val(rate)
playSpeed = _playSpeed
rate = Nothing
_playSpeed = Nothing
End Get
Set(ByVal Value As Integer)
mciSendString("set song speed " & Value, "", 0, 0)
End Set
End Property
Public Property volumeLevel() As Integer
'set - the sound volume level
'get - the current sound volume level value
'
'note: 1000 = max volume | 0 = minimum volume value
Get
Dim theLevel As String = Space(128) '128 space buffer
mciSendString("status song volume", theLevel, 128, 0)
_volLevel = Val(theLevel)
volumeLevel = _volLevel
theLevel = Nothing
_volLevel = Nothing
End Get
Set(ByVal Value As Integer)
mciSendString("setaudio song volume to " & Value, 0, 0, 0)
End Set
End Property
Public ReadOnly Property positionInMS() As Integer
'get the current playing position in milli-seconds
Get
Dim stat As String = Space(128) 'buffer with 128 spaces available
mciSendString("set song time format milliseconds", 0, 0, 0)
mciSendString("status song position", stat, 128, 0)
_posMS = Val(stat)
positionInMS = _posMS
stat = Nothing
_posMS = Nothing
End Get
End Property
Public ReadOnly Property positionInSec() As Integer
'get the current playing position in seconds
Get
_posSec = Val(positionInMS / 1000)
positionInSec = _posSec
_posSec = Nothing
End Get
End Property
Public ReadOnly Property formatPosition() As String
'get the current playing position in a user-friendly format, ex - 1:12
Get
Dim sec As Integer = Nothing
Dim mins As Integer = Nothing
sec = Val(positionInSec())
If sec < 60 Then _fPos = "0:" & Format(sec, "00")
If sec > 59 Then
mins = Int(sec / 60)
sec = sec - (mins * 60)
_fPos = Format(mins, "0") & ":" & Format(sec, "00")
End If
formatPosition = _fPos
sec = Nothing
mins = Nothing
_fPos = Nothing
End Get
End Property
Public Property muteSoundOutput() As Boolean
'set - turn the sound on or off
'get - check if the sound is on or off
Get
muteSoundOutput = _muteOutput
End Get
Set(ByVal Value As Boolean)
If Value = True Then
mciSendString("set song audio all off", 0, 0, 0)
_muteOutput = Value
Else
mciSendString("set song audio all on", 0, 0, 0)
_muteOutput = Value
End If
End Set
End Property
Public ReadOnly Property mp3BitrateBits() As Integer
'get the bitrate of a mp3 file in bits per second
Get
Dim thePath As String
Dim theSize As Integer
Dim ext As String
thePath = filename
If thePath.EndsWith("mp3" & Chr(34)) Then
'Strip off the quotations from the filename that was added with Chr(34)
theSize = Len(thePath) - 1
thePath = Right(thePath, theSize)
thePath = Left(thePath, Len(thePath) - 1)
'
theSize = FileLen(thePath)
theSize = theSize * 8
_bitrateBits = theSize / durationInSec
Else
_bitrateBits = 0
End If
mp3BitrateBits = _bitrateBits
thePath = Nothing
theSize = Nothing
ext = Nothing
_bitrateBits = Nothing
End Get
End Property
Public Sub changePosition(ByVal theSecond As Integer)
'change the position of the song in seconds
Try
theSecond = theSecond * 1000
If isPlaying = True Then mciSendString("play song from " & theSecond, 0, 0, 0)
If isPlaying = False Then mciSendString("seek song to " & theSecond, 0, 0, 0)
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Public Sub closeAudioDevices()
'close all devices, call this when you unload your application
Try
mciSendString("close all", 0, 0, 0)
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Public Sub stopPlay()
'stop playing the song
Try
mciSendString("stop song", 0, 0, 0)
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Public Sub pausePlay()
'pause the song
Try
mciSendString("pause song", 0, 0, 0)
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Public ReadOnly Property durationInMS() As Integer
'get duration of the song in milli-seconds
Get
Dim totalTime As String = Space(128)
mciSendString("status song length", totalTime, 128, 0&)
_dMS = Val(totalTime)
durationInMS = _dMS
totalTime = Nothing
_dMS = Nothing
End Get
End Property
Public ReadOnly Property mp3BitrateKB() As Integer
'get the bitrate of a mp3 file in Kilo-Bytes
Get
_bitrateKB = mp3BitrateBits / 1000
mp3BitrateKB = _bitrateKB
_bitrateKB = Nothing
End Get
End Property
Public Property leftVolume() As Integer
'set - change the left channels volume to the specified value
'get - get the current value of the left channel volume level
'
'note: 1000 = maximum value | 0 = minimum value
Get
Dim leftLevel As String = Space(128) ' 128 space buffer
mciSendString("status song left volume", leftLevel, 128, 0)
_lChanVol = Val(leftLevel)
leftVolume = _lChanVol
leftLevel = Nothing
_lChanVol = Nothing
End Get
Set(ByVal Value As Integer)
mciSendString("setaudio song left volume to " & Value, 0, 0, 0)
End Set
End Property
Public Property rightVolume() As Integer
'set - change the right volume level to the specified value
'get - get the current value of the right channel volume level
'
'note: 1000 = maximum value | 0 = minimum value
Get
Dim rightlevel As String = Space(128)
mciSendString("status song right volume", rightlevel, 128, 0)
_rChanVol = Val(rightlevel)
rightVolume = _rChanVol
'clean up
rightlevel = Nothing
_rChanVol = Nothing
End Get
Set(ByVal Value As Integer)
mciSendString("setaudio song right volume to " & Value, 0, 0, 0)
End Set
End Property
Public ReadOnly Property formatDuration() As String
'get the duration of a song in a user friendly format, ex: 5:54
Get
Dim stat As String = Space(128) '128 space string buufer
Dim totalTime As Integer = Nothing
mciSendString("set song time format ms", stat, 128, 0)
mciSendString("status song length", stat, 128, 0)
totalTime = Val(stat)
_fDur = getThisTime(totalTime)
formatDuration = _fDur
stat = Nothing
totalTime = Nothing
_fDur = Nothing
End Get
End Property
Private Function getThisTime(ByVal timein As Integer) As String
'used to format the position and duration propertys to a user friendly
'format. ex: :49, 9:02, ect...
Dim conH As Integer
Dim conM As Integer
Dim conS As Integer
Dim remTime As Integer
Dim strRetTime As String
Try
remTime = timein / 1000
conH = Int(remTime / 3600)
remTime = remTime Mod 3600
conM = Int(remTime / 60)
remTime = remTime Mod 60
conS = remTime
If conH > 0 Then
strRetTime = Trim(Str(conH)) & ":"
Else
strRetTime = ""
End If
If conM >= 10 Then
strRetTime = strRetTime & Trim(Str(conM))
ElseIf conM > 0 Then
strRetTime = strRetTime & Trim(Str(conM))
Else
strRetTime = strRetTime & "0"
End If
strRetTime = strRetTime & ":"
If conS >= 10 Then
strRetTime = strRetTime & Trim(Str(conS))
ElseIf conS > 0 Then
strRetTime = strRetTime & "0" & Trim(Str(conS))
Else
strRetTime = strRetTime & "00"
End If
getThisTime = strRetTime
'clean up all variables
conH = Nothing
conM = Nothing
conS = Nothing
remTime = Nothing
strRetTime = Nothing
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Function
Public ReadOnly Property durationInSec() As Integer
'get the duration of the song in seconds
Get
_dSec = durationInMS / 1000
durationInSec = _dSec
_dSec = Nothing
End Get
End Property
Public Sub resumePlay()
'resume a song that has been paused
Try
mciSendString("resume song", 0, 0, 0)
Catch exc As Exception
MessageBox.Show(exc.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Public ReadOnly Property currentStatus() As String
'check the status to see if the music is playing, stopped, or paused
Get
Dim status As String = Space(128) ' a buffer with 128 spaces
mciSendString("status song mode", status, 128, 0)
_cStatus = Trim(status) 'remove beginning and trailing spaces
currentStatus = _cStatus
status = Nothing
_cStatus = Nothing
End Get
End Property
Public ReadOnly Property isPlaying() As Boolean
'check to see if a file is playing or not
Get
Dim stat As String = Space(7) ' a buffer with 7 spaces
mciSendString("status song mode", stat, 128, 0)
If stat = "playing" Then
_isPlaying = True
Else
_isPlaying = False
End If
isPlaying = _isPlaying
stat = Nothing
_isPlaying = Nothing
End Get
End Property
Protected Overrides Sub Finalize()
MyBase.Finalize()
End Sub
End Class
