win7: Recording from microphone ? [waveIn not working]

Windows specific questions.
Post Reply
Mihail_B
Posts: 273
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:
Contact Mihail_B

win7: Recording from microphone ? [waveIn not working]

Post by Mihail_B »

I had a program for recording waves ...
it was using waveIn to achive that...

But it's not working in windows 7 [and vista]...
(waveInOpen returns no error but when i read for stream it returns "bulk"$%#@)

@chung: Does anyone knows how to use MCI_RECORD with mciSendCommand ? it seams this could be the only solution ...

Thanks !
Happy coding
Last edited by Mihail_B on Mar 08, 2012 6:21, edited 1 time in total.
Top
VANYA
Posts: 1834
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:
Contact VANYA

Post by VANYA »

Try this:

Code: Select all

Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" ( _ 
     Byval lpstrCommand As String, _ 
     Byval lpstrReturnString As String, _ 
     Byval uReturnLength As Long, _ 
     Byval hwndCallback As Long) As Long 
Print "If cancel record, press any key"  
mciSendString("open new type waveaudio alias mywav", "", 0, 0)
mciSendString("record mywav", "", 0, 0)
Sleep
mciSendString("stop mywav", "", 0, 0)
mciSendString("save mywav c:\cdtest.wav", "", 0, 0)
mciSendString("close mywav", "", 0, 0)
Or this:

Code: Select all

Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" ( _ 
     Byval lpstrCommand As String, _ 
     Byval lpstrReturnString As String, _ 
     Byval uReturnLength As Long, _ 
     Byval hwndCallback As Long) As Long 
Print "If cancel record, press any key"  
mciSendString("OPEN NEW TYPE WAVEAUDIO ALIAS rec", "", 0, 0)
mciSendString("set rec bitspersample 8 samplespersec 8000 channels 1", "", 0, 0)
mciSendString("record rec", "", 0, 0)
Sleep
mciSendString("STOP rec", "", 0, 0)
mciSendString("SAVE rec temp.wav", "", 0, 0)
mciSendString("CLOSE rec", "", 0, 0)
Other examples are:

http://freebasic-world.narod.ru/mcisendstring.html
Top
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

Re: win7: Recoring from microphone ? [waveIn not working]

Post by D.J.Peters »

Mihail_B wrote:But it's not working in windows 7 [and vista]...
you are sure ?

if not I think you have a memory problem
(recording outsite a buffer or something similar)

may be not detected on XP but on Win 7

Joshy
Top
Mihail_B
Posts: 273
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:
Contact Mihail_B

Post by Mihail_B »

This is perfect ! it works fine ...

PS: well I had to turn back the whole internet until I found how to view the disabled recoding devices [under vista/win7] ;
and then I had to realise that for some reasons I can't record from netbook's internal microphone just like that [but soundrecorder can why not me ?!] and I had to use external microphone ....

anyway ... your links helped me a lot ... Now I'm smarter than I was before I posted this thread ... :D
Top
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

Post by D.J.Peters »

can you test this on win 7 please
(i have only XP and some Linux boxes)

by the way nice FreeBASIC class example
'
' main
'
dim as WAVEIN_DEVICE Recorder
sleep

thank you

Joshy

Code: Select all

#include once "windows.bi"
#include once "win/mmsystem.bi"

#define DEBUG

#ifdef DEBUG
#define DPRINT(txt) OPEN ERR FOR OUTPUT AS #99:print #99,txt:close #99
#else
#define DPRINT(txt) :
#endif

'  #################
' # WAVEIN_DEVICE #
'#################
type WAVEIN_DEVICE
  declare constructor(DeviceIndex as integer=-1) ' default = WAVE_MAPPER
  declare destructor
  as short ptr pSamples
  as integer   nSamples,nRecordedBuffers

  private:
  declare static sub WaveInProc(hDevice   as HWAVEIN, _
                                DriverMsg as uinteger, _
                                pDevice   as WAVEIN_DEVICE ptr, _
                                pBuffer   as PWAVEHDR, _
                                Param2    as DWORD)
  declare sub PrepareBuffer(pBuffer as PWAVEHDR) 
  as WAVEFORMATEX     wfex
  as WAVEINCAPS       Caps
  as HWAVEIN          hDevice
  as MMRESULT         LastResult
  as PWAVEHDR ptr     Buffers
  as integer          IsOpen,IsRunning
  as integer          nBuffers,nSamplesPerbuffer
end type

' setup 44100 16 bit 2 channels
constructor WAVEIN_DEVICE(DeviceIndex as integer)
  dprint("WAVEIN_DEVICE()")
  nBuffers=32
  nSamplesPerBuffer = 1024
  LastResult = waveInGetDevCaps(DeviceIndex, _
                                @Caps, _
                                sizeof(WAVEINCAPS))
  if (LastResult=MMSYSERR_NOERROR) then

    with wfex
    .wFormatTag      = WAVE_FORMAT_PCM
    .nSamplesPerSec  = 44100
    .nChannels       = 2
    .wBitsPerSample  = 16
    .nBlockAlign     = (.wBitsPerSample shr 3) * .nChannels
    .nAvgBytesPerSec = .nBlockAlign * .nSamplesPerSec
    .cbSize          = 0 ' no extra bytes
    end with
    LastResult = waveInOpen(@hDevice, _
                            DeviceIndex, _
                            cptr(LPCWAVEFORMATEX,@wfex), _
                            cast(uinteger,@WaveInProc), _
                            cast(uinteger,@this), _
                            CALLBACK_FUNCTION)
  
    ' prepare buffers
    if IsOpen then
      dim as integer size = wfex.nBlockAlign
      size*=nSamplesPerBuffer
      pSamples=new short[size]
      nSamples=0
      Buffers=callocate(nBuffers*sizeof(PWAVEHDR))
      for i as integer =0 to nBuffers-1
        Buffers[i] = callocate(sizeof(WAVEHDR))
        with *Buffers[i]
          .lpData         = callocate(size) 
          .dwBufferLength = size
          .dwUser         = i
          .dwFlags        = 0
        end with
        LastResult = waveInPrepareHeader(hDevice   , _
                                         Buffers[i], _
                                         sizeof(WAVEHDR))
      
      next
      for i as integer=0 to nBuffers-1
        LastResult = waveInAddBuffer(hDevice,Buffers[i],sizeof(WAVEHDR))
      next
      LastResult = waveInStart(hDevice)
      IsRunning=(LastResult=MMSYSERR_NOERROR)
    end if
  end if
end constructor

' stop the device and free all resources
destructor WAVEIN_DEVICE
  if (hDevice<>NULL) then
    if (IsOpen<>0) then
      if (IsRunning<>0) then
        IsRunning=0
        LastResult = waveInStop(hDevice)
        dprint("waveInStop()=" & LastResult)
      end if
      LastResult = waveInReset(hDevice) ' mark all buffer as done
      dprint("waveInReset()=" & LastResult)
      sleep 1000,1
      if (Buffers<>NULL) then
        if (nBuffers>0) then
          for i as integer = 0 to nBuffers-1
            if (Buffers[i]<>NULL) then
              'if (Buffers[i]->dwFlags and WHDR_PREPARED) then
                LastResult = waveInUnprepareHeader(hDevice,Buffers[i],sizeof(WAVEHDR))
                dprint("waveInUnprepareHeader(" & i & ")=" & LastResult)
              'end if
              if Buffers[i]->lpData then deallocate Buffers[i]->lpData
              deallocate Buffers[i]
            end if
          next
        end if
        deallocate Buffers
      end if
      dprint("WAVEIN_DEVICE~ waveInClose")
      dim as integer count=100
      LastResult = waveInClose(hDevice)
      dprint("waveInClose()=" & LastResult)
      while (LastResult = WAVERR_STILLPLAYING) andalso (count>0)
        sleep 10,1:count-=1
        LastResult = waveInClose(hDevice)
      wend
    end if
  end if
  if pSamples<>NULL then delete pSamples
  dprint("WAVEIN_DEVICE~")
end destructor

' the audio in callback
sub WAVEIN_DEVICE.WaveInProc(hDevice   as HWAVEIN          , _
                             DriverMsg as uinteger         , _
                             pDevice   as WAVEIN_DEVICE ptr, _
                             pBuffer   as PWAVEHDR         , _
                             Param2    as DWORD)
  if (pDevice=NULL) then return
  
  select case as const DriverMsg
  case WIM_DATA
    if (pDevice->IsRunning<>0) then 
      pDevice->PrepareBuffer(pBuffer)
      pDevice->nRecordedBuffers+=1
    else
      DPRINT("WIM_DATA")
    end if
  case WIM_OPEN : dprint("WIM_OPEN")
    pDevice->IsOpen = 1
  case WIM_CLOSE : dprint("WIM_CLOSE")
    pDevice->IsOpen = 0
  end select
end sub

' new buffer are recorded
sub WAVEIN_DEVICE.PrepareBuffer(pBuffer as PWAVEHDR)
  lastResult=waveInUnprepareHeader(hDevice,pBuffer,sizeof(WAVEHDR))
  ' new samples aviable ?
  if pBuffer->dwBytesRecorded>0 then
    ' pointer to the 16 bit stereo samples
    dim as short ptr pNewSamples  = cptr(short ptr,pBuffer->lpData)
    nSamples = pBuffer->dwBytesRecorded\wfex.nBlockAlign
    RtlCopyMemory(pSamples,pNewSamples,pBuffer->dwBytesRecorded)
    dprint("new samples aviable")
    ' !!! now pSamples points to your fresh recorded audio data !!!
    ' !!! save it to the disc or plot it as bar or what ever    !!!
  end if
  ' prepare and add the last buffer
  if (IsRunning<>0) then
    pBuffer->dwFlags = 0
    pBuffer->dwBytesRecorded = 0
    lastResult=waveInPrepareHeader(hDevice,pBuffer,sizeof(WAVEHDR))
    if (LastResult=MMSYSERR_NOERROR) then
       lastResult = waveInAddBuffer(hDevice,pBuffer,sizeof(WAVEHDR))
       'dprint("waveInAddBuffer()=" & str(lastResult))
    end if
  end if

  if (LastResult<>MMSYSERR_NOERROR) then
    IsRunning=0
    'dprint("waveInStop()=" & str(waveInStop(hDevice)))
    'dprint("waveInReset()=" & str(waveInReset(hDevice)))
    dim as string sError=space(256)
    waveInGetErrorText(LastResult,strptr(sError),256)
    dprint("error: " & sError)
  end if
end sub

dim as WAVEIN_DEVICE Recorder

sleep
Top
Mihail_B
Posts: 273
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:
Contact Mihail_B

Post by Mihail_B »

D.J.Peters wrote:can you test this on win 7 please
(i have only XP and some Linux boxes)
it runs :D





here's my way :

Code: Select all

Sub record_continuous(filename As String, maxsize As LongInt,sampleRate As Integer,channels As integer,bps As Integer)
	#Ifdef __FB_WIN32__
	Dim As HWAVEOUT ho1
	Dim As HWAVEIN hi1
	Dim As WAVEFORMATEX wfi11
	Dim As WAVEHDR whad(1 To nttt_max)
	Dim As Any Ptr bufs(1 To nttt_max)
	Dim As Integer i,k,j,u,file1,cak,did,To_bep,last,spect,plai,dede,freq11
	Dim As Double op1,times1
	Dim As MMRESULT mr1
	Dim as LongInt tit
	Dim As String a
	Dim As wit3 Ptr fr
	Dim As wit2 Ptr am
	Dim As wit2 Ptr maroc
	Dim As compact_wavehdr cwh
	cak=1 ' very important should be at least 1 ! 
	
	wfi11.nSamplesPerSec=sampleRate
	wfi11.nChannels=channels
	wfi11.wFormatTag=WAVE_FORMAT_PCM
	wfi11.nBlockAlign=channels*bps\8
	wfi11.nAvgBytesPerSec=wfi11.nBlockAlign*samplerate
	wfi11.wBitsPerSample=bps
	
	If Dir(filename)<>"" Then
		Print "file allready exists :";filename;
		Line Input " Overwrite (y/[n]):";a
		a=LCase(Trim(a))
		If a="y" Then
			GoTo coco1
		Else
			Exit Sub
		EndIf
	EndIf
	coco1:
	file1=FreeFile
	Open filename For Binary As #file1
		For i=1 To nttt_max
			bufs(i)=Allocate(wfi11.nAvgBytesPerSec*cak)
			whad(i).lpData=bufs(i)
			whad(i).dwBufferLength=wfi11.nAvgBytesPerSec*cak
		Next i
		mr1=waveInOpen(@hi1,-1,@wfi11,0,0,CALLBACK_NULL)
		If mr1 <> MMSYSERR_NOERROR Then
			Print "ups error opening input device !"
			Print "error:";
			Select Case mr1
				Case MMSYSERR_ALLOCATED
					Print "MMSYSERR_ALLOCATED"
				Case MMSYSERR_BADDEVICEID	
					Print "MMSYSERR_BADDEVICEID"
				Case MMSYSERR_NODRIVER	
					Print "MMSYSERR_NODRIVER"
				Case MMSYSERR_NOMEM	
					Print "MMSYSERR_NOMEM"
				Case WAVERR_BADFORMAT	
					Print "WAVERR_BADFORMAT"
			End Select
			sleep
			GoTo clonc111
		EndIf
		For i=1 To nttt_max-1
			waveInPrepareHeader(hi1,@whad(i),SizeOf(WAVEHDR))
			mr1=waveInAddBuffer(hi1,@whad(i),SizeOf(WAVEHDR))
		Next i
		
		cwh=a_wavefilehdr
		
		cwh.fmt.wf.wFormatTag=1
		cwh.fmt.wf.nChannels=wfi11.nChannels
		cwh.fmt.wf.nSamplesPerSec=wfi11.nSamplesPerSec
		cwh.fmt.wf.nAvgBytesPerSec=wfi11.nAvgBytesPerSec
		cwh.fmt.wf.nBlockAlign=wfi11.nBlockAlign
		cwh.fmt.wBitsPerSample=wfi11.wBitsPerSample
		cwh.size_of_data=whad(1).dwBufferLength
		cwh.rest_of_size=len(compact_wavehdr)-8+whad(1).dwBufferLength
		
		Put #file1,1,cwh
		
		Print "enough space for recording :";maxsize /wfi11.nSamplesPerSec;" s(econds) // OR // ";(maxsize /wfi11.nSamplesPerSec)/60;" m(inutes)";"  "
		To_bep=nttt_max
		i=1
		tit=0
		fr=Allocate(wfi11.nSamplesPerSec*cak\2+4)
		am=Allocate(wfi11.nSamplesPerSec*cak\2+1)
		
		waveInStart(hi1)
		'important variable: i
		#Define mmxc 100
		#Define minxcc 169
		While tit<maxsize 
		'Locate 5,1
		'Print "Recoreded secs:";did;" === ";tit;" bytes     ";
		while (waveInUnprepareHeader(hi1,@whad(i),sizeof(WAVEHDR))=WAVERR_STILLPLAYING)
			Locate 5,1
			Print "Recoreded secs:";did;" === ";tit;" bytes     ";
			Sleep 250
			a=InKey 
			Select Case a
				Case "p","P"
					plai=IIf(plai=1,0,1)
				Case "s","S"
					spect=IIf(spect=1,0,1)
				Case "f","F"
					freq11=IIf(freq11=1,0,1)
				Case " "
					waveInStop(hi1)
					Print
					Print "========== pause =========="
					Print "press space to continue...."
					Print "========== pause =========="
					Do: 
					a=InKey:Sleep 200:
					If a = Chr(27) Then GoTo save111 
					Loop Until a=" "
					waveInStart(hi1)
					Line (0,5*16)-(639,9*16),0,bf
				Case Chr(27)
					Print "stopping !"
					Put #file1,,*CPtr(UByte Ptr, bufs(i)),whad(i).dwBufferLength
					did+=1
					tit+=whad(i).dwBufferLength
					GoTo save111
			End Select
		Wend
		
		Put #file1,,*CPtr(UByte Ptr, bufs(i)),whad(i).dwBufferLength
		did+=1
		tit+=whad(i).dwBufferLength
		If MultiKey(FB.SC_ESCAPE) <> 0 Then GoTo save111
		If last<>i And spect=1 Then
				Dim As Integer amadeus,w
				j=analyze_r(funcGetFreq,whad(i).lpData,whad(i).dwBufferLength,sampleRate,fr,am)
				u+=mmxc
				If u>469-mmxc Or u< minxcc Then 
					u=minxcc
					Line (0,minxcc)-(639,479),0,bf
				EndIf
				If freq11=0 Then
				For k=1 To j
					Line (-1+(fr->wvi(k)*640/(samplerate/2)),u+mmxc*k/j)-(-1+(fr->wvi(k)*640/(samplerate/2)),u+mmxc*k/j),RGB(10,128+am->wvi(k),10)
				Next k
				ElseIf freq11=1 Then
				amadeus=j
				j=0
				w=0
				Cls
				Do
					Line (j,479)-(j,479-(fr->wvi(w)/10)),RGB(0,(am->wvi(w)+1)*7,0),bf
					j+=1
					w+=1
				Loop Until w>amadeus
				Locate 1,1:Print amadeus;"   ";samplerate/2;"   "
				End If
				last=i
				If plai=1 And j>0 Then
					maroc=Allocate(whad(i).dwBufferLength*2)
					dede=whad(i).dwBufferLength*2
					'waveInStop(hi1)
					filter_frqint_to_wave(@fr->wvi(1),j,@am->wvi(1),0,maroc,8000,@dede)
					'Print "out of filter:";dede;"        "
					'Print "playing:";
					play_wave_seq(maroc,dede,8000)
					'waveInStart(hi1)
					'Print " done!      "
					DeAllocate maroc
				End if
		End if		
		waveInPrepareHeader(hi1,@whad(To_bep),SizeOf(WAVEHDR))
		mr1=waveInAddBuffer(hi1,@whad(to_bep),SizeOf(WAVEHDR))
		i+=1
		to_bep+=1
		If i>nttt_max Then i=1
		If to_bep>nttt_max Then To_bep=1
		Wend
		save111:
		waveInStop(hi1)
		waveInClose(hi1)
		clonc111:
		For i=1 To nttt_max
		DeAllocate bufs(i)
		Next i
		Print
		Print "Total recoreded secs:";did;" === ";tit/(1024*1024);" MBytes"
		cwh.size_of_data=tit
		cwh.rest_of_size=len(compact_wavehdr)-8+tit
		Put #file1,1,cwh
		Close #file1
		Sleep 1000,0
		GoTo notnow11
		Scope
		Dim As def_showacmfilter2 showacmfilter2
		Dim As Any Ptr ui
		Dim As WAVEFORMATEX wsel1, wenu1
		ui=DylibLoad("acmdll.dll")
		showacmfilter2=DylibSymbol(ui,"showacmfilter2")
		showacmfilter2(@wsel1,@wenu1)
		Print ":) ";wenu1.nSamplesPerSec, wsel1.nSamplesPerSec
		Sleep
		DylibFree(ui)
		End Scope
		notnow11:
		#EndIf
End Sub
Top
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

Post by D.J.Peters »

And what is the problem with your code on Win 7 ?

Joshy

edit:
ther are missing const's like "nttt_max"
and where are the lines with #include
...
Top
Mihail_B
Posts: 273
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:
Contact Mihail_B

Post by Mihail_B »

D.J.Peters wrote:And what is the problem with your code on Win 7 ?

Joshy

edit:
ther are missing const's like "nttt_max"
and where are the lines with #include
...
I can not record from my internal microphone for some reason ...
I've got to connect an external microphone OR to link between an audio output of some device and my microphone plug ...
---

the missing parts : the sub is actually a part of a bigger file about 300Kb in size :D ... I've posted here to see how I do ...
Anyway the full file is available for download at: http://sourceforge.net/projects/manytools/files/
take sndrecm.zip
The main file(s) are 2 actually (and a the library workfunc.bi):
1)sndrecmore.bas -> to record to disk from your default audio input
[tip : start at cmd prompt: sndrecmore.exe -next -ask]
2)sndrecload.bas -> ON-DISK editor for waves [it's only good for editing 8bit/mono/8KHz wav files, preferrable produced by sndrecmor.bas ...
3)workfunc.bi -> lots of stuff ... weighting about 300k ..

it can cut/insert anywhere in file, generate sinusoidal waves and insert/mix them into file / [in a file as big as your harddisk]
etc..bla-bla-bla [the gui could be nice if I would've have time to put all
the things in order ... maybe one day]
....


I'll add also MCI_RECORD support 'cause it seams to be of great value and nice ...
Top
chung
Posts: 648
Joined: Jan 16, 2010 20:52
Location: France
Contact:
Contact chung

Re: win7: Recording from microphone ? [waveIn not working]

Post by chung »

i have written a little program from the joshy's snippet
it uses gui_chung and you can change device with a combobox
it works on my netbook windows7 starter

Code: Select all

'wavein a wavein example
'
    #include once "windows.bi"
    #Include Once "gui_chung.bi"
    #include once "win/mmsystem.bi"

    '#define DEBUG

    #ifdef DEBUG
    #define DPRINT(txt) OPEN ERR FOR OUTPUT AS #99:print #99,txt:close #99
    #else
    #define DPRINT(txt) :
    #endif

    '  #################
    ' # WAVEIN_DEVICE #
    '#################
    type WAVEIN_DEVICE
      Declare Sub wstart(DeviceIndex as integer=-1) ' default = WAVE_MAPPER
      Declare Sub wclose()
      as short ptr pSamples
      as integer   nSamples,nRecordedBuffers

      private:
      declare static sub WaveInProc(hDevice   as HWAVEIN, _
                                    DriverMsg as uinteger, _
                                    pDevice   as WAVEIN_DEVICE ptr, _
                                    pBuffer   as PWAVEHDR, _
                                    Param2    as DWORD)
      declare sub PrepareBuffer(pBuffer as PWAVEHDR)
      as WAVEFORMATEX     wfex
      as WAVEINCAPS       Caps
      as HWAVEIN          hDevice
      as MMRESULT         LastResult
      as PWAVEHDR ptr     Buffers
      as integer          IsOpen,IsRunning
      as integer          nBuffers,nSamplesPerbuffer
    end type

Dim Shared As waveincaps mywaveincaps
Dim Shared As Integer numdev,idev,mydev=-1
numdev=waveInGetNumDevs()

dim Shared As String myname(30)
Dim Shared As Integer mychannels(30)
If numdev>30 Then numdev=30
for idev=-1 to numdev-1
  waveInGetDevCaps(idev,@mywaveincaps,sizeof(WAVEINCAPS))
  myname(idev+1)=mywaveincaps.szPname
  mychannels(idev+1)=mywaveincaps.wChannels
next idev

    ' setup 44100 16 bit 2 channels
    Sub WAVEIN_DEVICE.wstart(DeviceIndex as Integer=-1)
      dprint("WAVEIN_DEVICE()")
      nBuffers=8
      nSamplesPerBuffer = 1024
      LastResult = waveInGetDevCaps(DeviceIndex, _
                                    @Caps, _
                                    sizeof(WAVEINCAPS))
      if (LastResult=MMSYSERR_NOERROR) then

        with wfex
        .wFormatTag      = WAVE_FORMAT_PCM
        .nSamplesPerSec  = 44100
        .nChannels       = 2
        .wBitsPerSample  = 16
        .nBlockAlign     = (.wBitsPerSample shr 3) * .nChannels
        .nAvgBytesPerSec = .nBlockAlign * .nSamplesPerSec
        .cbSize          = 0 ' no extra bytes
        end with
        LastResult = waveInOpen(@hDevice, _
                                DeviceIndex, _
                                cptr(LPCWAVEFORMATEX,@wfex), _
                                cast(uinteger,@WaveInProc), _
                                cast(uinteger,@this), _
                                CALLBACK_FUNCTION)
     
        ' prepare buffers
        if IsOpen then
          dim as integer size = wfex.nBlockAlign
          size*=nSamplesPerBuffer
          pSamples=new short[size]
          nSamples=0
          Buffers=callocate(nBuffers*sizeof(PWAVEHDR))
          for i as integer =0 to nBuffers-1
            Buffers[i] = callocate(sizeof(WAVEHDR))
            with *Buffers[i]
              .lpData         = callocate(size)
              .dwBufferLength = size
              .dwUser         = i
              .dwFlags        = 0
            end with
            LastResult = waveInPrepareHeader(hDevice   , _
                                             Buffers[i], _
                                             sizeof(WAVEHDR))
         
          next
          for i as integer=0 to nBuffers-1
            LastResult = waveInAddBuffer(hDevice,Buffers[i],sizeof(WAVEHDR))
          next
          LastResult = waveInStart(hDevice)
          IsRunning=(LastResult=MMSYSERR_NOERROR)
        end if
      end if
    end Sub 

    ' stop the device and free all resources
    Sub WAVEIN_DEVICE.wclose()
      if (hDevice<>NULL) then
        if (IsOpen<>0) then
          isrunning=0
          guiscan
          Sleep 500
          LastResult = waveInReset(hDevice) ' mark all buffer as done
          dprint("waveInReset()=" & LastResult)
          LastResult = waveInStop(hDevice)
          dprint("waveInStop()=" & LastResult)
          guiscan
          Sleep 100
          if (Buffers<>NULL) then
            if (nBuffers>0) then
              for i as integer = 0 to nBuffers-1
                if (Buffers[i]<>NULL) then
                  'if (Buffers[i]->dwFlags and WHDR_PREPARED) then
                    LastResult = waveInUnprepareHeader(hDevice,Buffers[i],sizeof(WAVEHDR))
                    dprint("waveInUnprepareHeader(" & i & ")=" & LastResult)
                  'end if
                  if Buffers[i]->lpData then deallocate Buffers[i]->lpData
                  deallocate Buffers[i]
                end if
              next
            end if
            deallocate Buffers
          end if
          dprint("WAVEIN_DEVICE~ waveInClose")
          dim as integer count=100
          LastResult = waveInClose(hDevice)
          dprint("waveInClose()=" & LastResult)
          while (LastResult = WAVERR_STILLPLAYING) andalso (count>0)
            sleep 50:count-=1
            LastResult = waveInClose(hDevice)
          wend
        end if
      end if
      if pSamples<>NULL then delete pSamples
      dprint("WAVEIN_DEVICE~")
    end Sub 

    ' the audio in callback
    sub WAVEIN_DEVICE.WaveInProc(hDevice   as HWAVEIN          , _
                                 DriverMsg as uinteger         , _
                                 pDevice   as WAVEIN_DEVICE ptr, _
                                 pBuffer   as PWAVEHDR         , _
                                 Param2    as DWORD)
      if (pDevice=NULL) then return
     
      select case as const DriverMsg
      case WIM_DATA
        if (pDevice->IsRunning<>0) then
          pDevice->PrepareBuffer(pBuffer)
          pDevice->nRecordedBuffers+=1
        else
          DPRINT("WIM_DATA")
        end if
      case WIM_OPEN : dprint("WIM_OPEN")
        pDevice->IsOpen = 1
      case WIM_CLOSE : dprint("WIM_CLOSE")
        pDevice->IsOpen = 0
      end select
    end sub

Dim Shared As Integer isample,nsample=200000 '2sec
Dim Shared As Short   mysamples(nsample)
Dim Shared As Short Ptr mypsamples
Dim Shared As Integer mynsamples
Declare Sub mysubsample()
    ' new buffer are recorded
    sub WAVEIN_DEVICE.PrepareBuffer(pBuffer as PWAVEHDR)
      lastResult=waveInUnprepareHeader(hDevice,pBuffer,sizeof(WAVEHDR))
      ' new samples aviable ?
      if pBuffer->dwBytesRecorded>0 then
        ' pointer to the 16 bit stereo samples
        dim as short ptr pNewSamples  = cptr(short ptr,pBuffer->lpData)
        nSamples = pBuffer->dwBytesRecorded\wfex.nBlockAlign
        RtlCopyMemory(pSamples,pNewSamples,pBuffer->dwBytesRecorded)
        dprint("new samples available")
        ' !!! now pSamples points to your fresh recorded audio data !!!
        mynsamples=nsamples
        mypsamples=psamples
        mysubsample()
        ' !!! save it to the disc or plot it as bar or what ever    !!!
      end if
      ' prepare and add the last buffer
      if (IsRunning<>0) then
        pBuffer->dwFlags = 0
        pBuffer->dwBytesRecorded = 0
        lastResult=waveInPrepareHeader(hDevice,pBuffer,sizeof(WAVEHDR))
        if (LastResult=MMSYSERR_NOERROR) then
           lastResult = waveInAddBuffer(hDevice,pBuffer,sizeof(WAVEHDR))
           'dprint("waveInAddBuffer()=" & str(lastResult))
        end if
      end if

      if (LastResult<>MMSYSERR_NOERROR) then
        IsRunning=0
        'dprint("waveInStop()=" & str(waveInStop(hDevice)))
        'dprint("waveInReset()=" & str(waveInReset(hDevice)))
        dim as string sError=space(256)
        waveInGetErrorText(LastResult,strptr(sError),256)
        dprint("error: " & sError)
      end if
    end sub


Sub notice(ByRef msg As string,ByRef title As String ="notice")
	guinotice(msg,title)
End Sub
Sub confirm(ByRef msg As string,ByRef title As string,ByRef resp As String)
   guiconfirm(msg,title,resp)
End Sub 
Function max2(ByVal x As Single,ByVal y As Single)As Single
	If x>=y Then Return x Else Return y
End Function
Function min2(ByVal x As Single,ByVal y As Single)As Single
	If x<=y Then Return x Else Return y
End Function


Dim Shared As Integer winx,winy,windx,windy,file

Dim As String ficin
Dim As String ficini="wavein.ini"
file=FreeFile
Open ficini For Input As #file
winx=10:winy=10
If Not Eof(file) Then Line Input #file,ficin:winx=Val(ficin)
If Not Eof(file) Then Line Input #file,ficin:winy=Val(ficin)
mydev=-1
If Not Eof(file) Then Line Input #file,ficin:mydev=Val(ficin)
Close #file

Dim Shared As Integer quit,restart
Sub subquit
	quit=1
End Sub
Sub submsg()
End Sub
Sub subedittext()
End Sub
Sub subreset()
End Sub
Sub subcombo()
Dim As Integer i
getcomboindex("win.combo",i)
mydev=i-2 '-1=mapper
quit=1:restart=1
End Sub

' Program start
Dim Shared As Integer wx,wy
ScreenInfo wx,wy
winx=max2(0,min2(wx-500,winx))
winy=max2(0,min2(wy-350,winy)) 
guibackgroundcolor(50,255,50)
guiedittextbackcolor(220,170,255)
guiedittextinkcolor(0,0,100)
button("win.button1","quit",@subquit,10,10,80,20)
combobox("win.combo",@subcombo,100,10,256,200)
edittext("win.msg","",@submsg,10,40,473,180,es_multiline+WS_VSCROLL)
edittext("win.edittext","",@subedittext,10,240,400,20,ES_LEFT+es_multiline+WS_VSCROLL)
button("win.reset","reset",@submsg,420,240,50,20)
openwindow("win","wavein_chung",winx,winy,500,330) 

trapclose("win",@subquit)
guisetfocus("win")
guisetfocus("win.edittext")
reloadcombo("win.combo",myname())
selectcomboindex("win.combo",mydev+2)
addmenu("win.menu","menu")  'the same thing, with guimenu

Dim As WAVEIN_DEVICE mywavein

lrestart:
restart=0:quit=0
mywavein.wstart(mydev)

While quit=0 And guitestkey(vk_escape)=0
	guiscan
	Sleep 50	
Wend

mywavein.wclose()

If restart=1 Then restart=0:quit=0:Sleep 100:GoTo lrestart

guigetwindowpos("win",winx,winy,windx,windy)
file=freefile
Open ficini For Output As #file
Print #file,winx
Print #file,winy
Print #file,mydev
Close #file

guiclose()
guiquit()

End

Sub mysubsample()
Dim As Integer i,j,k
printgui("win.msg",Str(mynsamples)+"/"+Str(mypsamples[0]))
For i=0 To mynsamples-1
	isample+=1
	If isample>=nsample Then isample=0
	mysamples(i)=mypsamples[i]
Next
End Sub
Top
nobozoz
Posts: 238
Joined: Nov 17, 2005 6:24
Location: Chino Hills, CA, USA

Re: win7: Recording from microphone ? [waveIn not working]

Post by nobozoz »

What/where is "wavein.ini"?
Top
chung
Posts: 648
Joined: Jan 16, 2010 20:52
Location: France
Contact:
Contact chung

Re: win7: Recording from microphone ? [waveIn not working]

Post by chung »

you can create an empty file , or the program will create one at first use with default values.
Top
nobozoz
Posts: 238
Joined: Nov 17, 2005 6:24
Location: Chino Hills, CA, USA

Re: win7: Recording from microphone ? [waveIn not working]

Post by nobozoz »

That seems to have done the trick - thanks for your patience.
Top
Post Reply

Return to “Windows”