Audio file class - vb.net

I am using VB.net VS2012 and would like some help playing an Audio file.
Here is my code:
''' <summary>
''' This class is a wrapper for the Windows API calls to play wave, midi or mp3 files.
''' </summary>
''' <remarks>
''' </remarks>
Public Class AudioFile
'***********************************************************************************************************
' Class: PlayFile
' Written By: Blake Pell (bpell#indiana.edu)
' Initial Date: 03/31/2007
' Last Updated: 02/04/2009
'***********************************************************************************************************
' Windows API Declarations
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Int32, ByVal hwndCallback As Int32) As Int32
''' <summary>
''' Constructor: Location is the filename of the media to play. Wave files and Mp3 files are the supported formats.
''' </summary>
''' <param name="Location"></param>
''' <remarks></remarks>
Public Sub New(ByVal location As String)
Me.Filename = location
End Sub
''' <summary>
''' Plays the file that is specified as the filename.
''' </summary>
''' <remarks></remarks>
Public Sub Play()
If _filename = "" Or Filename.Length <= 4 Then Exit Sub
Select Case Right(Filename, 3).ToLower
Case "mp3"
mciSendString("open """ & _filename & """ type mpegvideo alias audiofile", Nothing, 0, IntPtr.Zero)
Dim playCommand As String = "play audiofile from 0"
If _wait = True Then playCommand += " wait"
mciSendString(playCommand, Nothing, 0, IntPtr.Zero)
Case "wav"
mciSendString("open """ & _filename & """ type waveaudio alias audiofile", Nothing, 0, IntPtr.Zero)
mciSendString("play audiofile from 0", Nothing, 0, IntPtr.Zero)
Case "mid", "idi"
mciSendString("stop midi", "", 0, 0)
mciSendString("close midi", "", 0, 0)
mciSendString("open sequencer!" & _filename & " alias midi", "", 0, 0)
mciSendString("play midi", "", 0, 0)
Case Else
Throw New Exception("File type not supported.")
Call Close()
End Select
IsPaused = False
End Sub
''' <summary>
''' Pause the current play back.
''' </summary>
''' <remarks></remarks>
Public Sub Pause()
mciSendString("pause audiofile", Nothing, 0, IntPtr.Zero)
IsPaused = True
End Sub
''' <summary>
''' Resume the current play back if it is currently paused.
''' </summary>
''' <remarks></remarks>
Public Sub [Resume]()
mciSendString("resume audiofile", Nothing, 0, IntPtr.Zero)
IsPaused = False
End Sub
''' <summary>
''' Stop the current file if it's playing.
''' </summary>
''' <remarks></remarks>
Public Sub [Stop]()
mciSendString("stop audiofile", Nothing, 0, IntPtr.Zero)
End Sub
''' <summary>
''' Close the file.
''' </summary>
''' <remarks></remarks>
Public Sub Close()
mciSendString("close audiofile", Nothing, 0, IntPtr.Zero)
End Sub
Private _wait As Boolean = False
''' <summary>
''' Halt the program until the .wav file is done playing. Be careful, this will lock the entire program up until the
''' file is done playing. It behaves as if the Windows Sleep API is called while the file is playing (and maybe it is, I don't
''' actually know, I'm just theorizing). :P
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Wait() As Boolean
Get
Return _wait
End Get
Set(ByVal value As Boolean)
_wait = value
End Set
End Property
''' <summary>
''' Sets the audio file's time format via the mciSendString API.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property Milleseconds() As Integer
Get
Dim buf As String = Space(255)
mciSendString("set audiofile time format milliseconds", Nothing, 0, IntPtr.Zero)
mciSendString("status audiofile length", buf, 255, IntPtr.Zero)
buf = Replace(buf, Chr(0), "") ' Get rid of the nulls, they muck things up
If buf = "" Then
Return 0
Else
Return CInt(buf)
End If
End Get
End Property
''' <summary>
''' Gets the status of the current playback file via the mciSendString API.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property Status() As String
Get
Dim buf As String = Space(255)
mciSendString("status audiofile mode", buf, 255, IntPtr.Zero)
buf = Replace(buf, Chr(0), "") ' Get rid of the nulls, they muck things up
Return buf
End Get
End Property
''' <summary>
''' Gets the file size of the current audio file.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property FileSize() As Integer
Get
Try
Return My.Computer.FileSystem.GetFileInfo(_filename).Length
Catch ex As Exception
Return 0
End Try
End Get
End Property
''' <summary>
''' Gets the channels of the file via the mciSendString API.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property Channels() As Integer
Get
Dim buf As String = Space(255)
mciSendString("status audiofile channels", buf, 255, IntPtr.Zero)
If IsNumeric(buf) = True Then
Return CInt(buf)
Else
Return -1
End If
End Get
End Property
''' <summary>
''' Used for debugging purposes.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property Debug() As String
Get
Dim buf As String = Space(255)
mciSendString("status audiofile channels", buf, 255, IntPtr.Zero)
Return Str(buf)
End Get
End Property
Private _isPaused As Boolean = False
''' <summary>
''' Whether or not the current playback is paused.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property IsPaused() As Boolean
Get
Return _isPaused
End Get
Set(ByVal value As Boolean)
_isPaused = value
End Set
End Property
Private _filename As String
''' <summary>
''' The current filename of the file that is to be played back.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Filename() As String
Get
Return _filename
End Get
Set(ByVal value As String)
If My.Computer.FileSystem.FileExists(value) = False Then
Throw New System.IO.FileNotFoundException
Exit Property
End If
_filename = value
End Set
End Property
End Class
This code works well. Can I please have some help to create an Event that will be called when the Audio file has finished playing. When an Audio file has finished, the 'Status' is 'Stopped'. How can I check to see when this happens and create an Event for it?

There doesn't seem to a way to register a callback for when the playback status changes, so you'll have to use an observer (i.e. a timer).
Private WithEvents StatusMonitor As New Timers.Timer(100)
Private Property LastStatus As String
Private Sub StatusMonitor_Elapsed(sender As Object, e As Timers.ElapsedEventArgs) Handles StatusMonitor.Elapsed
If Not String.Equals(Me.Status, Me.LastStatus) Then
Me.LastStatus = Me.Status
RaiseEvent PlaybackStatusChanged(Me, New PlaybackStatusChangedEventArgs(Me.Status))
End If
End Sub
Public Event PlaybackStatusChanged(sender As Object, e As PlaybackStatusChangedEventArgs)
Public Class PlaybackStatusChangedEventArgs
Inherits EventArgs
Private _status As String
Public Sub New(status As String)
_status = status
End Sub
Public ReadOnly Property Status As String
Get
Return _status
End Get
End Property
End Class
What this does is it stores the status in a private property and compares it to the current status every 100ms. If the status has changed, it fires the PlaybackStatusChanged event, along with arguments containing the new status. You can then listen for this event, and check e.Status in the event callback as if you were directly getting it from AudioFile.Status.
EDIT
After doing a couple of test runs, I've found that the status property behaves inconsistently. It seems to return a lot of whitespace as well, for reasons that I can't seem to figure out. Anyway, as a result, the status passed to the status event is wrong.

I'm not sure how to do that. But what you could do is this. On your main form, Dim a string like lol as string
Now for a button, set this code:
lol = "Audio file path goes here :3"
Dim audio As New AudioFile(lol)
Timer1.Start()
audio.Play()
Add a timer, and set its interval to 10.
For the timer code add this:
Dim audio As New AudioFile(lol)
If audio.Status.Contains("stopped") Then
audio.Play()
End If
That way, when the song is done playing, the timer will automatically start playing it again. And its set for the audio file that's on that variable, so just have the button set the path on that variable and boom. Your set.
Hope that helped...

Related

How to read data from serial port in vb.net?

I made a class and there is this sub named SendUSSD, when this is called it sends a ussd code like *123# to a COM port where a gsm mobile is connected. This ussd is supposed to return the mobile balance.
If IsOpen = True Then 'checks if the port is open
SMSPort.WriteLine("AT+CUSD=1,""*123#""" vbCr) 'this sends the ussd code
Form1.TextBox2.Text = SMSPort.ReadLine().ToString() 'this shows the response
End If
Now the problem is sometimes I get the full response like "Your current balance is so and so". But, most of the time I get a part of the message like "Your curr". My guess is that it takes some time to get the response, so how do I make this Form1.TextBox2.Text = SMSPort.ReadLine().ToString() line wait until the last character which is a full-stop to appear and then execute the line?
im using this class to connect com ports.
'connect like this
Public comm As New CommunicationManager
comm.Parity = "None"
comm.StopBits = "One"
comm.DataBits = "8"
comm.BaudRate = "38400"
comm.PortName = comport_ismi
comm.OpenPort()
and the class
Imports System.Text
Imports System.Drawing
Imports System.IO.Ports
Imports System.Windows.Forms
Public Class CommunicationManager
#Region "Manager Enums"
''' <summary>
''' enumeration to hold our transmission types
''' </summary>
Public Enum TransmissionType
Text
Hex
End Enum
''' <summary>
''' enumeration to hold our message types
''' </summary>
Public Enum MessageType
Incoming
Outgoing
Normal
Warning
[Error]
End Enum
#End Region
#Region "Manager Variables"
'property variables
Private _baudRate As String = String.Empty
Private _parity As String = String.Empty
Private _stopBits As String = String.Empty
Private _dataBits As String = String.Empty
Private _portName As String = String.Empty
Private _transType As TransmissionType
Private _displayWindow As RichTextBox
'global manager variables
Private MessageColor As Color() = {Color.Blue, Color.Green, Color.Black, Color.Orange, Color.Red}
Private comPort As New SerialPort()
#End Region
#Region "Manager Properties"
''' <summary>
''' Property to hold the BaudRate
''' of our manager class
''' </summary>
Public Property BaudRate() As String
Get
Return _baudRate
End Get
Set(value As String)
_baudRate = value
End Set
End Property
''' <summary>
''' property to hold the Parity
''' of our manager class
''' </summary>
Public Property Parity() As String
Get
Return _parity
End Get
Set(value As String)
_parity = value
End Set
End Property
''' <summary>
''' property to hold the StopBits
''' of our manager class
''' </summary>
Public Property StopBits() As String
Get
Return _stopBits
End Get
Set(value As String)
_stopBits = value
End Set
End Property
''' <summary>
''' property to hold the DataBits
''' of our manager class
''' </summary>
Public Property DataBits() As String
Get
Return _dataBits
End Get
Set(value As String)
_dataBits = value
End Set
End Property
''' <summary>
''' property to hold the PortName
''' of our manager class
''' </summary>
Public Property PortName() As String
Get
Return _portName
End Get
Set(value As String)
_portName = value
End Set
End Property
''' <summary>
''' property to hold our TransmissionType
''' of our manager class
''' </summary>
Public Property CurrentTransmissionType() As TransmissionType
Get
Return _transType
End Get
Set(value As TransmissionType)
_transType = value
End Set
End Property
''' <summary>
''' property to hold our display window
''' value
''' </summary>
Public Property DisplayWindow() As RichTextBox
Get
Return _displayWindow
End Get
Set(value As RichTextBox)
_displayWindow = value
End Set
End Property
#End Region
#Region "Manager Constructors"
''' <summary>
''' Constructor to set the properties of our Manager Class
''' </summary>
''' <param name="baud">Desired BaudRate</param>
''' <param name="par">Desired Parity</param>
''' <param name="sBits">Desired StopBits</param>
''' <param name="dBits">Desired DataBits</param>
''' <param name="name">Desired PortName</param>
Public Sub New(baud As String, par As String, sBits As String, dBits As String, name As String, rtb As RichTextBox)
_baudRate = baud
_parity = par
_stopBits = sBits
_dataBits = dBits
_portName = name
_displayWindow = rtb
'now add an event handler
AddHandler comPort.DataReceived, New SerialDataReceivedEventHandler(AddressOf comPort_DataReceived)
End Sub
''' <summary>
''' Comstructor to set the properties of our
''' serial port communicator to nothing
''' </summary>
Public Sub New()
_baudRate = String.Empty
_parity = String.Empty
_stopBits = String.Empty
_dataBits = String.Empty
_portName = comport_ismi
_displayWindow = Nothing
'add event handler
AddHandler comPort.DataReceived, New SerialDataReceivedEventHandler(AddressOf comPort_DataReceived)
End Sub
#End Region
#Region "WriteData"
Public Sub WriteData(msg As String)
Select Case CurrentTransmissionType
Case TransmissionType.Text
'first make sure the port is open
'if its not open then open it
If Not (comPort.IsOpen = True) Then
comPort.Open()
End If
'send the message to the port
comPort.Write(msg)
'display the message
DisplayData(MessageType.Outgoing, msg & Convert.ToString(vbLf))
Exit Select
Case TransmissionType.Hex
Try
'convert the message to byte array
Dim newMsg As Byte() = HexToByte(msg)
'send the message to the port
comPort.Write(newMsg, 0, newMsg.Length)
'convert back to hex and display
DisplayData(MessageType.Outgoing, ByteToHex(newMsg) & Convert.ToString(vbLf))
Catch ex As FormatException
'display error message
DisplayData(MessageType.[Error], ex.Message)
Finally
_displayWindow.SelectAll()
End Try
Exit Select
Case Else
'first make sure the port is open
'if its not open then open it
If Not (comPort.IsOpen = True) Then
comPort.Open()
End If
'send the message to the port
comPort.Write(msg)
'display the message
DisplayData(MessageType.Outgoing, msg & Convert.ToString(vbLf))
Exit Select
End Select
End Sub
#End Region
#Region "HexToByte"
''' <summary>
''' method to convert hex string into a byte array
''' </summary>
''' <param name="msg">string to convert</param>
''' <returns>a byte array</returns>
Private Function HexToByte(msg As String) As Byte()
'remove any spaces from the string
msg = msg.Replace(" ", "")
'create a byte array the length of the
'divided by 2 (Hex is 2 characters in length)
Dim comBuffer As Byte() = New Byte(msg.Length / 2 - 1) {}
'loop through the length of the provided string
For i As Integer = 0 To msg.Length - 1 Step 2
'convert each set of 2 characters to a byte
'and add to the array
comBuffer(i / 2) = CByte(Convert.ToByte(msg.Substring(i, 2), 16))
Next
'return the array
Return comBuffer
End Function
#End Region
#Region "ByteToHex"
''' <summary>
''' method to convert a byte array into a hex string
''' </summary>
''' <param name="comByte">byte array to convert</param>
''' <returns>a hex string</returns>
Private Function ByteToHex(comByte As Byte()) As String
'create a new StringBuilder object
Dim builder As New StringBuilder(comByte.Length * 3)
'loop through each byte in the array
For Each data As Byte In comByte
'convert the byte to a string and add to the stringbuilder
builder.Append(Convert.ToString(data, 16).PadLeft(2, "0"c).PadRight(3, " "c))
Next
'return the converted value
Return builder.ToString().ToUpper()
End Function
#End Region
#Region "DisplayData"
''' <summary>
''' method to display the data to & from the port
''' on the screen
''' </summary>
''' <param name="type">MessageType of the message</param>
''' <param name="msg">Message to display</param>
<STAThread> _
Private Sub DisplayData(type As MessageType, msg As String)
'_displayWindow.Invoke(New EventHandler(Sub()
' _displayWindow.SelectedText = String.Empty
' _displayWindow.SelectionFont = New Font(_displayWindow.SelectionFont, FontStyle.Bold)
' _displayWindow.SelectionColor = MessageColor(CInt(type))
' _displayWindow.AppendText(msg)
' _displayWindow.ScrollToCaret()
' End Sub))
End Sub
#End Region
#Region "OpenPort"
Public Function OpenPort() As Boolean
Try
'first check if the port is already open
'if its open then close it
If comPort.IsOpen = True Then
comPort.Close()
End If
'set the properties of our SerialPort Object
comPort.BaudRate = Integer.Parse(_baudRate)
'BaudRate
comPort.DataBits = Integer.Parse(_dataBits)
'DataBits
comPort.StopBits = DirectCast([Enum].Parse(GetType(StopBits), _stopBits), StopBits)
'StopBits
comPort.Parity = DirectCast([Enum].Parse(GetType(Parity), _parity), Parity)
'Parity
comPort.PortName = _portName
'PortName
'now open the port
comPort.Open()
'display message
DisplayData(MessageType.Normal, "Port AÇILDI: " + DateTime.Now + vbLf)
'return true
Return True
Catch ex As Exception
DisplayData(MessageType.[Error], ex.Message)
Return False
End Try
End Function
#End Region
#Region "ClosePort"
Public Function ClosePort() As Boolean
Try
'first check if the port is already open
'if its open then close it
If comPort.IsOpen = True Then
comPort.Close()
End If
'display message
DisplayData(MessageType.Normal, "Port KAPANDI: " + DateTime.Now + vbLf)
'return true if port is closed
If comPort.IsOpen = False Then
Return True
End If
DisplayData(MessageType.Normal, "Kapatmada hata oluştu" & vbLf)
Return False
Catch ex As Exception
DisplayData(MessageType.[Error], ex.Message)
Return False
End Try
End Function
#End Region
#Region "SetParityValues"
Public Sub SetParityValues(obj As Object)
For Each str As String In [Enum].GetNames(GetType(Parity))
DirectCast(obj, ComboBox).Items.Add(str)
Next
End Sub
#End Region
#Region "SetStopBitValues"
Public Sub SetStopBitValues(obj As Object)
For Each str As String In [Enum].GetNames(GetType(StopBits))
DirectCast(obj, ComboBox).Items.Add(str)
Next
End Sub
#End Region
#Region "SetPortNameValues"
Public Sub SetPortNameValues(obj As Object)
For Each str As String In SerialPort.GetPortNames()
DirectCast(obj, ComboBox).Items.Add(str)
Next
End Sub
#End Region
#Region "comPort_DataReceived"
''' <summary>
''' method that will be called when theres data waiting in the buffer
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub comPort_DataReceived(sender As Object, e As SerialDataReceivedEventArgs)
'determine the mode the user selected (binary/string)
Select Case CurrentTransmissionType
'user chose string
Case TransmissionType.Text
'read data waiting in the buffer
Dim msg As String = comPort.ReadExisting()
'display the data to the user
DisplayData(MessageType.Incoming, msg)
' + "\n"); **************
Exit Select
'user chose binary
Case TransmissionType.Hex
'retrieve number of bytes in the buffer
Dim bytes As Integer = comPort.BytesToRead
'create a byte array to hold the awaiting data
Dim comBuffer As Byte() = New Byte(bytes - 1) {}
'read the data and store it
comPort.Read(comBuffer, 0, bytes)
'display the data to the user
DisplayData(MessageType.Incoming, ByteToHex(comBuffer))
' + "\n");
Exit Select
Case Else
'read data waiting in the buffer
Dim str As String = comPort.ReadExisting()
'display the data to the user
DisplayData(MessageType.Incoming, str)
' + "\n");
Exit Select
End Select
End Sub
#End Region
End Class
I guess you are using the DataReceived event, if so, you can just take the data and split it by the lastIndexOf(Enviroment.NewLine).
you will have two part the first one is a string with some amount of lines and the second one is a string that contain no more lines.
You can take the first part and split it by new line and even create a new event (LineReceived).
for the second part(the part after the lastIndexOf(Enviroment.NewLine)) of the data just concatenate it to the beginning of the data that will arrive the next time.
Try setting comm.Newline. Probably should be vbCR.

Check if FTP folder exists & if not then create it

I need a function to complete the following tasks:
Check if a folder exists (via its name) - if not then, create it.
Upload a file into the directory.
I tried with the following code, but it does not seem to check and create the directory:
Dim request As System.Net.FtpWebRequest = DirectCast(System.Net.FtpWebRequest.Create("HOST"), System.Net.FtpWebRequest)
request.Credentials = New System.Net.NetworkCredential("uase", "pass")
request.Method = System.Net.WebRequestMethods.Ftp.UploadFile
Dim file() As Byte = System.IO.File.ReadAllBytes("C:\Users\Nini\Desktop\10ebd0d.png")
Dim str As System.IO.Stream = request.GetRequestStream()
str.Write(file, 0, file.Length)
str.Close()
str.Dispose()
1.Check if a folder exists (via its name) - if not then, create it.
I'll admit that this is not the most robust or elegant solution but I was OK with something 'quick and dirty' for the occasional one-off need that I have for this.
Dim request As FtpWebRequest = FtpWebRequest.Create("ftp://myftp/parentfolder")
Dim creds As NetworkCredential = New NetworkCredential("user", "pwd")
request.Credentials = creds
Dim resp As FtpWebResponse = Nothing
request.Method = WebRequestMethods.Ftp.ListDirectoryDetails
request.KeepAlive = True
Using resp
resp = request.GetResponse()
Dim sr As StreamReader = New StreamReader(resp.GetResponseStream(), System.Text.Encoding.ASCII)
Dim s As String = sr.ReadToEnd()
If Not s.Contains("newfolder") Then
request = FtpWebRequest.Create("ftp://myftp/parentfolder/newfolder")
request.Credentials = creds
request.Method = WebRequestMethods.Ftp.MakeDirectory
resp = request.GetResponse()
Console.WriteLine(resp.StatusCode & "Created")
Else
Console.WriteLine("Directory already exists")
End If
Console.ReadLine()
End Using
You could use the FTPClient library for .NET
I've did an helper Class to manage the library (but is easy as is provided there is no need to use an helper Class)
The methods that you're interested to are DirectoryExists, CreateDirectory, and UploadFile
This is an example usage:
Public Class Form1
Private WithEvents UploadClient As New System.Net.WebClient()
Private WithEvents DownloadClient As New System.Net.WebClient()
Private ftp As New FTP("ftpsite", "username", "password")
Private Sub Test() Handles MyBase.Shown
ftp.Connect()
ftp.CreateDirectory("/DirectoryName", True)
ftp.UploadFile(UploadClient, "C:\File.txt", "/DirectoryName/NewFile.txt", False)
ftp.DownloadFile(DownloadClient, "/DirectoryName/NewFile.txt", "c:\DownloadedFile.txt", True)
End Sub
Private Sub Client_UploadProgress(sender As System.Net.WebClient, e As System.Net.UploadProgressChangedEventArgs) _
Handles UploadClient.UploadProgressChanged
Label_Upload.Text = e.ProgressPercentage & "%"
End Sub
Private Sub Client_UploadCompleted(sender As System.Net.WebClient, e As System.Net.UploadFileCompletedEventArgs) _
Handles UploadClient.UploadFileCompleted
Label_UploadCompleted.Text = e.Result.ToString
End Sub
Private Sub Client_DownloadProgress(sender As System.Net.WebClient, e As System.Net.DownloadProgressChangedEventArgs) _
Handles DownloadClient.DownloadProgressChanged
Label_Download.Text = e.ProgressPercentage & "%"
End Sub
Private Sub Client_DownloadCompleted(sender As System.Net.WebClient, e As System.ComponentModel.AsyncCompletedEventArgs) _
Handles DownloadClient.DownloadFileCompleted
Label_DownloadCompleted.Text = "Done!"
End Sub
End Class
The Helper Class:
Imports System.Net
Imports System.Net.FtpClient
Imports System.Net.FtpClient.Extensions
#Region " FTPClient Helper "
' [ FTPClient Helper ]
'
' // By Elektro
Public Class FTP
#Region " Variables "
Private conn As New FtpClient
''' <summary>
''' The FTP site.
''' </summary>
Private Property host As String = String.Empty
''' <summary>
''' The user name.
''' </summary>
Private Property user As String = String.Empty
''' <summary>
''' The user password.
''' </summary>
Private Property pass As String = String.Empty
' Friend m_reset As New ManualResetEvent(False) ' Use it for CallBacks
#End Region
#Region " Constructor "
''' <summary>
''' .
''' </summary>
''' <param name="host">Indicates the ftp site.</param>
''' <param name="user">Indicates the username.</param>
''' <param name="pass">Indicates the password.</param>
Public Sub New(ByVal host As String,
ByVal user As String,
ByVal pass As String)
If Not host.ToLower.StartsWith("ftp://") Then
Me.host = "ftp://" & host
Else
Me.host = host
End If
If Me.host.Last = "/" Then
Me.host = Me.host.Remove(Me.host.Length - 1)
End If
Me.user = user
Me.pass = pass
With conn
.Host = If(host.Last = "/", host.Remove(host.Length - 1), host)
.Credentials = New NetworkCredential(Me.user, Me.pass)
End With
End Sub
#End Region
#Region " Public Methods "
''' <summary>
''' Connects to server.
''' </summary>
Public Sub Connect()
conn.Connect()
End Sub
''' <summary>
''' Disconnects from server.
''' </summary>
Public Sub Disconnect()
conn.Disconnect()
End Sub
''' <summary>
''' Creates a directory on server.
''' </summary>
''' <param name="directorypath">Indicates the ftp directory path.</param>
''' <param name="force">Try to force all non-existant pieces of the path to be created.</param>
Public Sub CreateDirectory(ByVal directorypath As String, ByVal force As Boolean)
conn.CreateDirectory(directorypath, force)
End Sub
''' <summary>
''' Creates a directory on server.
''' </summary>
''' <param name="directorypath">Indicates the ftp directory path.</param>
''' <param name="force">Try to force all non-existant pieces of the path to be created.</param>
''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
Public Sub DeleteDirectory(ByVal directorypath As String,
ByVal force As Boolean,
Optional ByVal FtpListOption As FtpListOption =
FtpListOption.AllFiles Or FtpListOption.ForceList)
' Remove the directory and all objects beneath it. The last parameter
' forces System.Net.FtpClient to use LIST -a for getting a list of objects
' beneath the specified directory.
conn.DeleteDirectory(directorypath, force, FtpListOption)
End Sub
''' <summary>
''' Deletes a file on server.
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
Public Sub DeleteFile(ByVal filepath As String)
conn.DeleteFile(filepath)
End Sub
''' <summary>
''' Checks if a directory exist on server.
''' </summary>
''' <param name="directorypath">Indicates the ftp directory path.</param>
Public Function DirectoryExists(ByVal directorypath As String) As Boolean
Return conn.DirectoryExists(directorypath)
End Function
''' <summary>
''' Executes a command on server.
''' </summary>
''' <param name="command">Indicates the command to execute on the server.</param>
''' <returns>Returns an object containing the server reply information.</returns>
Public Function Execute(ByVal command As String) As FtpReply
Return (InlineAssignHelper(New FtpReply, conn.Execute(command)))
End Function
''' <summary>
''' Tries to execute a command on server.
''' </summary>
''' <param name="command">Indicates the command to execute on the server.</param>
''' <returns>Returns TRUE if command execution successfull, otherwise returns False.</returns>
Public Function TryExecute(ByVal command As String) As Boolean
Dim reply As FtpReply = Nothing
Return (InlineAssignHelper(reply, conn.Execute(command))).Success
End Function
''' <summary>
''' Checks if a file exist on server.
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
Public Function FileExists(ByVal filepath As String,
Optional ByVal FtpListOption As FtpListOption =
FtpListOption.AllFiles Or FtpListOption.ForceList) As Boolean
' The last parameter forces System.Net.FtpClient to use LIST -a
' for getting a list of objects in the parent directory.
Return conn.FileExists(filepath, FtpListOption)
End Function
''' <summary>
''' Retrieves a checksum of the given file
''' using a checksumming method that the server supports, if any.
''' The algorithm used goes in this order:
''' 1. HASH command (server preferred algorithm).
''' 2. MD5 / XMD5 commands
''' 3. XSHA1 command
''' 4. XSHA256 command
''' 5. XSHA512 command
''' 6. XCRC command
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
Public Function GetChecksum(ByVal filepath As String) As FtpHash
Return conn.GetChecksum(filepath)
End Function
''' <summary>
''' Gets the checksum of file on server and compare it with the checksum of local file.
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
''' <param name="localfilepath">Indicates the local disk file path.</param>
''' <param name="algorithm">Indicates the algorithm that should be used to verify checksums.</param>
''' <returns>Returns TRUE if both checksums are equal, otherwise returns False.</returns>
Public Function VerifyChecksum(ByVal filepath As String,
ByVal localfilepath As String,
ByVal algorithm As FtpHashAlgorithm) As Boolean
Dim hash As FtpHash = Nothing
hash = conn.GetChecksum(filepath)
' Make sure it returned a, to the best of our knowledge, valid hash object.
' The commands for retrieving checksums are
' non-standard extensions to the protocol so we have to
' presume that the response was in a format understood by
' System.Net.FtpClient and parsed correctly.
'
' In addition, there is no built-in support for verifying CRC hashes.
' You will need to write you own or use a third-party solution.
If hash.IsValid AndAlso hash.Algorithm <> algorithm Then
Return hash.Verify(localfilepath)
Else
Return Nothing
End If
End Function
''' <summary>
''' Gets the size of file.
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
Public Function GetFileSize(ByVal filepath As String) As Long
Return conn.GetFileSize(filepath)
End Function
''' <summary>
''' Gets the currently HASH algorithm used for the HASH command on server.
''' </summary>
Public Function GetHashAlgorithm() As FtpHashAlgorithm
Return conn.GetHashAlgorithm()
End Function
''' <summary>
''' Gets the modified time of file.
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
Public Function GetModifiedTime(ByVal filepath As String) As Date
Return conn.GetModifiedTime(filepath)
End Function
''' <summary>
''' Returns a file/directory listing using the NLST command.
''' </summary>
''' <param name="directorypath">Indicates the ftp file path.</param>
Public Function GetNameListing(ByVal directorypath As String) As String()
Return conn.GetNameListing(directorypath)
End Function
''' <summary>
''' Gets the current working directory on server.
''' </summary>
Public Function GetWorkingDirectory() As String
Return conn.GetWorkingDirectory()
End Function
''' <summary>
''' Opens the specified file to be appended to...
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
Public Function OpenAppend(ByVal filepath As String) As IO.Stream
Return conn.OpenAppend(filepath)
End Function
''' <summary>
''' Opens the specified file for reading.
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
Public Function OpenRead(ByVal filepath As String) As IO.Stream
Return conn.OpenRead(filepath)
End Function
''' <summary>
''' Opens the specified file for writing.
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
Public Function OpenWrite(ByVal filepath As String) As IO.Stream
Return conn.OpenWrite(filepath)
End Function
''' <summary>
''' Rename a file on the server.
''' </summary>
''' <param name="filepath">Indicates the ftp file path.</param>
''' <param name="newfilepath">Indicates the new ftp file path.</param>
Public Sub RenameFile(ByVal filepath As String, ByVal newfilepath As String)
If conn.FileExists(filepath) Then
conn.Rename(filepath, newfilepath)
Else
Throw New Exception(filepath & " File does not exist on server.")
End If
End Sub
''' <summary>
''' Rename a directory on the server.
''' </summary>
''' <param name="directorypath">Indicates the ftp file path.</param>
''' <param name="newdirectorypath">Indicates the new ftp file path.</param>
Public Sub RenameDirectory(ByVal directorypath As String, ByVal newdirectorypath As String)
If conn.DirectoryExists(directorypath) Then
conn.Rename(directorypath, newdirectorypath)
Else
Throw New Exception(directorypath & " Directory does not exist on server.")
End If
End Sub
''' <summary>
''' Tells the server wich hash algorithm to use for the HASH command.
''' </summary>
''' <param name="algorithm">Indicates the HASH algorithm.</param>
Public Function SetHashAlgorithm(ByVal algorithm As FtpHashAlgorithm) As Boolean
If conn.HashAlgorithms.HasFlag(algorithm) Then
conn.SetHashAlgorithm(algorithm)
Return True
Else
Return False
End If
End Function
''' <summary>
''' Sets the working directory on the server.
''' </summary>
''' <param name="directorypath">Indicates the ftp directory path.</param>
Public Sub SetWorkingDirectory(ByVal directorypath As String)
conn.SetWorkingDirectory(directorypath)
End Sub
''' <summary>
''' Gets a directory list on the specified path.
''' </summary>
''' <param name="directorypath">Indicates the ftp directory path.</param>
''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
Public Function GetDirectories(ByVal directorypath As String,
Optional ByVal FtpListOption As FtpListOption =
FtpListOption.AllFiles) As FtpListItem()
Return conn.GetListing(directorypath, FtpListOption).
Where(Function(item) item.Type = FtpFileSystemObjectType.Directory)
End Function
''' <summary>
''' Gets a file list on the specified path.
''' </summary>
''' <param name="directorypath">Indicates the ftp directory path.</param>
''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
Public Function GetFiles(ByVal directorypath As String,
Optional ByVal FtpListOption As FtpListOption =
FtpListOption.AllFiles) As FtpListItem()
Return conn.GetListing(directorypath, FtpListOption).
Where(Function(item) item.Type = FtpFileSystemObjectType.File)
End Function
''' <summary>
''' Gets a link list on the specified path.
''' </summary>
''' <param name="directorypath">Indicates the ftp directory path.</param>
''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
Public Function GetLinks(ByVal directorypath As String,
Optional ByVal FtpListOption As FtpListOption =
FtpListOption.AllFiles) As FtpListItem()
Return conn.GetListing(directorypath, FtpListOption).
Where(Function(item) item.Type = FtpFileSystemObjectType.Link)
End Function
''' <summary>
''' Gets a file/folder list on the specified path.
''' </summary>
''' <param name="directorypath">Indicates the ftp directory path.</param>
''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
Public Function GetListing(ByVal directorypath As String,
Optional ByVal FtpListOption As FtpListOption =
FtpListOption.AllFiles) As FtpListItem()
Return conn.GetListing(directorypath, FtpListOption)
End Function
''' <summary>
''' Log to a console window
''' </summary>
Public Sub LogToConsole()
FtpTrace.AddListener(New ConsoleTraceListener())
' now use System.Net.FtpCLient as usual and the server transactions
' will be written to the Console window.
End Sub
''' <summary>
''' Log to a text file
''' </summary>
''' <param name="filepath">Indicates the file where to save the log.</param>
Public Sub LogToFile(ByVal filepath As String)
FtpTrace.AddListener(New TextWriterTraceListener(filepath))
' now use System.Net.FtpCLient as usual and the server transactions
' will be written to the specified log file.
End Sub
''' <summary>
''' Uploads a file to FTP.
''' </summary>
''' <param name="UploadClient">Indicates the WebClient object to upload the file.</param>
''' <param name="filepath">Indicates the ftp fle path.</param>
''' <param name="localfilepath">Specifies the local path where to save the downloaded file.</param>
''' <param name="Asynchronous">Indicates whether the download should be an Asynchronous operation,
''' to raise WebClient events.</param>
Public Sub UploadFile(ByRef UploadClient As WebClient,
ByVal localfilepath As String,
Optional ByVal filepath As String = Nothing,
Optional ByVal Asynchronous As Boolean = False)
If filepath Is Nothing Then
filepath = Me.host & "/" & New IO.FileInfo(localfilepath).Name
ElseIf filepath.StartsWith("/") Then
filepath = Me.host & filepath
Else
filepath = Me.host & "/" & filepath
End If
With UploadClient
.Credentials = New NetworkCredential(Me.user, Me.pass)
If Asynchronous Then
.UploadFileAsync(New Uri(filepath), "STOR", localfilepath)
Else
.UploadFile(New Uri(filepath), "STOR", localfilepath)
End If
End With
End Sub
''' <summary>
''' Downloads a file from FTP.
''' </summary>
''' <param name="DownloadClient">Indicates the WebClient object to download the file.</param>
''' <param name="filepath">Indicates the ftp fle path.</param>
''' <param name="localfilepath">Specifies the local path where to save the downloaded file.</param>
''' <param name="Asynchronous">Indicates whether the download should be an Asynchronous operation,
''' to raise WebClient events.</param>
Public Sub DownloadFile(ByRef DownloadClient As WebClient,
ByVal filepath As String,
ByVal localfilepath As String,
Optional ByVal Asynchronous As Boolean = False)
If filepath.StartsWith("/") Then
filepath = Me.host & filepath
Else
filepath = Me.host & "/" & filepath
End If
With DownloadClient
.Credentials = New NetworkCredential(Me.user, Me.pass)
If Asynchronous Then
.DownloadFileAsync(New Uri(filepath), localfilepath)
Else
.DownloadFile(New Uri(filepath), localfilepath)
End If
End With
End Sub
#End Region
#Region " Miscellaneous methods "
Private Shared Function InlineAssignHelper(Of T)(ByRef target As T, value As T) As T
target = value
Return value
End Function
#End Region
End Class
#End Region

VB.net - Simultaneous Audio

So I'm working on a simple VB.net game for school, in which you pop bubbles. We need to have a sound play when you pop a bubble, which is very simple with the audio play function;
Private Sub bubblePop(sender As Object, e As EventArgs) Handles bubble.Click
My.Computer.Audio.Play(My.Resources.pop, _
AudioPlayMode.Background)
End Sub
However we also have a little backing track for the game that we want to loop in the background infinitely. We tried this with a similar instance of that function;
Private Sub GameScreen_Load(sender As Object, e As EventArgs) Handles MyBase.Load
My.Computer.Audio.Play(My.Resources.musicLoop, _
AudioPlayMode.BackgroundLoop)
End Sub
The function shown above only allows one audio file to be played at once, meaning when a bubble is popped the music disappears for good.
I've tried using two seperate windows media player things, but that isn't working either;
Public pop As String = "pop.wav"
Public minesound As String = "mine.wav"
Public Sub soundEffects(sound)
If sound = pop Then
GameScreen.AxWindowsMediaPlayer2.URL = pop
ElseIf sound = minesound Then
GameScreen.AxWindowsMediaPlayer2.URL = minesound
End If
End Sub
Any help or advice is very appreciated! Thank you!
Basically you need to run an asynchronous operation to play more than one file at once.
I've started writting a solution using My.Computer method but even using a Task/Thread it seems that (strangely) is not sufficient to play a secondary file without stopping the playback of the first file ran so maybe other factor (unknown for me) could be involved, then I've solved it using MCI.
The usage can be this:
Dim TaskCancellationTokenSource As New CancellationTokenSource
Dim TaskToken As CancellationToken = TaskCancellationTokenSource.Token
Private Sub BubbleLoop(ByVal CancellationToken As Threading.CancellationToken)
Dim AudioFileLoop = New MCIPlayer(Me, "C:\BubbleLoop.wav")
Do Until CancellationToken.IsCancellationRequested
AudioFileLoop.Play(AudioPlayMode.WaitToComplete)
Loop
AudioFileLoop.Close()
End Sub
Private Sub Test()
' This plays a file asynchronously into an infinite loop.
Task.Factory.StartNew(Sub() BubbleLoop(TaskToken), TaskToken)
' Wait 2 seconds (just to demonstrate this example)
Threading.Thread.Sleep(2 * 1000)
' Play any other file while the loop is still playing.
Dim AudioFile = New MCIPlayer(Me, "C:\SingleBubble.mp3")
AudioFile.Play(AudioPlayMode.Background)
' Cancel the Bubble Loop.
TaskCancellationTokenSource.Cancel()
End Sub
And you need to add this basic MCI class that I've did (It's not full tsted):
' [ MCI Player ]
'
' // By Elektro H#cker
#Region " Usage Examples "
'Dim AudioFile As New MCIPlayer(Me, "C:\Audio.wav")
'AudioFile.Play(AudioPlayMode.BackgroundLoop)
'Dim sb As New System.Text.StringBuilder
'sb.AppendLine("Filename: " & AudioFile.Filename)
'sb.AppendLine("State...: " & AudioFile.State.ToString)
'sb.AppendLine("Mode....: " & AudioFile.PlaybackMode.ToString)
'sb.AppendLine("Channels: " & CStr(AudioFile.Channels))
'sb.AppendLine("Duration: " & TimeSpan.FromMilliseconds(AudioFile.Duration).ToString("hh\:mm\:ss"))
'MessageBox.Show(sb.ToString, "MCI Player", MessageBoxButtons.OK, MessageBoxIcon.Information)
'AudioFile.Stop()
#End Region
#Region " MCI Player "
''' <summary>
''' Play Wave, MP3 or MIDI files
''' </summary>
Public Class MCIPlayer
Inherits NativeWindow
Implements IDisposable
#Region " API "
''' <summary>
''' Sends a command string to an MCI device.
''' The device that the command is sent to is specified in the command string.
''' </summary>
''' <param name="command">
''' Pointer to a null-terminated string that specifies an MCI command string.
''' For a list, see Multimedia Command Strings.
''' </param>
''' <param name="buffer">
''' Buffer that receives return information.
''' If no return information is needed, this parameter can be NULL.
''' </param>
''' <param name="bufferSize">
''' Size, in characters, of the return buffer specified.
''' </param>
''' <param name="hwndCallback">
''' Handle to a callback window if the "notify" flag was specified in the command string.
''' </param>
<System.Runtime.InteropServices.
DllImport("winmm.dll", SetLastError:=True)>
Private Shared Function mciSendString(
ByVal command As String,
ByVal buffer As System.Text.StringBuilder,
ByVal bufferSize As Integer,
ByVal hwndCallback As IntPtr
) As Integer
End Function
#End Region
#Region " Variables "
''' <summary>
''' The form to manage Windows Messages.
''' </summary>
Private WithEvents form As Form = Nothing
''' <summary>
''' Indicates the audio play command of mciSendString.
''' </summary>
Private PlayCommand As String = String.Empty
''' <summary>
''' Buffer that receives return information.
''' </summary>
Private ReturnInfo As New System.Text.StringBuilder() With {.Capacity = 255}
''' <summary>
''' The current filename of the file that is to be played.
''' </summary>
Private _filename As String = String.Empty
''' <summary>
''' Indicates the current playback mode.
''' </summary>
Private _PlaybackMode As AudioPlayMode
''' <summary>
''' Flag to cancel the BackgroundLoop PlaybackMode.
''' </summary>
Private CancelLoop As Boolean = False
#End Region
#Region " Properties "
''' <summary>
''' The current filename of the file that is to be played.
''' </summary>
Public Property Filename() As String
Get
Return _filename
End Get
Set(ByVal value As String)
If Not IO.File.Exists(value) Then
Throw New IO.FileNotFoundException
Exit Property
End If
_filename = value
End Set
End Property
''' <summary>
''' Gets che current Playback State.
''' </summary>
Public ReadOnly Property State As PlaybackState
Get
mciSendString("status file mode", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
Return [Enum].Parse(GetType(PlaybackState), ReturnInfo.ToString, True)
End Get
End Property
''' <summary>
''' Gets or sets the playback mode of the current file.
''' </summary>
Public Property PlaybackMode As AudioPlayMode
Get
Return _PlaybackMode
End Get
Set(value As AudioPlayMode)
_PlaybackMode = value
End Set
End Property
''' <summary>
''' Gets the channels of the file.
''' </summary>
ReadOnly Property Channels() As Integer
Get
mciSendString("status file channels", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
Return If(IsNumeric(ReturnInfo.ToString),
CInt(ReturnInfo.ToString),
-1)
End Get
End Property
''' <summary>
''' Gets the file duration in Milleseconds.
''' </summary>
ReadOnly Property Duration() As Integer
Get
mciSendString("set file time format milliseconds", Nothing, 0, IntPtr.Zero)
mciSendString("status file length", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
Return If(String.IsNullOrEmpty(ReturnInfo.ToString), 0, CInt(ReturnInfo.ToString))
End Get
End Property
#End Region
#Region " Enumerations "
''' <summary>
''' Audio File playback state.
''' </summary>
Public Enum PlaybackState As Short
''' <summary>
''' File is playing.
''' </summary>
Playing = 0
''' <summary>
''' File is paused.
''' </summary>
Paused = 1
''' <summary>
''' File is stopped.
''' </summary>
Stopped = 2
End Enum
''' <summary>
''' Windows Message Identifiers.
''' </summary>
Public Enum KnownMessages As Integer
''' <summary>
''' Notifies an application that an MCI device has completed an operation.
''' MCI devices send this message only when the MCI_NOTIFY flag is used.
''' </summary>
MM_MCINOTIFY = 953
End Enum
#End Region
#Region " Constructor "
''' <summary>
''' Play Wave, MP3 or MIDI files.
''' </summary>
''' <param name="AudioFile">Indicates the filename of the media to play.</param>
''' <remarks></remarks>
Public Sub New(ByVal form As Form, ByVal AudioFile As String)
Me.Filename = AudioFile
' Set the Formulary.
Me.form = form
' Assign the form handle.
SetFormHandle()
End Sub
#End Region
#Region " Public Methods "
''' <summary>
''' Plays the file that is specified as the filename.
''' </summary>
''' <remarks></remarks>
Public Sub Play(ByVal PlayMode As AudioPlayMode)
DisposedCheck()
Select Case PlayMode
Case AudioPlayMode.Background
PlayCommand = "play file from 0"
Me.PlaybackMode = AudioPlayMode.Background
Case AudioPlayMode.BackgroundLoop
PlayCommand = "play file from 0 notify"
Me.PlaybackMode = AudioPlayMode.BackgroundLoop
Case AudioPlayMode.WaitToComplete
PlayCommand = "play file from 0 wait"
Me.PlaybackMode = AudioPlayMode.WaitToComplete
End Select
' Open command
Select Case Me.Filename.Split(".").LastOrDefault
Case "mp3"
mciSendString(String.Format("open ""{0}"" type mpegvideo alias file", Me.Filename),
Nothing,
0,
IntPtr.Zero)
Case "wav"
mciSendString(String.Format("open ""{0}"" type waveaudio alias file", Me.Filename),
Nothing,
0,
IntPtr.Zero)
Case "mid", "midi"
mciSendString("stop midi", Nothing, 0, 0)
mciSendString("close midi", Nothing, 0, 0)
mciSendString(String.Format("open sequencer! ""{0}"" alias file", Me.Filename),
Nothing,
0, IntPtr.Zero)
Case Else
Throw New Exception("File type not supported.")
[Close]()
End Select
' Play command
mciSendString(PlayCommand, Nothing, 0, If(PlaybackMode = AudioPlayMode.BackgroundLoop,
Me.Handle,
IntPtr.Zero))
End Sub
''' <summary>
''' Pause the current playback.
''' </summary>
''' <remarks></remarks>
Public Sub Pause()
DisposedCheck()
CancelLoop = True
mciSendString("pause file", Nothing, 0, IntPtr.Zero)
End Sub
''' <summary>
''' Resume the current playback if it is currently paused.
''' </summary>
Public Sub [Resume]()
DisposedCheck()
If Me.State = PlaybackState.Paused Then
CancelLoop = False
mciSendString("resume file", Nothing, 0, IntPtr.Zero)
End If
End Sub
''' <summary>
''' Stop the current playback.
''' </summary>
Public Sub [Stop]()
DisposedCheck()
CancelLoop = True
mciSendString("stop file", Nothing, 0, IntPtr.Zero)
End Sub
''' <summary>
''' Close the current file.
''' </summary>
Public Overloads Sub [Close]()
DisposedCheck()
CancelLoop = True
mciSendString("close file", Nothing, 0, IntPtr.Zero)
End Sub
#End Region
#Region " Event Handlers "
''' <summary>
''' Assign the handle of the target form to this NativeWindow,
''' necessary to override WndProc.
''' </summary>
Private Sub SetFormHandle() _
Handles form.HandleCreated, form.Load, form.Shown
Try
If Not Me.Handle.Equals(Me.form.Handle) Then
Me.AssignHandle(Me.form.Handle)
End If
Catch ' ex As InvalidOperationException
End Try
End Sub
''' <summary>
''' Releases the Handle.
''' </summary>
Private Sub OnHandleDestroyed() _
Handles form.HandleDestroyed
Me.ReleaseHandle()
End Sub
#End Region
#Region " Windows Messages "
''' <summary>
''' Processes Windows messages for this Window.
''' </summary>
''' <param name="m">
''' Contains the Windows Message parameters.
''' </param>
Protected Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
If m.Msg = KnownMessages.MM_MCINOTIFY Then
If Not CancelLoop Then
Play(AudioPlayMode.BackgroundLoop)
Else
CancelLoop = False
End If
End If
End Sub
#End Region
#Region " IDisposable "
''' <summary>
''' To detect redundant calls when disposing.
''' </summary>
Private IsDisposed As Boolean = False
''' <summary>
''' Prevents calls to methods after disposing.
''' </summary>
Private Sub DisposedCheck()
If Me.IsDisposed Then
Throw New ObjectDisposedException(Me.GetType().FullName)
End If
End Sub
''' <summary>
''' Disposes the objects generated by this instance.
''' </summary>
Public Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
' IDisposable
Protected Overridable Sub Dispose(IsDisposing As Boolean)
If Not Me.IsDisposed Then
If IsDisposing Then
[Close]()
Me.form = Nothing
Me.ReleaseHandle()
Me.DestroyHandle()
End If
End If
Me.IsDisposed = True
End Sub
#End Region
End Class
#End Region

Playing Audio if Killing a file is successful

When I kill a file using:
Private Sub Form1_Load()
Kill(file)
for example, how would I then play a sound after that
Thanks
Will
My.Computer.Audio.PlaySystemSound(Media.SystemSounds.Exclamation)
or
My.Computer.Audio.Play(filename)
...Or you could use mci.
' Class: PlayFile
' Written By: Blake Pell (bpell#indiana.edu)
' Initial Date: 03/31/2007
' Last Updated: 02/04/2009
Usage;
' PlayFile
'
' Examples:
' Dim Audio As New PlayFile("C:\File.mp3")
' Audio.Play()
' Audio.Pause()
' Audio.Resume()
' Audio.Stop()
#Region " PlayFile Class"
''' <summary>
''' This class is a wrapper for the Windows API calls to play wave, midi or mp3 files.
''' </summary>
''' <remarks>
''' </remarks>
Public Class PlayFile
' Windows API Declarations
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Int32, ByVal hwndCallback As Int32) As Int32
''' <summary>
''' Constructor: Location is the filename of the media to play. Wave files and Mp3 files are the supported formats.
''' </summary>
''' <param name="Location"></param>
''' <remarks></remarks>
Public Sub New(ByVal location As String)
Me.Filename = location
End Sub
''' <summary>
''' Plays the file that is specified as the filename.
''' </summary>
''' <remarks></remarks>
Public Sub Play()
If _filename = "" Or Filename.Length <= 4 Then Exit Sub
Select Case Right(Filename, 3).ToLower
Case "mp3"
mciSendString("open """ & _filename & """ type mpegvideo alias audiofile", Nothing, 0, IntPtr.Zero)
Dim playCommand As String = "play audiofile from 0"
If _wait = True Then playCommand += " wait"
mciSendString(playCommand, Nothing, 0, IntPtr.Zero)
Case "wav"
mciSendString("open """ & _filename & """ type waveaudio alias audiofile", Nothing, 0, IntPtr.Zero)
mciSendString("play audiofile from 0", Nothing, 0, IntPtr.Zero)
Case "mid", "idi"
mciSendString("stop midi", "", 0, 0)
mciSendString("close midi", "", 0, 0)
mciSendString("open sequencer!" & _filename & " alias midi", "", 0, 0)
mciSendString("play midi", "", 0, 0)
Case Else
Throw New Exception("File type not supported.")
Call Close()
End Select
IsPaused = False
End Sub
''' <summary>
''' Pause the current play back.
''' </summary>
''' <remarks></remarks>
Public Sub Pause()
mciSendString("pause audiofile", Nothing, 0, IntPtr.Zero)
IsPaused = True
End Sub
''' <summary>
''' Resume the current play back if it is currently paused.
''' </summary>
''' <remarks></remarks>
Public Sub [Resume]()
mciSendString("resume audiofile", Nothing, 0, IntPtr.Zero)
IsPaused = False
End Sub
''' <summary>
''' Stop the current file if it's playing.
''' </summary>
''' <remarks></remarks>
Public Sub [Stop]()
mciSendString("stop audiofile", Nothing, 0, IntPtr.Zero)
End Sub
''' <summary>
''' Close the file.
''' </summary>
''' <remarks></remarks>
Public Sub Close()
mciSendString("close audiofile", Nothing, 0, IntPtr.Zero)
End Sub
Private _wait As Boolean = False
''' <summary>
''' Halt the program until the .wav file is done playing. Be careful, this will lock the entire program up until the
''' file is done playing. It behaves as if the Windows Sleep API is called while the file is playing (and maybe it is, I don't
''' actually know, I'm just theorizing). :P
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Wait() As Boolean
Get
Return _wait
End Get
Set(ByVal value As Boolean)
_wait = value
End Set
End Property
''' <summary>
''' Sets the audio file's time format via the mciSendString API.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property Milleseconds() As Integer
Get
Dim buf As String = Space(255)
mciSendString("set audiofile time format milliseconds", Nothing, 0, IntPtr.Zero)
mciSendString("status audiofile length", buf, 255, IntPtr.Zero)
buf = Replace(buf, Chr(0), "") ' Get rid of the nulls, they muck things up
If buf = "" Then
Return 0
Else
Return CInt(buf)
End If
End Get
End Property
''' <summary>
''' Gets the status of the current playback file via the mciSendString API.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property Status() As String
Get
Dim buf As String = Space(255)
mciSendString("status audiofile mode", buf, 255, IntPtr.Zero)
buf = Replace(buf, Chr(0), "") ' Get rid of the nulls, they muck things up
Return buf
End Get
End Property
''' <summary>
''' Gets the file size of the current audio file.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property FileSize() As Integer
Get
Try
Return My.Computer.FileSystem.GetFileInfo(_filename).Length
Catch ex As Exception
Return 0
End Try
End Get
End Property
''' <summary>
''' Gets the channels of the file via the mciSendString API.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property Channels() As Integer
Get
Dim buf As String = Space(255)
mciSendString("status audiofile channels", buf, 255, IntPtr.Zero)
If IsNumeric(buf) = True Then
Return CInt(buf)
Else
Return -1
End If
End Get
End Property
''' <summary>
''' Used for debugging purposes.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
ReadOnly Property Debug() As String
Get
Dim buf As String = Space(255)
mciSendString("status audiofile channels", buf, 255, IntPtr.Zero)
Return Str(buf)
End Get
End Property
Private _isPaused As Boolean = False
''' <summary>
''' Whether or not the current playback is paused.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property IsPaused() As Boolean
Get
Return _isPaused
End Get
Set(ByVal value As Boolean)
_isPaused = value
End Set
End Property
Private _filename As String
''' <summary>
''' The current filename of the file that is to be played back.
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Filename() As String
Get
Return _filename
End Get
Set(ByVal value As String)
If My.Computer.FileSystem.FileExists(value) = False Then
Throw New System.IO.FileNotFoundException
Exit Property
End If
_filename = value
End Set
End Property
End Class
#End Region

Force datagridviewcell that host a numeric updown revert it changed on escape key press

I'm creating a datagridviewcell that host a numeric updown control. Everything went fine except one thing. I can't revert changed on escape key press like textboxcell or comboboxcell. My datagridviewcell was created base on this example. So anyone have any idea how to revert numeric updown cell to previous value on escape key press?
NumericColumn class:
Imports System
Imports System.Windows.Forms
Public Class NumericColumn
Inherits DataGridViewColumn
''' <summary>
''' Get, set numeric control min value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property MinValue() As Decimal
Get
Return CType(MyBase.CellTemplate, NumericCell).MinValue
End Get
Set(ByVal value As Decimal)
CType(MyBase.CellTemplate, NumericCell).MinValue = value
End Set
End Property
''' <summary>
''' Get, set numeric control max value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property MaxValue() As Decimal
Get
Return CType(MyBase.CellTemplate, NumericCell).MaxValue
End Get
Set(ByVal value As Decimal)
CType(MyBase.CellTemplate, NumericCell).MaxValue = value
End Set
End Property
''' <summary>
''' Get, set numeric control value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property NumericControlValue() As Decimal
Get
Return CType(MyBase.CellTemplate, NumericCell).NumericControlValue
End Get
Set(ByVal value As Decimal)
CType(MyBase.CellTemplate, NumericCell).NumericControlValue = value
End Set
End Property
''' <summary>
''' Indicate number of decimal places to display
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property DecimalPlaces() As Integer
Get
Return CType(MyBase.CellTemplate, NumericCell).DecimalPlaces
End Get
Set(ByVal value As Integer)
CType(MyBase.CellTemplate, NumericCell).DecimalPlaces = value
End Set
End Property
''' <summary>
''' Detemine the value to increment or decrement each time button click
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Increment() As Integer
Get
Return CType(MyBase.CellTemplate, NumericCell).Increment
End Get
Set(ByVal value As Integer)
CType(MyBase.CellTemplate, NumericCell).Increment = value
End Set
End Property
Public Sub New()
MyBase.New(New NumericCell())
End Sub
Public Overrides Property CellTemplate() As DataGridViewCell
Get
Return MyBase.CellTemplate
End Get
Set(ByVal value As DataGridViewCell)
' Ensure that the cell used for the template is a CalendarCell.
If (value IsNot Nothing) AndAlso _
Not value.GetType().IsAssignableFrom(GetType(NumericCell)) _
Then
Throw New InvalidCastException("Must be a Numeric Cell")
End If
MyBase.CellTemplate = value
End Set
End Property
''' <summary>
''' Override clone method to clone new added properties
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Overrides Function Clone() As Object
Dim obj As NumericColumn = MyBase.Clone()
obj.MaxValue = Me.MaxValue
obj.MinValue = Me.MinValue
obj.NumericControlValue = Me.NumericControlValue
obj.DecimalPlaces = Me.DecimalPlaces
obj.Increment = Me.Increment
Return obj
End Function
End Class
NumericCell class
Imports System
Imports System.Windows.Forms
Public Class NumericCell
Inherits DataGridViewTextBoxCell
''' <summary>
''' Min value for numeric control
''' </summary>
''' <remarks></remarks>
Private min As Decimal = 0.0
''' <summary>
''' Max value for numeric control
''' </summary>
''' <remarks></remarks>
Private max As Decimal = 100.0
''' <summary>
''' Value for numeric control
''' </summary>
''' <remarks></remarks>
Private controlValue As Decimal = 0.0
''' <summary>
''' Decimal places for numeric control
''' </summary>
''' <remarks></remarks>
Private places As Integer = 0
''' <summary>
''' Detemine the value to increment or decrement each time button click
''' </summary>
''' <remarks></remarks>
Private incrementStep As Integer = 1
''' <summary>
''' Get, set numeric control min value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property MinValue() As Decimal
Get
Return Me.min
End Get
Set(ByVal value As Decimal)
Me.min = value
End Set
End Property
''' <summary>
''' Get, set numeric control max value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property MaxValue() As Decimal
Get
Return Me.max
End Get
Set(ByVal value As Decimal)
Me.max = value
End Set
End Property
''' <summary>
''' Get, set numeric control value
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property NumericControlValue() As Decimal
Get
Return Me.controlValue
End Get
Set(ByVal value As Decimal)
Me.controlValue = value
End Set
End Property
''' <summary>
''' Indicate number of decimal places to display
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property DecimalPlaces() As Integer
Get
Return Me.places
End Get
Set(ByVal value As Integer)
Me.places = value
End Set
End Property
''' <summary>
''' Detemine the value to increment or decrement each time button click
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Increment() As Integer
Get
Return Me.incrementStep
End Get
Set(ByVal value As Integer)
Me.incrementStep = value
End Set
End Property
Public Sub New()
End Sub
Public Overrides Sub InitializeEditingControl(ByVal rowIndex As Integer, _
ByVal initialFormattedValue As Object, _
ByVal dataGridViewCellStyle As DataGridViewCellStyle)
' Set the value of the editing control to the current cell value.
MyBase.InitializeEditingControl(rowIndex, initialFormattedValue, _
dataGridViewCellStyle)
Dim ctl As NumericEditingControl = CType(DataGridView.EditingControl, NumericEditingControl)
RemoveHandler ctl.Enter, AddressOf Me.OnNumericEnter
AddHandler ctl.Enter, AddressOf Me.OnNumericEnter
'config property for control
ctl.Minimum = Me.min
ctl.Maximum = Me.max
ctl.DecimalPlaces = Me.DecimalPlaces
ctl.Increment = Me.incrementStep
ctl.TextAlign = HorizontalAlignment.Right
ctl.ThousandsSeparator = True
' Use the default row value when Value property is null.
If (Me.Value Is Nothing) Then
ctl.Value = Me.controlValue
Else
ctl.Value = CType(Me.Value, Decimal)
End If
End Sub
''' <summary>
''' Handle on enter event of numeric
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub OnNumericEnter(ByVal sender As Object, ByVal e As EventArgs)
Dim control As NumericEditingControl = CType(sender, NumericEditingControl)
Dim strValue As String = control.Value.ToString("N2")
control.Select(0, strValue.Length)
End Sub
Public Overrides ReadOnly Property EditType() As Type
Get
' Return the type of the editing control that CalendarCell uses.
Return GetType(NumericEditingControl)
End Get
End Property
Public Overrides ReadOnly Property ValueType() As Type
Get
' Return the type of the value that CalendarCell contains.
Return GetType(String)
End Get
End Property
Public Overrides ReadOnly Property DefaultNewRowValue() As Object
Get
' Use the current date and time as the default value.
Return 0.0
End Get
End Property
''' <summary>
''' Override clone method to clone new added properties
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Overrides Function Clone() As Object
Dim obj As NumericCell = MyBase.Clone()
obj.MaxValue = Me.MaxValue
obj.MinValue = Me.MinValue
obj.NumericControlValue = Me.NumericControlValue
obj.DecimalPlaces = Me.DecimalPlaces
obj.Increment = Me.Increment
Return obj
End Function
End Class
NumericEditingControl class:
Imports System
Imports System.Windows.Forms
Public Class NumericEditingControl
Inherits NumericUpDown
Implements IDataGridViewEditingControl
Private dataGridViewControl As DataGridView
Private valueIsChanged As Boolean = False
Private rowIndexNum As Integer
Public Sub New()
'Me.Format = DateTimePickerFormat.Short
End Sub
Public Property EditingControlFormattedValue() As Object _
Implements IDataGridViewEditingControl.EditingControlFormattedValue
Get
Return Me.Value.ToString("N2")
End Get
Set(ByVal value As Object)
Try
' This will throw an exception of the string is
' null, empty, or not in the format of a date.
Me.Value = Decimal.Parse(value)
Catch
' In the case of an exception, just use the default
' value so we're not left with a null value.
Me.Value = 0.0
End Try
End Set
End Property
Public Function GetEditingControlFormattedValue(ByVal context _
As DataGridViewDataErrorContexts) As Object _
Implements IDataGridViewEditingControl.GetEditingControlFormattedValue
Return Me.Value.ToString("N2")
End Function
Public Sub ApplyCellStyleToEditingControl(ByVal dataGridViewCellStyle As _
DataGridViewCellStyle) _
Implements IDataGridViewEditingControl.ApplyCellStyleToEditingControl
Me.Font = dataGridViewCellStyle.Font
Me.ForeColor = dataGridViewCellStyle.ForeColor
Me.BackColor = dataGridViewCellStyle.BackColor
End Sub
Public Property EditingControlRowIndex() As Integer _
Implements IDataGridViewEditingControl.EditingControlRowIndex
Get
Return rowIndexNum
End Get
Set(ByVal value As Integer)
rowIndexNum = value
End Set
End Property
Public Function EditingControlWantsInputKey(ByVal key As Keys, _
ByVal dataGridViewWantsInputKey As Boolean) As Boolean _
Implements IDataGridViewEditingControl.EditingControlWantsInputKey
' Let the DateTimePicker handle the keys listed.
'Select Case key And Keys.KeyCode
' Case Keys.Left, Keys.Up, Keys.Down, Keys.Right, _
' Keys.Home, Keys.End, Keys.PageDown, Keys.PageUp
' Return True
' Case Else
' Return Not dataGridViewWantsInputKey
'End Select
If key.KeyCode = Keys.Escape Then
End If
Return True
End Function
Public Sub PrepareEditingControlForEdit(ByVal selectAll As Boolean) _
Implements IDataGridViewEditingControl.PrepareEditingControlForEdit
' No preparation needs to be done.
End Sub
Public ReadOnly Property RepositionEditingControlOnValueChange() _
As Boolean Implements _
IDataGridViewEditingControl.RepositionEditingControlOnValueChange
Get
Return False
End Get
End Property
Public Property EditingControlDataGridView() As DataGridView _
Implements IDataGridViewEditingControl.EditingControlDataGridView
Get
Return dataGridViewControl
End Get
Set(ByVal value As DataGridView)
dataGridViewControl = value
End Set
End Property
Public Property EditingControlValueChanged() As Boolean _
Implements IDataGridViewEditingControl.EditingControlValueChanged
Get
Return valueIsChanged
End Get
Set(ByVal value As Boolean)
valueIsChanged = value
End Set
End Property
Public ReadOnly Property EditingControlCursor() As Cursor _
Implements IDataGridViewEditingControl.EditingPanelCursor
Get
Return MyBase.Cursor
End Get
End Property
Protected Overrides Sub OnValueChanged(ByVal eventargs As EventArgs)
' Notify the DataGridView that the contents of the cell have changed.
valueIsChanged = True
Me.EditingControlDataGridView.NotifyCurrentCellDirty(True)
MyBase.OnValueChanged(eventargs)
End Sub
End Class
The part responsible to deal with this behaviour is EditingControlWantsInputKey. By looking at the original code it is clear that this part has to be set by default to false (= returning to the previously stored value), but in your code it is set to true. The idea is setting this to true only for ("special") keys which shouldn't provoke the scaping of the value; that is, you don't need to mention here scape, just any other key (triggering this function) which you don't want to provoke the coming-back-to-previous-value behaviour.
Thus, solution:
Public Function EditingControlWantsInputKey(ByVal key As Keys, _
ByVal dataGridViewWantsInputKey As Boolean) As Boolean _
Implements IDataGridViewEditingControl.EditingControlWantsInputKey
Return False
End Function