add :
btn1,btn2 3 labels listbox, textbox (chk multiline property), picture box, timer (2000 interval, enabled=true)
add class :
add morse class :
main code :
btn1,btn2 3 labels listbox, textbox (chk multiline property), picture box, timer (2000 interval, enabled=true)
add class :
Code:
Imports System.Runtime.InteropServices
Public Class WaveIn
#Region "API"
Private Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" _
(ByVal Err As Int32, ByVal Text As String, ByVal uSize As Int32) As Int32
Private Const MAXERRORLENGTH As Int32 = 128
Private Declare Function waveInGetNumDevs Lib "winmm" () As Int32
Private Declare Function waveInGetDevCaps Lib "winmm" Alias "waveInGetDevCapsA" (
ByVal uDeviceID As Int32, ByRef WaveInCapsPointer As WAVEINCAPS,
ByVal WaveInCapsStructSize As Int32) As Int32
Private Declare Function waveInOpen Lib "winmm" (ByRef phwi As IntPtr, ByVal uDeviceID As Int32,
ByRef pwfx As WAVEFORMATEX, ByVal CallBack As waveInProc, ByVal CallBackInstance As Int32,
ByVal fdwOpen As Int32) As Int32
Private Delegate Sub waveInProc(ByVal hwi As Int32, ByVal uMsg As UInt32, ByVal dwInstance As IntPtr,
ByVal dwParam1 As IntPtr, ByVal dwParam2 As IntPtr)
Private procWaveIn As waveInProc
Private Declare Function waveInClose Lib "winmm" (ByVal hwi As IntPtr) As Int32
Private Declare Function waveInStart Lib "winmm" (ByVal hwi As IntPtr) As Int32
Private Declare Function waveInReset Lib "winmm" (ByVal WaveDeviceInputHandle As IntPtr) As IntPtr
Private Declare Function waveInStop Lib "winmm" (ByVal WaveDeviceInputHandle As IntPtr) As IntPtr
Private Declare Function waveInAddBuffer Lib "winmm" (ByVal InputDeviceHandle As IntPtr,
ByVal WaveHdrPointer As IntPtr, ByVal WaveHdrStructSize As Int32) As Int32
Private Declare Function waveInPrepareHeader Lib "winmm" (ByVal InputDeviceHandle As IntPtr,
ByVal WaveHdrPointer As IntPtr, ByVal WaveHdrStructSize As Int32) As Int32
Private Declare Function waveInUnprepareHeader Lib "winmm" (ByVal InputDeviceHandle As IntPtr,
ByVal WaveHdrPointer As IntPtr, ByVal WaveHdrStructSize As Int32) As Int32
'header eines Aufnahme Buffers:
<StructLayout(LayoutKind.Sequential)>
Private Structure WAVEHDR
Public lpData As IntPtr
Public dwBufferLength As Int32
Public dwBytesRecorded As Int32
Public dwUser As Int32
Public dwFlags As Int32
Public dwLoops As Int32
Public lpNext As IntPtr
Public Reserved As Int32
End Structure
<StructLayout(LayoutKind.Sequential)>
Private Structure WAVEINCAPS
Public ManufacturerID As Int16
Public ProductID As Int16
Public DriverVersion As Int32
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)> Public ProductName As Char()
Public Formats As Int32
Public CHANNELS As Int16
Public Reserved As Int16
End Structure
<StructLayout(LayoutKind.Sequential)>
Private Structure WAVEFORMATEX
Public wFormatTag As Int16
Public nChannels As Int16
Public nSamplesPerSec As Int32
Public nAvgBytesPerSec As Int32
Public nBlockAlign As Int16
Public wBitsPerSample As Int16
Public cbSize As Int16
End Structure
Private Const CALLBACK_FUNCTION As Int32 = &H30000
Private Const CALLBACK_WINDOW As Int32 = &H10000
Private Const MM_WIM_CLOSE As Int32 = &H3BF
Private Const MM_WIM_DATA As Int32 = &H3C0
Private Const MM_WIM_OPEN As Int32 = &H3BE
Private Const WIM_OPEN As Int32 = MM_WIM_OPEN
Private Const WIM_DATA As Int32 = MM_WIM_DATA
Private Const WIM_CLOSE As Int32 = MM_WIM_CLOSE
Private Const WAVE_FORMAT_PCM As Int32 = &H1
#End Region
Event BufferFilled(Index As Int32)
Event Overflow()
Public isOverflow As Boolean 'indicates loss of data due to insufficient free buffers
Private udtRecordingFormat As WAVEFORMATEX
Private iWriteIndex As Int32 'index of the next buffer to be filled by the device
Private lReadIndex As Int32 'index of the filled next buffer to be read by the client
Private cBuffers As Int32 'number of buffers
Private cbBuffer As Int32 'size in bytes of one buffer
Private cFullBuffers As Int32 'number of filled buffers that have not yet been processed by the client
Private cbBufferHeader As Int32 'SizeOf(WAVEHDR)
Private lpBufferHeaders As IntPtr 'pointer to the heap memory storing the buffer headers. Size: cBuffers * cbBufferHeader (all in one block)
Private lpBufferData As IntPtr 'pointer to the heap memory storing the buffers. Size: cBuffers * cbBuffer (all in one block)
Private isRecording As Boolean
Private hOpenDevice As IntPtr 'Handle of the Audiodevice
Private WatcherThread As Threading.Thread
Public Sub New()
SetFormat(44100, 16, 2) 'default
End Sub
ReadOnly Property Recording As Boolean
Get
Return isRecording
End Get
End Property
Public Function GetDeviceNames() As String()
Dim sDevices(0 To waveInGetNumDevs - 1) As String
Dim WavCaps As New WAVEINCAPS
For i As Int32 = 0 To sDevices.Count - 1
waveInGetDevCaps(i, WavCaps, Marshal.SizeOf(WavCaps))
Dim sTemp As New String(WavCaps.ProductName)
sDevices(i) = sTemp.Substring(0, sTemp.IndexOf(Convert.ToChar(0)))
Next
Return sDevices
End Function
Public Sub SetFormat(SamplesPerSec As Int32, BitsPerSample As Int16, CHANNELS As Int16)
With udtRecordingFormat
.cbSize = 0
.nChannels = CHANNELS
.nSamplesPerSec = SamplesPerSec
.wBitsPerSample = BitsPerSample
.nBlockAlign = Convert.ToInt16(BitsPerSample / 8 * CHANNELS)
.nAvgBytesPerSec = .nSamplesPerSec * .nBlockAlign
.wFormatTag = WAVE_FORMAT_PCM
End With
End Sub
Public Function Prepare(DeviceID As Int32, BufferCount As Int32, BufferSize As Int32) As Boolean
'Open device and add audio buffers
Unprepare() 'just in case
cBuffers = BufferCount
cbBuffer = BufferSize
Dim dwApiResult As Int32
procWaveIn = AddressOf MyWaveInProc
dwApiResult = waveInOpen(hOpenDevice, DeviceID, udtRecordingFormat, procWaveIn, 0, CALLBACK_FUNCTION)
If Not dwApiResult = 0 Then
Unprepare()
Throw New Exception(FormatWaveError(dwApiResult))
End If
'prepare buffers and pass them to the device:
Dim udt As New WAVEHDR With {.dwBufferLength = cbBuffer, .dwFlags = 0}
cbBufferHeader = Marshal.SizeOf(udt)
lpBufferHeaders = Marshal.AllocHGlobal(cbBufferHeader * cBuffers)
lpBufferData = Marshal.AllocHGlobal(cbBuffer * cBuffers)
dwApiResult = 0
For i As Int32 = 0 To cBuffers - 1
udt.dwUser = i 'buffer index in dwUser
udt.lpData = lpBufferData + i * cbBuffer
Marshal.StructureToPtr(udt, lpBufferHeaders + i * cbBufferHeader, False)
dwApiResult = dwApiResult Or waveInPrepareHeader(hOpenDevice, lpBufferHeaders + i * cbBufferHeader, cbBufferHeader)
dwApiResult = dwApiResult Or waveInAddBuffer(hOpenDevice, lpBufferHeaders + i * cbBufferHeader, cbBufferHeader)
Next
If dwApiResult <> 0 Then
Unprepare() 'there was an issue preparing the buffers
Throw New Exception("waveInPrepareHeader/waveInAddBuffer Error!")
End If
isOverflow = False
cFullBuffers = 0
Return (dwApiResult = 0)
End Function
Public Function StartRecording() As Boolean
WatcherThread = New Threading.Thread(AddressOf Watcher)
WatcherThread.Start()
isRecording = (waveInStart(hOpenDevice) = 0)
Return isRecording
End Function
Public Function GetData() As Byte()
'returns a copy of the recorded data. if multiple buffers are completed,
'it returns the entire data of all finished buffers.
'the processed buffers are added back to the device
Dim cFullBuffersTemp As Int32
Dim cbUsedUpper As Int32
Dim cbUsedLower As Int32
Dim btData(0) As Byte
Dim udt As WAVEHDR
If cFullBuffers > 0 Then
cFullBuffersTemp = cFullBuffers 'cFullBuffers may change during execution
'sum the length of all finished buffers
For i As Int32 = 0 To cFullBuffersTemp - 1
udt = DirectCast(Marshal.PtrToStructure(lpBufferHeaders + (lReadIndex + i) * cbBufferHeader, GetType(WAVEHDR)), WAVEHDR)
If lReadIndex + i < cBuffers Then
cbUsedUpper += udt.dwBytesRecorded
Else
cbUsedLower += udt.dwBytesRecorded
End If
Next
ReDim btData(cbUsedLower + cbUsedUpper - 1)
'copy the data
If cbUsedLower > 0 Then
'two blocks
Marshal.Copy(lpBufferData, btData, cbUsedUpper, cbUsedLower)
End If
udt = DirectCast(Marshal.PtrToStructure(lpBufferHeaders + lReadIndex * cbBufferHeader, GetType(WAVEHDR)), WAVEHDR)
Marshal.Copy(udt.lpData, btData, 0, cbUsedUpper)
'add buffers back to the device
Do While cFullBuffersTemp > 0
DoneBuffer()
cFullBuffersTemp -= 1
Loop
End If
Return btData
End Function
Private Sub DoneBuffer()
'adds the buffer iReadIndex back to the device buffer chain
If cFullBuffers > 0 Then
cFullBuffers -= 1
Dim dwApiResult As Int32 = waveInAddBuffer(hOpenDevice, lpBufferHeaders + lReadIndex * cbBufferHeader, cbBufferHeader)
If dwApiResult <> 0 Then
Throw New Exception("WaveInDoneBuffer waveInAddBuffer Error: " & FormatWaveError(dwApiResult))
End If
lReadIndex += 1
If lReadIndex = cBuffers Then
lReadIndex = 0
End If
End If
End Sub
Public Sub StopRecording()
If Not hOpenDevice.Equals(IntPtr.Zero) Then
waveInStop(hOpenDevice)
waveInReset(hOpenDevice)
isOverflow = False
End If
If WatcherThread IsNot Nothing Then
WatcherThread.Abort()
WatcherThread = Nothing
End If
isRecording = False
End Sub
Public Sub Unprepare()
StopRecording()
If Not hOpenDevice.Equals(IntPtr.Zero) Then
For i As Int32 = 0 To cBuffers - 1
waveInUnprepareHeader(hOpenDevice, lpBufferHeaders + i * cbBufferHeader, cbBufferHeader)
Next
Marshal.FreeHGlobal(lpBufferData)
Marshal.FreeHGlobal(lpBufferHeaders)
If waveInClose(hOpenDevice) = 0 Then
hOpenDevice = Nothing
Else
Throw New Exception("Error closing the device!")
End If
End If
iWriteIndex = 0
lReadIndex = 0
End Sub
Private Sub MyWaveInProc(hDevice As Int32, uMsg As UInt32, dwInstance As IntPtr, dwParam1 As IntPtr, dwParam2 As IntPtr)
'Low Level Wave In Proc
'MSDN: "Applications should not call any system-defined functions from inside a callback function" so keep it simple
Select Case uMsg
Case WIM_OPEN
Case WIM_CLOSE
Case WIM_DATA
cFullBuffers += 1
iWriteIndex += 1
If iWriteIndex = cBuffers Then
iWriteIndex = 0
End If
If iWriteIndex = lReadIndex Then
isOverflow = True
End If
End Select
End Sub
Private Sub Watcher()
Do
If cFullBuffers > 0 Then
RaiseEvent BufferFilled(iWriteIndex)
End If
If isOverflow Then
RaiseEvent Overflow()
End If
Threading.Thread.Sleep(10)
Loop
End Sub
Private Function FormatWaveError(ErrCode As Int32) As String
Dim sTemp As New String(" "c, MAXERRORLENGTH)
waveInGetErrorText(ErrCode, sTemp, MAXERRORLENGTH)
Return sTemp.Substring(0, sTemp.IndexOf(Convert.ToChar(0)))
End Function
End Classadd morse class :
Code:
Public Class morse
Public Shared Function Code(ByVal user As String) As String
Dim result As String = ""
For index = 0 To user.Length - 1
result &= charToMorse(user(index))
Next
Return result
End Function
Private Shared Function charToMorse(ByVal x As Char) As String
Dim result As String = ""
Select Case x
Case "a"
result = "*-"
Case "b"
result = "-***"
Case "c"
result = "-*-*"
Case "d"
result = "-**"
Case "e"
result = "*"
Case "f"
result = "**-*"
Case "g"
result = "--*"
Case "h"
result = "****"
Case "i"
result = "**"
Case "j"
result = "*---"
Case "k"
result = "-*-"
Case "l"
result = "*-**"
Case "m"
result = "--"
Case "n"
result = "-*"
Case "o"
result = "---"
Case "p"
result = "*--*"
Case "q"
result = "--*-"
Case "r"
result = "*-*"
Case "s"
result = "***"
Case "t"
result = "-"
Case "u"
result = "**-"
Case "v"
result = "***-"
Case "w"
result = "*--"
Case "x"
result = "-**-"
Case "y"
result = "-*--"
Case "z"
result = "--**"
Case "0"
result = "-----"
Case "1"
result = "*----"
Case "2"
result = "**---"
Case "3"
result = "***--"
Case "4"
result = "****-"
Case "5"
result = "*****"
Case "6"
result = "-****"
Case "7"
result = "--***"
Case "8"
result = "---**"
Case "9"
result = "----*"
Case "."
result = "*-*-*-"
Case ","
result = "--**--"
Case "?"
result = "**--**"
Case " "
result = "/"
Case Else
End Select
Return result & "/"
End Function
Public Shared Function decoder(ByVal msg As String) As String
Dim result As String = ""
Dim morseChr As String = ""
For index = 0 To msg.Length - 1
If msg(index) <> "/" Then
morseChr &= msg(index)
Else
result &= morseCharToChar(morseChr)
morseChr = ""
End If
Next
result = result.Replace(" ", " ")
'result = result.replaceAll(" ", " ")
Return result
End Function
Private Shared Function morseCharToChar(ByVal x As String) As Char
Dim result As Char = "@"
Select Case x
Case "*-"
result = "a"
Case "-***"
result = "b"
Case "-*-*"
result = "c"
Case "-**"
result = "d"
Case "*"
result = "e"
Case "**-*"
result = "f"
Case "--*"
result = "g"
Case "****"
result = "h"
Case "**"
result = "i"
Case "*---"
result = "j"
Case "-*-"
result = "k"
Case "*-**"
result = "l"
Case "--"
result = "m"
Case "-*"
result = "n"
Case "---"
result = "o"
Case "*--*"
result = "p"
Case "--*-"
result = "q"
Case "*-*"
result = "r"
Case "***"
result = "s"
Case "-"
result = "t"
Case "**-"
result = "u"
Case "***-"
result = "v"
Case "*--"
result = "w"
Case "-**-"
result = "x"
Case "-*--"
result = "y"
Case "--**"
result = "z"
Case "-----"
result = "0"
Case "*----"
result = "1"
Case "**---"
result = "2"
Case "***--"
result = "3"
Case "****-"
result = "4"
Case "*****"
result = "5"
Case "-****"
result = "6"
Case "--***"
result = "7"
Case "---**"
result = "8"
Case "----*"
result = "9"
Case "*-*-*-"
result = "."
Case "--**--"
result = ","
Case "**--**"
result = "?"
Case "/"
result = " "
Case Else
End Select
If result = "@" Then
result = " "
End If
Return result
End Function
Public Shared Function netLingo(ByVal str1 As String) As String
Dim result As String = str1
If str1.Contains("h w") Then
Return str1.Replace("h w", "hello world")
End If
If str1.Contains("x o x o") Then
Return str1.Replace("x o x o", "hugs And kisses")
End If
Return result
End Function
End Classmain code :
Code:
Public Class Form1
'needs: a listview called ListView1
' two buttons, one called btnStart, the other btnStop
' a PictureBox called PictureBox1
Dim isVolume As Boolean = False ' is volume ?
Dim quietCount As Integer = 0
Dim volCount As Integer = 0
Dim volumeLimes As Double = 0.2
Dim charTime As Integer = 20 ' time to wait for char B4 sending word
Dim slashCount As Integer = 0
Dim morseLength As Integer = 0
Private WithEvents oWaveIn As New WaveIn
'Private oStream As IO.FileStream
Private maxAmplitude As Int32
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
'get the list of input devices and display in listview
Dim s() As String = oWaveIn.GetDeviceNames()
s.ToList.ForEach(Sub(sName)
ListView1.Items.Add(sName)
End Sub)
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If ListView1.SelectedItems.Count = 0 OrElse ListView1.SelectedItems.Count > 1 Then
MessageBox.Show("Select one Device")
Exit Sub
End If
'set the desired recording format to 44.1kHz, 16Bit Stereo
oWaveIn.SetFormat(44100, 16, 2)
Dim iDevice As Int32 = ListView1.SelectedItems(0).Index
oWaveIn.Prepare(iDevice, 60, 4410) '60 x 4410 Bytes=2205 16 bit samples = 50ms @44100 * 60 = 3 seconds audio
'LameMp3Convert.InitLame()
'oStream = New IO.FileStream("c:\kill\recording.mp3", IO.FileMode.Create)
oWaveIn.StartRecording()
Button1.Enabled = False
Button2.Enabled = True
End Sub
Private Sub o_BufferFull(Index As Integer) Handles oWaveIn.BufferFilled
'Label1.Invoke(Sub()
' Label1.Text = Index.ToString
' End Sub)
Dim bt As Byte() = oWaveIn.GetData()
'Dim btEncoded As Byte() = LameMp3Convert.EncodeBlock(bt, bt.Length)
'oStream.Write(btEncoded, 0, btEncoded.Length)
'get the max amplitude from the data
maxAmplitude = 0
For i As Int32 = 0 To bt.Length - 1 Step 2
Dim val As Int16 = Convert.ToInt16(bt(i + 1)) << 8 Or bt(i)
If Math.Abs(CInt(val)) > maxAmplitude Then
maxAmplitude = Math.Abs(CInt(val))
End If
Next
PictureBox1.Invalidate()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
oWaveIn.StopRecording()
oWaveIn.Unprepare()
'oStream.Close()
Button2.Enabled = False
Button1.Enabled = True
End Sub
Private Sub oWaveIn_Overflow() Handles oWaveIn.Overflow
Me.Invoke(Sub()
Me.BackColor = Color.Red
End Sub)
End Sub
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
Dim db As Double = -4.5198 / (20 * Math.Log10(maxAmplitude / (Int16.MaxValue + 1)))
db = If(Double.IsInfinity(db), 1, db)
e.Graphics.FillRectangle(Brushes.Gray, New Rectangle(0, 0, PictureBox1.Width, PictureBox1.Height))
e.Graphics.FillRectangle(Brushes.LawnGreen, New Rectangle(0, 0, CInt(PictureBox1.Width * db), PictureBox1.Height))
'Label1.Text = db
isVolume = db > volumeLimes
If isVolume Then ' listening
quietCount = 0
If volCount < charTime Then
volCount += 1
End If
ElseIf quietCount < chartime Then ' char
If volCount > 0 And volCount < charTime Then
morseLabel.Text &= "*"
ElseIf volCount >= chartime Then
morseLabel.Text &= "-"
End If
volCount = 0
slashCount = 0
ElseIf quietCount > 1 Then ' not 0 (= word silence time)
If slashCount < 3 Then
morseLabel.Text &= "/"
slashCount += 1
End If
End If
If Not isVolume Then ' separate char or word ?
quietCount += 1
End If
If morseLabel.Text.Length > 50 Then 'clear ear
decodeLbl.Text = morse.decoder(morseLabel.Text)
netLingoLbl.Text = morse.netLingo(decodeLbl.Text)
morseLabel.Text = "" ' decode
End If
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
If morseLabel.Text.Length = morseLength Then
' if contains data add char to sentence
If morseLabel.Text.Contains("*") Or morseLabel.Text.Contains("-") Then
decodeLbl.Text = morse.decoder(morseLabel.Text)
netLingoLbl.Text &= morse.netLingo(decodeLbl.Text)
Else ' no data sentence ended
decodeLbl.Text = ""
TextBox1.Text &= netLingoLbl.Text
If TextBox1.MaxLength > 50000 Then
TextBox1.Clear()
End If
netLingoLbl.Text = ""
End If
morseLabel.Text = ""
End If
morseLength = morseLabel.Text.Length
End Sub
End Class