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
Related
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
I am looking for an automatic method to create a shortcut to a network connection in Windows 7. I do not believe this is the same as a shortcut to a file.
I would prefer it to be in vb.net, but anything (VBS, PowerShell, etc...) would be fine.
I came up with the following script, but it requires you to click yes.
Const CSIDL_CONNECTIONS = &H31
Dim objShell As Object = CreateObject("Shell.Application")
Dim objConnectionsFolder = objShell.NameSpace(CSIDL_CONNECTIONS)
For Each objConnection In objConnectionsFolder.Items
If objConnection.name = "Local Area Connection" Then
Dim colVerbs = objConnection.Verbs
For Each objVerb In colVerbs
If Replace(objVerb.name, "&", "") = "Create Shortcut" Then
objVerb.DoIt()
End If
Next
End If
Next
MsgBox("If the script ends too quickly then it doesn't finish.")
Any Suggestions would be greatly appreciated.
Powershell:
$WshShell = New-Object -comObject WScript.Shell
$Shortcut = $WshShell.CreateShortcut("C:\somepath\shortcutName.lnk"));
$Shortcut.TargetPath = "\\server\path";
$Shortcut.Save();
In VB.NET you could try to use my Shortcut Manager Helper Class.
Usage:
Dim Shortcut As New ShortcutManager.ShortcutInfo
With Shortcut
.ShortcutFile = "C:\New shortcut.lnk"
.Target = "\\server\path"
.Description = "Shortcut Description"
.Icon = "Icon.ico"
.IconIndex = 0
End With
ShortcutManager.CreateShortcut(Shortcut)
The Class is partially defined 'cause the character limit of StackOverflow (if you want the full version then go this link):
' ***********************************************************************
' Author : Elektro
' Modified : 02-16-2014
' ***********************************************************************
' <copyright file="ShortcutManager.vb" company="Elektro Studios">
' Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************
#Region " Imports "
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.IO
#End Region
#Region " ShortcutManager "
''' <summary>
''' Performs Shortcut related operations.
''' </summary>
Public Class ShortcutManager
#Region " Variables "
Private Shared lnk As New ShellLink()
Private Shared lnk_data As New WIN32_FIND_DATAW()
Private Shared lnk_arguments As New StringBuilder(260)
Private Shared lnk_description As New StringBuilder(260)
Private Shared lnk_target As New StringBuilder(260)
Private Shared lnk_workingdir As New StringBuilder(260)
Private Shared lnk_iconpath As New StringBuilder(260)
Private Shared lnk_iconindex As Integer = -1
Private Shared lnk_hotkey As Short = -1
Private Shared lnk_windowstate As ShortcutWindowState = ShortcutWindowState.Normal
#End Region
#Region " P/Invoke "
<DllImport("shfolder.dll", CharSet:=CharSet.Auto)>
Private Shared Function SHGetFolderPath(
ByVal hwndOwner As IntPtr,
ByVal nFolder As Integer,
ByVal hToken As IntPtr,
ByVal dwFlags As Integer,
ByVal lpszPath As StringBuilder
) As Integer
End Function
<Flags()>
Private Enum SLGP_FLAGS
''' <summary>
''' Retrieves the standard short (8.3 format) file name.
''' </summary>
SLGP_SHORTPATH = &H1
''' <summary>
''' Retrieves the Universal Naming Convention (UNC) path name of the file.
''' </summary>
SLGP_UNCPRIORITY = &H2
''' <summary>
''' Retrieves the raw path name.
''' A raw path is something that might not exist and may include environment variables that need to be expanded.
''' </summary>
SLGP_RAWPATH = &H4
End Enum
<Flags()>
Private Enum SLR_FLAGS
''' <summary>
''' Do not display a dialog box if the link cannot be resolved. When SLR_NO_UI is set,
''' the high-order word of fFlags can be set to a time-out value that specifies the
''' maximum amount of time to be spent resolving the link. The function returns if the
''' link cannot be resolved within the time-out duration. If the high-order word is set
''' to zero, the time-out duration will be set to the default value of 3,000 milliseconds
''' (3 seconds). To specify a value, set the high word of fFlags to the desired time-out
''' duration, in milliseconds.
''' </summary>
SLR_NO_UI = &H1
''' <summary>
''' If the link object has changed, update its path and list of identifiers.
''' If SLR_UPDATE is set, you do not need to call IPersistFile::IsDirty to determine,
''' whether or not the link object has changed.
''' </summary>
SLR_UPDATE = &H4
''' <summary>
''' Do not update the link information
''' </summary>
SLR_NOUPDATE = &H8
''' <summary>
''' Do not execute the search heuristics
''' </summary>
SLR_NOSEARCH = &H10
''' <summary>
''' Do not use distributed link tracking
''' </summary>
SLR_NOTRACK = &H20
''' <summary>
''' Disable distributed link tracking.
''' By default, distributed link tracking tracks removable media,
''' across multiple devices based on the volume name.
''' It also uses the Universal Naming Convention (UNC) path to track remote file systems,
''' whose drive letter has changed.
''' Setting SLR_NOLINKINFO disables both types of tracking.
''' </summary>
SLR_NOLINKINFO = &H40
''' <summary>
''' Call the Microsoft Windows Installer
''' </summary>
SLR_INVOKE_MSI = &H80
End Enum
''' <summary>
''' Stores information about a shortcut file.
''' </summary>
Public Class ShortcutInfo
''' <summary>
''' Shortcut file full path.
''' </summary>
Public Property ShortcutFile As String
''' <summary>
''' Shortcut Comment/Description.
''' </summary>
Public Property Description As String
''' <summary>
''' Shortcut Target Arguments.
''' </summary>
Public Property Arguments As String
''' <summary>
''' Shortcut Target.
''' </summary>
Public Property Target As String
''' <summary>
''' Shortcut Working Directory.
''' </summary>
Public Property WorkingDir As String
''' <summary>
''' Shortcut Icon Location.
''' </summary>
Public Property Icon As String
''' <summary>
''' Shortcut Icon Index.
''' </summary>
Public Property IconIndex As Integer
''' <summary>
''' Shortcut Hotkey combination.
''' Is represented as Hexadecimal.
''' </summary>
Public Property Hotkey As Short
''' <summary>
''' Shortcut Hotkey modifiers.
''' </summary>
Public Property Hotkey_Modifier As HotkeyModifiers
''' <summary>
''' Shortcut Hotkey Combination.
''' </summary>
Public Property Hotkey_Key As Keys
''' <summary>
''' Shortcut Window State.
''' </summary>
Public Property WindowState As ShortcutWindowState
''' <summary>
''' Indicates if the target is a file.
''' </summary>
Public Property IsFile As Boolean
''' <summary>
''' Indicates if the target is a directory.
''' </summary>
Public Property IsDirectory As Boolean
''' <summary>
''' Shortcut target drive letter.
''' </summary>
Public Property DriveLetter As String
''' <summary>
''' Shortcut target directory name.
''' </summary>
Public Property DirectoryName As String
''' <summary>
''' Shortcut target filename.
''' (File extension is not included in name)
''' </summary>
Public Property FileName As String
''' <summary>
''' Shortcut target file extension.
''' </summary>
Public Property FileExtension As String
End Class
''' <summary>
''' Hotkey modifiers for a shortcut file.
''' </summary>
<Flags()>
Public Enum HotkeyModifiers As Short
''' <summary>
''' The SHIFT key.
''' </summary>
SHIFT = 1
''' <summary>
''' The CTRL key.
''' </summary>
CONTROL = 2
''' <summary>
''' The ALT key.
''' </summary>
ALT = 4
''' <summary>
''' None.
''' Specifies any hotkey modificator.
''' </summary>
NONE = 0
End Enum
''' <summary>
''' The Window States for a shortcut file.
''' </summary>
Public Enum ShortcutWindowState As Integer
''' <summary>
''' Shortcut Window is at normal state.
''' </summary>
Normal = 1
''' <summary>
''' Shortcut Window is Maximized.
''' </summary>
Maximized = 3
''' <summary>
''' Shortcut Window is Minimized.
''' </summary>
Minimized = 7
End Enum
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
Private Structure WIN32_FIND_DATAW
Public dwFileAttributes As UInteger
Public ftCreationTime As Long
Public ftLastAccessTime As Long
Public ftLastWriteTime As Long
Public nFileSizeHigh As UInteger
Public nFileSizeLow As UInteger
Public dwReserved0 As UInteger
Public dwReserved1 As UInteger
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)>
Public cFileName As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=14)>
Public cAlternateFileName As String
End Structure
''' <summary>
''' The IShellLink interface allows Shell links to be created, modified, and resolved
''' </summary>
<ComImport(),
InterfaceType(ComInterfaceType.InterfaceIsIUnknown),
Guid("000214F9-0000-0000-C000-000000000046")>
Private Interface IShellLinkW
''' <summary>
''' Retrieves the path and file name of a Shell link object.
''' </summary>
Sub GetPath(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszFile As StringBuilder,
ByVal cchMaxPath As Integer,
ByRef pfd As WIN32_FIND_DATAW,
ByVal fFlags As SLGP_FLAGS)
''' <summary>
''' Retrieves the list of item identifiers for a Shell link object.
''' </summary>
Sub GetIDList(ByRef ppidl As IntPtr)
''' <summary>
''' Sets the pointer to an item identifier list (PIDL) for a Shell link object.
''' </summary>
Sub SetIDList(ByVal pidl As IntPtr)
''' <summary>
''' Retrieves the description string for a Shell link object.
''' </summary>
Sub GetDescription(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszName As StringBuilder,
ByVal cchMaxName As Integer)
''' <summary>
''' Sets the description for a Shell link object.
''' The description can be any application-defined string.
''' </summary>
Sub SetDescription(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszName As String)
''' <summary>
''' Retrieves the name of the working directory for a Shell link object.
''' </summary>
Sub GetWorkingDirectory(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszDir As StringBuilder,
ByVal cchMaxPath As Integer)
''' <summary>
''' Sets the name of the working directory for a Shell link object.
''' </summary>
Sub SetWorkingDirectory(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszDir As String)
''' <summary>
''' Retrieves the command-line arguments associated with a Shell link object.
''' </summary>
Sub GetArguments(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszArgs As StringBuilder,
ByVal cchMaxPath As Integer)
''' <summary>
''' Sets the command-line arguments for a Shell link object.
''' </summary>
Sub SetArguments(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszArgs As String)
''' <summary>
''' Retrieves the hot key for a Shell link object.
''' </summary>
Sub GetHotkey(ByRef pwHotkey As Short)
''' <summary>
''' Sets a hot key for a Shell link object.
''' </summary>
Sub SetHotkey(ByVal wHotkey As Short)
''' <summary>
''' Retrieves the show command for a Shell link object.
''' </summary>
Sub GetShowCmd(ByRef piShowCmd As Integer)
''' <summary>
''' Sets the show command for a Shell link object.
''' The show command sets the initial show state of the window.
''' </summary>
Sub SetShowCmd(ByVal iShowCmd As ShortcutWindowState)
''' <summary>
''' Retrieves the location (path and index) of the icon for a Shell link object.
''' </summary>
Sub GetIconLocation(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszIconPath As StringBuilder,
ByVal cchIconPath As Integer,
ByRef piIcon As Integer)
''' <summary>
''' Sets the location (path and index) of the icon for a Shell link object.
''' </summary>
Sub SetIconLocation(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszIconPath As String,
ByVal iIcon As Integer)
''' <summary>
''' Sets the relative path to the Shell link object.
''' </summary>
Sub SetRelativePath(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszPathRel As String,
ByVal dwReserved As Integer)
''' <summary>
''' Attempts to find the target of a Shell link,
''' even if it has been moved or renamed.
''' </summary>
Sub Resolve(ByVal hwnd As IntPtr,
ByVal fFlags As SLR_FLAGS)
''' <summary>
''' Sets the path and file name of a Shell link object
''' </summary>
Sub SetPath(ByVal pszFile As String)
End Interface
<ComImport(), Guid("0000010c-0000-0000-c000-000000000046"),
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Private Interface IPersist
<PreserveSig()>
Sub GetClassID(ByRef pClassID As Guid)
End Interface
<ComImport(), Guid("0000010b-0000-0000-C000-000000000046"),
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Private Interface IPersistFile
Inherits IPersist
Shadows Sub GetClassID(ByRef pClassID As Guid)
<PreserveSig()>
Function IsDirty() As Integer
<PreserveSig()>
Sub Load(<[In](), MarshalAs(UnmanagedType.LPWStr)>
pszFileName As String,
dwMode As UInteger)
<PreserveSig()>
Sub Save(<[In](), MarshalAs(UnmanagedType.LPWStr)>
pszFileName As String,
<[In](), MarshalAs(UnmanagedType.Bool)>
fRemember As Boolean)
<PreserveSig()>
Sub SaveCompleted(<[In](), MarshalAs(UnmanagedType.LPWStr)>
pszFileName As String)
<PreserveSig()>
Sub GetCurFile(<[In](), MarshalAs(UnmanagedType.LPWStr)>
ppszFileName As String)
End Interface
' "CLSID_ShellLink" from "ShlGuid.h"
<ComImport(),
Guid("00021401-0000-0000-C000-000000000046")>
Private Class ShellLink
End Class
#End Region
#Region " Public Methods "
''' <summary>
''' Creates a shortcut file.
''' </summary>
''' <param name="FilePath">
''' The filepath to create the shortcut.
''' </param>
''' <param name="Target">
''' The target file or directory.
''' </param>
''' <param name="WorkingDirectory">
''' The working directory os the shortcut.
''' </param>
''' <param name="Description">
''' The shortcut description.
''' </param>
''' <param name="Arguments">
''' The target file arguments.
''' This value only should be set when target is an executable file.
''' </param>
''' <param name="Icon">
''' The icon location of the shortcut.
''' </param>
''' <param name="IconIndex">
''' The icon index of the icon file.
''' </param>
''' <param name="HotKey_Modifier">
''' The hotkey modifier(s) which should be used for the hotkey combination.
''' <paramref name="HotkeyModifiers"/> can be one or more modifiers.
''' </param>
''' <param name="HotKey_Key">
''' The key used in combination with the <paramref name="HotkeyModifiers"/> for hotkey combination.
''' </param>
''' <param name="WindowState">
''' The Window state for the target.
''' </param>
Public Shared Sub CreateShortcut(ByVal FilePath As String,
ByVal Target As String,
Optional ByVal WorkingDirectory As String = Nothing,
Optional ByVal Description As String = Nothing,
Optional ByVal Arguments As String = Nothing,
Optional ByVal Icon As String = Nothing,
Optional ByVal IconIndex As Integer = Nothing,
Optional ByVal HotKey_Modifier As HotkeyModifiers = Nothing,
Optional ByVal HotKey_Key As Keys = Nothing,
Optional ByVal WindowState As ShortcutWindowState = ShortcutWindowState.Normal)
' Load Shortcut
LoadShortcut(FilePath)
' Clean objects
Clean()
' Set Shortcut Info
DirectCast(lnk, IShellLinkW).SetPath(Target)
DirectCast(lnk, IShellLinkW).SetWorkingDirectory(If(WorkingDirectory IsNot Nothing,
WorkingDirectory,
Path.GetDirectoryName(Target)))
DirectCast(lnk, IShellLinkW).SetDescription(Description)
DirectCast(lnk, IShellLinkW).SetArguments(Arguments)
DirectCast(lnk, IShellLinkW).SetIconLocation(Icon, IconIndex)
DirectCast(lnk, IShellLinkW).SetHotkey(If(HotKey_Modifier + HotKey_Key <> 0,
Convert.ToInt16(CInt(HotKey_Modifier & Hex(HotKey_Key)), 16),
Nothing))
DirectCast(lnk, IShellLinkW).SetShowCmd(WindowState)
DirectCast(lnk, IPersistFile).Save(FilePath, True)
DirectCast(lnk, IPersistFile).SaveCompleted(FilePath)
End Sub
''' <summary>
''' Creates a shortcut file.
''' </summary>
''' <param name="Shortcut">Indicates a ShortcutInfo object.</param>
Public Shared Sub CreateShortcut(ByVal Shortcut As ShortcutInfo)
CreateShortcut(Shortcut.ShortcutFile,
Shortcut.Target,
Shortcut.WorkingDir,
Shortcut.Description,
Shortcut.Arguments,
Shortcut.Icon,
Shortcut.IconIndex,
Shortcut.Hotkey_Modifier,
Shortcut.Hotkey_Key,
Shortcut.WindowState)
End Sub
#End Region
#Region " Private Methods "
''' <summary>
''' Loads the shortcut object to retrieve information.
''' </summary>
''' <param name="ShortcutFile">
''' The shortcut file to retrieve the info.
''' </param>
Private Shared Sub LoadShortcut(ByVal ShortcutFile As String)
DirectCast(lnk, IPersistFile).Load(ShortcutFile, 0)
End Sub
''' <summary>
''' Clean the shortcut info objects.
''' </summary>
Private Shared Sub Clean()
lnk_description.Clear()
lnk_arguments.Clear()
lnk_target.Clear()
lnk_workingdir.Clear()
lnk_iconpath.Clear()
lnk_hotkey = -1
lnk_iconindex = -1
End Sub
''' <summary>
''' Gets the low order byte of a number.
''' </summary>
Private Shared Function GetLoByte(ByVal Intg As Integer) As Integer
Return Intg And &HFF&
End Function
''' <summary>
''' Gets the high order byte of a number.
''' </summary>
Private Shared Function GetHiByte(ByVal Intg As Integer) As Integer
Return (Intg And &HFF00&) / 256
End Function
#End Region
End Class
#End Region
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
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
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...