Audio Recorder - Select Recording Device - VB.Net - vb.net

I'm trying to create an audio recorder using VB.Net.
This is how I'm doing it:
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
mciSendString("set recsound samplespersec 11025 channels 2 bitspersample 16 alignment 4 bytespersec 44100", vbNullString, 0, 0)
mciSendString("record capture", vbNullString, 0, 0)
Label1.Text = "Recording..."
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
mciSendString("save recsound c:\recsound.wav", "", 0, 0)
mciSendString("close recsound", "", 0, 0)
Label1.Text = "Stopped."
End Sub
It works fine, the only problem is that I have two mics, one of them is built-in and the other one is connected via USB. The second one has a way better recording quality but this application always records from the built-in mic.
I've searched all over the internet and I can't find a way to select the recording device. The only thing I was able to find was:
Dim DeviceId As Integer = 2
mciSendString("set recsound input " & DeviceId.ToString())
I've tried different values to no avail.
I have also tried the following code that successfully listed all the properties of all the recording devices found in my computer but I couldn't find anything that could help:
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Dim objSearcher As New System.Management.ManagementObjectSearcher("SELECT * FROM Win32_SoundDevice")
Dim objCollection As System.Management.ManagementObjectCollection = objSearcher.Get()
Me.TextBox1.Text = ""
For Each obj As ManagementObject In objCollection
Me.TextBox1.Text &= "---------------------------------" & vbCrLf
For Each myProperty As PropertyData In obj.Properties
Me.TextBox1.Text &= myProperty.Name & " - " & myProperty.Value & vbCrLf
Next
Next
End Sub
Any suggestions will be appreciated.

I realize that you asked this question almost two years ago and so you may never see this answer. Perhaps you have notifications turned on and this may help you.
I have switched to Naudio (available through Nuget) for my recording applications and have had much better luck with it. I can specify the recording device as follows:
waveIn = New WaveIn
waveIn.DeviceNumber = 0 '0 - Stereo Mix, 1 - Microphone, 2 - Line In
Figure out what device number your USB microphone is and use that. Do a search on "Naudio" and you will find example code.

Related

Trying to programmatically hold a key down

I'm trying to write an app to perform some basic process automation by sending keyboard events (i.e. simulating single key presses as well as holding keys down) to a window in focus (any window, such as Notepad). I can get single key presses to work just fine, but I can't get it to hold a key down. Even if I do a key down event, followed by a lengthy delay, followed by a key up... all I get is a single keypress.
I've read so many tutorials, and many of them multiple times over to ensure I haven't missed something. Every single time however, all I get is a single key press, it fails to hold the key down.
The following is a code sample I found from:
https://social.msdn.microsoft.com/Forums/vstudio/en-US/bad5b1f3-cf59-4a2b-889b-257ee590bf99/vb-advanced-key-bot?forum=vbgeneral
What I'm expecting to have happen is that it would send a keyboard event that tells the system to hold down a key (e.g. aaaaaaaaaaaaaaaaaaaa), but all I get is a single character. I've tried spamming the system with repeat keypresses, but the receiving app sees the different keyboard code for keydowns and keyups, as opposed to a key in a held status, and thus is not responding as though the key were actually held key down.
What am I doing wrong? Did they maybe change this dll?
A huge thanks to anyone who can help me get this working.
Public Class Form1
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Integer, ByVal wMapType As Integer) As Integer
' flag to indicate completion
Dim finished As Boolean = True
' how long to 'press' the Space key
Dim delay As Integer = 3
' how many times to repeat Q and Space
Dim Repeats As Integer
' User closes application during processing
Dim UserInterupt As Boolean = False
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
KeyPreview = True
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
If Not finished Then
TextBox1.AppendText("USER closing" & vbCrLf)
UserInterupt = True
e.Cancel = True
End If
End Sub
Private Sub Form1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Me.KeyPress
Select Case e.KeyChar
Case "z", "Z"
e.Handled = True
Repeats = 12
finished = False
Do While Not finished
TextBox1.AppendText("Pressing SPACE" & vbCrLf)
HoldKeyDown(Keys.Space, delay)
Loop
Case "x", "X"
e.Handled = True
TextBox1.AppendText("USER stopping" & vbCrLf)
finished = True
End Select
End Sub
Private Sub HoldKeyDown(ByVal k As Keys, ByVal Hold As Integer)
Dim HoldFor As DateTime = DateTime.Now().AddSeconds(Hold)
keybd_event(k, MapVirtualKey(k, 0), 0, 0)
While HoldFor.Subtract(DateTime.Now()).TotalSeconds > 0
Application.DoEvents()
End While
keybd_event(k, MapVirtualKey(k, 0), 2, 0)
TextBox1.AppendText("SPACE released" & vbCrLf)
Repeats -= 1
If Repeats = 0 Then
finished = True
TextBox1.AppendText("REPEATS completed" & vbCrLf)
End If
If UserInterupt Then End
End Sub
End Class
Answering my own question after going right down the rabbit hole on this one.
Basically put, the only way to do this is with SendKeys. The other methods are all deprecated and so will not work in this way anymore.
However this isn't a dead-end for you. If you want to use SendKeys to "hold down" a key, then spam the key at 10ms intervals and this should trigger the receiving app to think the key is held down.

How can I stream the microphone in real-time?

I have a program I'm writing which has a Server and a Client to communicate with each other to stream a microphone in real-time.
This is how it works
The user opens the client.exe, and their computer appears on the server, which is where I can operate the microphone (I'm NOT using this on other people).
When I press "listen" I can hear the clients microphone.
This is the code I'm using to listen to the clients microphone
CLIENT APPLICATION
Private Declare Function mmciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
Case "scream1"
mmciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
mmciSendString("record recsound", "", 0, 0)
Case "scream1stop"
mmciSendString("save recsound " + screamx, "", 0, 0)
mmciSendString("close recsound", "", 0, 0)
Dim n As New IO.FileInfo(screamx)
Comet.Send("scream2" & Yy & n.Name & Yy & Convert.ToBase64String(IO.File.ReadAllBytes(screamx)))
Comet.Send("screamf" & Yy & n.Name & Yy & Convert.ToBase64String(IO.File.ReadAllBytes(screamx)))
My.Computer.Audio.Stop()
SERVER APPLICATION
Timer2.Enabled = True
Timer3.Enabled = True
Private Sub Timer3_Tick(sender As Object, e As EventArgs) Handles Timer3.Tick
Form1.S.Send(xxx, "scream1")
Timer1.Enabled = True
Timer3.Enabled = False
Timer3.Enabled = True
End Sub
Private Sub BunifuFlatButton3_Click(sender As Object, e As EventArgs) Handles BunifuFlatButton3.Click
BunifuFlatButton2.Show()
BunifuFlatButton3.Hide()
Form1.S.Send(xxx, "scream1stop")
Timer1.Enabled = False
Timer2.Enabled = False
Timer3.Enabled = False
End Sub
Of course, there is other code which communicates with the server, but I don't think it's necessary at this point in time.
So, that code I provided you with, it listens for the microphone, but doesn't stream my own microphone. So, how can I do this?
Are there any good .dll add-ons for Visual Basic to do this task?
If I haven't made this clear enough, please comment below.
Thanks!

Shift Keys Stays Pressed in Windows Embedded Handheld 6.5 Classic

I'm writing a program for a handheld barcode scanner which uses Windows Embedded Handheld 6.5 Classic.
I have added a LinkLabel on my form and have coded it so that when you press Shift and click the link it brings up an input box for you to enter a password (I'll be replacing this with an actual form eventually but it is an InputBox for the time being)
When I let go of shift and begin to type my password using the physical keys (it is currently a 4 digit number) it treats the first character as though I am still holding shift.
Is there any way, in code, to revert it back so that shift isn't pressed?
I have tried to use the keybd_event api and it doesn't seem to work
This is what I've tried but I can't seem to find anything else to try.
Public Declare Sub keybd_event Lib "coredll.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
Private Sub lblTitle_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles lblTitle.Click
Try
If GetKeyState(Keys.ShiftKey) = 0 Then Exit Sub
Dim StaffPassword as String = "1234"
Dim _Continue As Boolean = False
keybd_event(VK_Shift, 0, KEYEVENTF_KEYDOWN, 0)
keybd_event(VK_Shift, 0, KEYEVENTF_KEYUP, 0)
Do Until _Continue
Dim _Password As String = InputBox("Please enter the staff password to go into the Admin Screen.", "Enter Password", "", True)
If Not _Password = StaffPassword Then
Dim _Ans As MsgBoxResult = MsgBox("You entered an incorrect password!" & vbNewLine & vbNewLine & "Would you like to try again?", MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo, "Incorrect Password")
If _Ans = MsgBoxResult.No Then Exit Sub
Else
_Continue = True
End If
Loop
frmAdmin.ShowDialog()
Catch ex As Exception
MsgBox(ex.ToString, MsgBoxStyle.Critical, "Error")
End Try
End Sub
Please could someone help?
I know you want to revert the shift effect but maybe a simple workaround could do it. I'm only suggesting this approach because windows ce devices often have non-standard (hardware) keyboards whose drivers are not always perfect.
Since you are only expecting numbers you could try to detect a non-number char and map it to the corresponding number on the keyboard.

How to play 2 different sounds at the same time?(Visual basic)

I have a problem about a game. I want to play a background sound and another sound when you click a button. When this happens, the background sound stops and the 2nd sound starts. When the 2nd sound finishes, no sound will be played.
You can see my code below:
Imports System.Media.SoundPlayer
Public Class GamePlaying
Dim mainmenusndplayer As New System.Media.SoundPlayer
Private Sub GamePlaying_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
MainMenu.Show()
mainmenusndplayer.Stop()
End Sub
Private Sub btn_Fire_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btn_Fire.Click
btn_Fire.Enabled = False
Dim shotsound As New System.Media.SoundPlayer
shotsound.Stream = My.Resources.TankShoot
shotsound.Play()
End Sub
Private Sub GamePlaying_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
mainmenusndplayer.Stream = My.Resources.WoT_Roll_Out
mainmenusndplayer.Load()
mainmenusndplayer.PlayLooping()
End Sub
End Class
I had been struggling with the same issue.....
The short answer is you can't. The system will only permit one channel to the sound interface within any given process. As such, when you start a new sound, the previous one terminates.
There are a number of work-arounds which mostly use either Direct-X or Media-Player. However, I found neither of those solutions to be either easy or robust in that you are depending on the users machine to have the right things installed.
However, I found a quick and simple solution to the problem.
I added a special "hook" to my application so that when I run it with an appropriate command line argument, all it does is play a particular sound and quit. I then use the process object to start another instance of the application with the appropriate argument.. and hey presto.. multiple sounds.
If your application is configured to automatically be be a single instance, you need to disable that and replace it with a little code to detect another instance and quit.
Another alternative is to add a small exe to your application package that simply does the sound part.
I know it does not sound very "pure", but really, all you are doing is starting a process to play a sound in the background. It doesn't really matter if that process is a windows native function or one of your own making.
you can use winmm.dll with mciSendString :
Imports System.Text
Imports System.Runtime.InteropServices
<DllImport("winmm.dll")>
Private Shared Function mciSendString(ByVal command As String, ByVal buffer As
StringBuilder, ByVal bufferSize As Integer, ByVal hwndCallback As IntPtr) As Integer
End Function
Private Sub MyForm_Click(sender As Object, e As EventArgs) Handles Me.Click
mciSendString("open " & Chr(34) & "C:\myFile1.wav" & Chr(34) " type waveaudio alias Sound1" & internalName, Nothing, 0, IntPtr.Zero)
mciSendString("open " & Chr(34) & "C:\myFile2.wav" & Chr(34) " type waveaudio alias Sound2" & internalName, Nothing, 0, IntPtr.Zero)
mciSendString("play Sound1", Nothing, 0, Me.Handle.ToInt64())
mciSendString("play Sound2", Nothing, 0, Me.Handle.ToInt64())
mciSendString("setaudio Sound1 volume to 1000", Nothing, 0, Me.Handle.ToInt64())
mciSendString("setaudio Sound2 volume to 1000", Nothing, 0, Me.Handle.ToInt64())
End Sub
and to stop the sounds you have to :
mciSendString("close Name1", Nothing, 0, Me.Handle.ToInt64())
mciSendString("close Name2", Nothing, 0, Me.Handle.ToInt64())
Download winmm.dll at https://www.dll-files.com/winmm.dll.html

VB.NET Upload to FTP with progressbar

I relise there is so many other questions out there regarding the progressbar, though I've looked through them "all" and can not find one that works.
I am trying to upload c:\screenshot.png to my ftp with a progress bar and a msgbox once finished.
Could someone provide a working example for me?
Thankyou
Edit heres the code I tried. Uploading works, though the progress bar dosent.
Sub UpdateProgressBar(ByVal sender As Object, ByVal e As UploadProgressChangedEventArgs)
If ProgressBar1.InvokeRequired Then
ProgressBar1.Invoke(New UploadProgressChangedEventHandler(AddressOf UpdateProgressBar), sender, e)
Exit Sub
End If
ProgressBar1.Value = CInt(ProgressBar1.Minimum + _
((ProgressBar1.Maximum - ProgressBar1.Minimum) * _
e.ProgressPercentage) / 100)
End Sub
Private Sub btnUpload_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click
Label16.Text = "Uploading now..."
Label16.Update()
Dim client As New System.Net.WebClient()
AddHandler client.UploadProgressChanged, AddressOf UpdateProgressBar
With client
.Credentials = New NetworkCredential( _
"damon#slimar.eu", "mine123!")
.UploadFile("ftp://slimar.eu/screenshot.png", "C:\screenshot.png")
End With
Label16.Text = "Done!"
Label16.Update()
End Sub
Progress bar has minValue,Max value, StepValue which is used to perform a step and Value to setup arbitray value.When you uploading a file or downloading you should be able to see via e paramenter total byte and actual byte trasmission.So you can setup Progress bar value and max value.
Also personally i invite you to use backgroundworker which :
Not Freeze GUI
Give you much controll on thread with no issue and no invoke needs
Make it more simple :)