home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Audio_Reco210496362008.psc / modWaveIn.bas < prev   
BASIC Source File  |  2008-03-06  |  16KB  |  556 lines
  1. Attribute VB_Name = "modWaveIn"
  2. Option Explicit
  3.  
  4. ' DEBUGING
  5. Public Const Debuging As Boolean = False
  6.  
  7.  
  8. Enum OutputMode
  9.     WAVE = 0
  10.     MP3 = 1
  11. End Enum
  12.  
  13. Enum eMP3_TYPE
  14.     CBR = 0
  15.     ABR = 1
  16.     vbr = 2
  17. End Enum
  18.  
  19. Enum eVBR_Routine
  20.     New_Routine = 0
  21.     Old_Routine = 1
  22. End Enum
  23.  
  24. Public Type tMP3
  25.     MP3_Type As eMP3_TYPE
  26.     
  27.     VBR_MinBitrate As Integer
  28.     VBR_MaxBitrate As Integer
  29.     VBR_Quality As Integer
  30.     VBR_Routine As eVBR_Routine
  31.     
  32.     ABR_AvgBitrate As Integer
  33.     
  34.     CBR_Bitrate As Integer
  35.     
  36.     LAME As String
  37. End Type
  38.  
  39.  
  40. Public INI_FILE As String
  41.  
  42. Private Const RECORD As Long = 100
  43. Private Const MONITOR As Long = 10
  44.  
  45. Private Const GMEM_FIXED As Long = &H0
  46.  
  47. Private Const CALLBACK_WINDOW As Long = &H10000
  48.  
  49. Private Const STATUS_PENDING As Long = &H103
  50. Private Const STILL_ACTIVE As Long = STATUS_PENDING
  51.  
  52. Private Const WAVE_FORMAT_PCM As Long = 1
  53.  
  54. Private Const MM_WIM_CLOSE As Long = &H3BF
  55. Private Const MM_WIM_DATA As Long = &H3C0
  56. Private Const MM_WIM_OPEN As Long = &H3BE
  57. Private Const WIM_CLOSE As Long = MM_WIM_CLOSE
  58. Private Const WIM_DATA As Long = MM_WIM_DATA
  59. Private Const WIM_OPEN As Long = MM_WIM_OPEN
  60. Private Const WHDR_DONE As Long = &H1
  61. Private Const PROCESS_TERMINATE As Long = (&H1)
  62.  
  63.  
  64. Private Type WAVEFORMATEX
  65.     wFormatTag As Integer
  66.     nChannels As Integer
  67.     nSamplesPerSec As Long
  68.     nAvgBytesPerSec As Long
  69.     nBlockAlign As Integer
  70.     wBitsPerSample As Integer
  71. End Type
  72.  
  73.  
  74. Private Type WAVEHDR
  75.     lpData As Long
  76.     dwBufferLength As Long
  77.     dwBytesRecorded As Long
  78.     dwUser As Long
  79.     dwFlags As Long
  80.     dwLoops As Long
  81.     lpNext As Long
  82.     Reserved As Long
  83. End Type
  84.  
  85. Private Declare Function TerminateProcess Lib "kernel32.dll" ( _
  86.      ByVal hProcess As Long, _
  87.      ByVal uExitCode As Long) As Long
  88.  
  89. Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
  90.  
  91. Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" ( _
  92.      ByRef Destination As Any, _
  93.      ByVal Length As Long)
  94.  
  95. Private Declare Function CloseHandle Lib "kernel32.dll" ( _
  96.      ByVal hObject As Long) As Long
  97.  
  98. Private Const MB_ICONHAND As Long = &H10&
  99. Private Const MB_ICONERROR As Long = MB_ICONHAND
  100.  
  101. Private Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" ( _
  102.      ByVal hwnd As Long, _
  103.      ByVal lpText As String, _
  104.      ByVal lpCaption As String, _
  105.      ByVal wType As Long) As Long
  106.  
  107.  
  108. Private Const SW_HIDE As Long = 0
  109. Private Const SW_SHOW As Long = 5
  110.  
  111.  
  112. Private Const STARTF_USESTDHANDLES As Long = &H100
  113. Private Const STARTF_USESHOWWINDOW As Long = &H1
  114. Private Const STD_INPUT_HANDLE As Long = -10&
  115. Private Const STD_OUTPUT_HANDLE As Long = -11&
  116.  
  117. Private Declare Function AllocConsole Lib "kernel32.dll" () As Long
  118. Private Declare Function FreeConsole Lib "kernel32.dll" () As Long
  119. Private Declare Function GetStdHandle Lib "kernel32.dll" ( _
  120.      ByVal nStdHandle As Long) As Long
  121.  
  122.  
  123. Private Declare Function GetExitCodeProcess Lib "kernel32.dll" ( _
  124.      ByVal hProcess As Long, _
  125.      ByRef lpExitCode As Long) As Long
  126.  
  127. Private Declare Function CreatePipe Lib "kernel32" ( _
  128.     ByRef phReadPipe As Long, _
  129.     ByRef phWritePipe As Long, _
  130.     ByRef lpPipeAttributes As SECURITY_ATTRIBUTES, _
  131.     ByVal nSize As Long) As Long
  132.  
  133. Private Declare Sub GetStartupInfoA Lib "kernel32" ( _
  134.     ByRef lpInfo As STARTUPINFO)
  135.  
  136. Private Declare Function CreateProcessA Lib "kernel32" ( _
  137.     ByVal lpApplicationName As String, _
  138.     ByVal lpCommandLine As String, _
  139.     ByRef lpProcessAttributes As Any, _
  140.     ByRef lpThreadAttributes As Any, _
  141.     ByVal bInheritHandles As Long, _
  142.     ByVal dwCreationFlags As Long, _
  143.     ByRef lpEnvironment As Any, _
  144.     ByVal lpCurrentDriectory As String, _
  145.     ByRef lpStartupInfo As STARTUPINFO, _
  146.     ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
  147.     
  148.  
  149. Private Declare Function WriteFile Lib "kernel32.dll" ( _
  150.      ByVal hFile As Long, _
  151.      ByVal lpBuffer As String, _
  152.      ByVal nNumberOfBytesToWrite As Long, _
  153.      ByRef lpNumberOfBytesWritten As Long, _
  154.      ByRef lpOverlapped As Any) As Long
  155.  
  156. Private Declare Function ReadFile Lib "kernel32" ( _
  157.     ByVal hFile As Long, _
  158.     ByVal lpBuffer As String, _
  159.     ByVal nNumberOfBytesToRead As Long, _
  160.     ByRef lpNumberOfBytesRead As Long, _
  161.     ByRef lpOverlapped As Any) As Long
  162.   
  163. Private Declare Function PeekNamedPipe Lib "kernel32" ( _
  164.     ByVal hReadPipe As Long, _
  165.     ByRef lpBuffer As Any, _
  166.     ByVal nBufferSize As Long, _
  167.     ByRef lpBytesRead As Long, _
  168.     ByRef lpTotalBytesAvail As Long, _
  169.     ByRef lpBytesLeftThisMessage As Long) As Long
  170.  
  171.  
  172. Private Type SECURITY_ATTRIBUTES
  173.     nLength As Long
  174.     lpSecurityDescriptor As Long
  175.     bInheritHandle As Long
  176. End Type
  177.  
  178. Private Type PROCESS_INFORMATION
  179.     hProcess As Long
  180.     hThread As Long
  181.     dwProcessID As Long
  182.     dwThreadId As Long
  183. End Type
  184.  
  185. Private Type STARTUPINFO
  186.     cb As Long
  187.     lpReserved As Long
  188.     lpDesktop As Long
  189.     lpTitle As Long
  190.     dwX As Long
  191.     dwY As Long
  192.     dwXSize As Long
  193.     dwYSize As Long
  194.     dwXCountChars As Long
  195.     dwYCountChars As Long
  196.     dwFillAttribute As Long
  197.     dwFlags As Long
  198.     wShowWindow As Integer
  199.     cbReserved2 As Integer
  200.     lpReserved2 As Byte
  201.     hStdInput As Long
  202.     hStdOutput As Long
  203.     hStdError As Long
  204. End Type
  205.  
  206. Private Declare Function GetLastError Lib "kernel32.dll" () As Long
  207.  
  208. Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMiliseconds As Long)
  209.  
  210. Private Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" ( _
  211.      ByVal sz As String, _
  212.      ByVal uFlags As Long) As Long
  213.  
  214. Private Type tHeader
  215.     RIFF As Long            ' "RIFF"
  216.     LenR As Long            ' size of following segment
  217.     WAVE As Long            ' "WAVE"
  218.     fmt As Long             ' "fmt
  219.     FormatSize As Long      ' chunksize
  220.     format As WAVEFORMATEX  ' audio format
  221.     data As Long            ' "data"
  222.     DataLength As Long      ' length of datastream
  223. End Type
  224.  
  225.  
  226.  
  227. Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
  228.      ByRef Destination As Any, _
  229.      ByRef Source As Any, _
  230.      ByVal Length As Long)
  231.  
  232. Public Declare Sub CopyAudioMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
  233.      ByRef Destination As Any, _
  234.      ByVal Source As Long, _
  235.      ByVal Length As Long)
  236.  
  237.  
  238. Private Declare Function GlobalAlloc Lib "kernel32.dll" ( _
  239.      ByVal wFlags As Long, _
  240.      ByVal dwBytes As Long) As Long
  241. Private Declare Function GlobalLock Lib "kernel32.dll" ( _
  242.      ByVal hMem As Long) As Long
  243. Private Declare Function GlobalFree Lib "kernel32.dll" ( _
  244.      ByVal hMem As Long) As Long
  245. Private Declare Function GlobalUnlock Lib "kernel32" ( _
  246.      ByVal hMem As Long) As Long
  247.  
  248.  
  249. Private Const GWL_WNDPROC As Long = -4
  250.  
  251. Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
  252.      ByVal lpPrevWndFunc As Long, _
  253.      ByVal hwnd As Long, _
  254.      ByVal msg As Long, _
  255.      ByVal wParam As Long, _
  256.      ByRef lParam As Any) As Long
  257. Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
  258.      ByVal hwnd As Long, _
  259.      ByVal nIndex As Long, _
  260.      ByVal dwNewLong As Long) As Long
  261.  
  262.  
  263.  
  264.  
  265. Private Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" ( _
  266.      ByVal err As Long, _
  267.      ByVal lpText As String, _
  268.      ByVal uSize As Long) As Long
  269.  
  270.  
  271. Private Declare Function waveInReset Lib "winmm.dll" ( _
  272.      ByVal hWaveIn As Long) As Long
  273. Private Declare Function waveInAddBuffer Lib "winmm.dll" ( _
  274.      ByVal hWaveIn As Long, _
  275.      ByRef lpWaveInHdr As WAVEHDR, _
  276.      ByVal uSize As Long) As Long
  277. Private Declare Function waveInClose Lib "winmm.dll" ( _
  278.      ByVal hWaveIn As Long) As Long
  279. Private Declare Function waveInOpen Lib "winmm.dll" ( _
  280.      ByRef lphWaveIn As Long, _
  281.      ByVal uDeviceID As Long, _
  282.      ByRef lpFormat As WAVEFORMATEX, _
  283.      ByVal dwCallback As Long, _
  284.      ByVal dwInstance As Long, _
  285.      ByVal dwFlags As Long) As Long
  286. Private Declare Function waveInPrepareHeader Lib "winmm.dll" ( _
  287.      ByVal hWaveIn As Long, _
  288.      ByRef lpWaveInHdr As WAVEHDR, _
  289.      ByVal uSize As Long) As Long
  290. Private Declare Function waveInStart Lib "winmm.dll" ( _
  291.      ByVal hWaveIn As Long) As Long
  292. Private Declare Function waveInStop Lib "winmm.dll" ( _
  293.      ByVal hWaveIn As Long) As Long
  294. Private Declare Function waveInUnprepareHeader Lib "winmm.dll" ( _
  295.      ByVal hWaveIn As Long, _
  296.      ByRef lpWaveInHdr As WAVEHDR, _
  297.      ByVal uSize As Long) As Long
  298.  
  299. Private hStdinWrite As Long
  300. Private hStdoutWrite As Long
  301. Private hStdinRead As Long
  302. Private hStdoutRead As Long
  303.  
  304. Private pi As PROCESS_INFORMATION
  305.  
  306. Private Const BUFFERS As Integer = 4
  307. Private Const BUFFERS_MONITOR As Integer = 2
  308. Private Const BUFFERSIZE_MONITOR As Integer = 8192
  309. Private BUFFERSIZE As Long
  310. 'Private Const BUFFERSIZE As Long = 8192
  311.  
  312. Dim hWaveIn As Long
  313. Public hWaveIn_Monitor As Long
  314. Dim ret As Long
  315. Dim format As WAVEFORMATEX
  316. Dim hMem(BUFFERS) As Long
  317. Dim hmem_monitor(BUFFERS_MONITOR) As Long
  318. Dim hdr(BUFFERS) As WAVEHDR
  319. Dim hdr_monitor(BUFFERS_MONITOR) As WAVEHDR
  320. Dim lpPrevWndFunc As Long
  321. Dim hwnd As Long
  322. Dim num As Integer
  323. Public msg As String * 255
  324. Dim pos As Long
  325. Dim pos_mp3 As Long
  326. Dim bHeaderWritten As Boolean
  327. Public bRecording As Boolean
  328. Public bMonitoring As Boolean
  329. Dim bPaused As Boolean
  330. Dim bPaused_Monitoring As Boolean
  331. Dim OutputFile As String
  332. Public OutMode As OutputMode
  333. Public MP3_Settings As tMP3
  334.  
  335. Dim curBuffer As Long
  336.  
  337. ' =============
  338. ' Subclassing function
  339. ' =============
  340. Sub Hook(bHook As Boolean)
  341.     ' Save hWnd of main form for waveOutOpen purposes => see PrepareRecording sub
  342.     hwnd = frmMain.hwnd
  343.     'Exit Sub
  344.     
  345.     ' Prevent double hooking
  346.     If lpPrevWndFunc <> 0 And bHook Then
  347.         MessageBox 0&, "Double-hooking not permited!", "ERROR!", MB_ICONERROR
  348.         Exit Sub
  349.     End If
  350.     
  351.     Logging "[Hook] About to hook/unhook frmMain"
  352.     
  353.     ' bHook chooses whether we should subclass the form or restore previous Callback
  354.     ' function
  355.     If bHook Then
  356.         lpPrevWndFunc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf CallbackProc)
  357.     Else
  358.         lpPrevWndFunc = 0
  359.         SetWindowLong hwnd, GWL_WNDPROC, lpPrevWndFunc
  360.     End If
  361. End Sub
  362.  
  363. ' ================
  364. ' Pausing function
  365. ' ----------------
  366. ' It's a toggling function
  367. ' ================
  368. Sub Pause()
  369.     Dim i As Integer
  370.     
  371.     bPaused = Not bPaused
  372.     
  373.     If bPaused Then
  374.         ' Order MM subsystem to stop sending recorded data
  375.         waveInStop hWaveIn
  376.     Else
  377.         ' We have to add buffers to MM subsystem, otherwise it won't send any new data
  378.         For i = 0 To BUFFERS
  379.             waveInAddBuffer hWaveIn, hdr(i), Len(hdr(i))
  380.         Next
  381.         
  382.         ' Finally start again recording
  383.         waveInStart hWaveIn
  384.     End If
  385. End Sub
  386.  
  387. ' internal function: delete recording file (obviously, used after recording has stopped)
  388. Private Sub DeleteFile()
  389.     Close #num
  390.     Kill OutputFile
  391. End Sub
  392.  
  393. ' Resets monitoring
  394. ' =================
  395. ' Sometimes does monitoring to 'stuck'
  396. ' In most cases this solved it
  397. '
  398. Public Sub ResetMonitoring()
  399.     waveInReset hWaveIn_Monitor
  400. End Sub
  401.  
  402. ' ==================
  403. ' Stop monitoring
  404. ' ------------------
  405. ' this stops secondary recording for monitoring
  406. ' It should be called at program quit. To pause use PauseMonitoring
  407. ' ==================
  408. Public Sub StopMonitoring()
  409.     Dim i As Integer
  410.     
  411.     ' Signal that recording for monitoring has stopped (no longer available)
  412.     bMonitoring = False
  413.     
  414.     ' Stops monitoring
  415.     ret = waveInStop(hWaveIn_Monitor)
  416.     
  417.     ' Reset it
  418.     ret = waveInReset(hWaveIn_Monitor)
  419.     
  420.     ' Unprepare buffers
  421.     For i = 0 To BUFFERS_MONITOR
  422.         waveInUnprepareHeader hWaveIn_Monitor, hdr_monitor(i), Len(hdr_monitor(i))
  423.         GlobalUnlock hdr_monitor(i).lpData
  424.         GlobalFree hdr_monitor(i).lpData
  425.     Next i
  426.     
  427.     ' Close hWaveIn_Monitor
  428.     ret = waveInClose(hWaveIn_Monitor)
  429.     
  430.     ' Clear handle
  431.     hWaveIn_Monitor = 0
  432. End Sub
  433.  
  434. ' ===============
  435. ' Stops recording
  436. ' ---------------
  437. ' this stops main recording
  438. '================
  439. Sub StopRec()
  440.     Dim i As Integer
  441.     
  442.     ' if not recording, exit sub
  443.     If Not bRecording Then Exit Sub
  444.     
  445.     ' stop sending data
  446.     ret = waveInStop(hWaveIn)
  447.     
  448.     ' reset hWaveIn
  449.     ret = waveInReset(hWaveIn)
  450.     
  451.     ' Unprepare buffers
  452.     For i = 0 To BUFFERS
  453.         waveInUnprepareHeader hWaveIn, hdr(i), Len(hdr(i))
  454.         GlobalUnlock hdr(i).lpData
  455.         GlobalFree hdr(i).lpData
  456.     Next i
  457.     
  458.     ' Close device
  459.     ret = waveInClose(hWaveIn)
  460.     
  461.     ' Write header only if its not already written AND output _MUST_ be WAVE (obviously)
  462.     If (bHeaderWritten = False) And (OutMode = WAVE) Then WriteWAVHeader
  463.     
  464.     ' closes recorded file
  465.     Close #num
  466.     
  467.     ' Signal that recording has stopped
  468.     bRecording = False
  469.     
  470.     ' If recording to MP3 stop (kill) encoder
  471.     ' killing lame.exe is because Lame just can't know _when_ we want to stop it
  472.     If OutMode = MP3 Then StopEncoder
  473.     
  474.     ' Clear handle
  475.     hWaveIn = 0
  476. End Sub
  477.  
  478. ' =====================
  479. ' Pause monitoring : toggling function
  480. ' =====================
  481. Public Sub PauseMonitoring()
  482.     Dim i As Integer
  483.     
  484.     ' Toggle monitoring signal "Paused"
  485.     bPaused_Monitoring = Not bPaused_Monitoring
  486.     
  487.     If bPaused_Monitoring Then
  488.         ' stop sending data
  489.         waveInStop hWaveIn_Monitor
  490.     Else
  491.         ' We have to add buffers or we won't get any data
  492.         For i = 0 To BUFFERS_MONITOR
  493.             waveInAddBuffer hWaveIn_Monitor, hdr_monitor(i), Len(hdr_monitor(i))
  494.         Next
  495.         
  496.         ' Reset it
  497.         waveInReset hWaveIn_Monitor
  498.         
  499.         ' Start monitoring (hWaveIn_Monitor)
  500.         waveInStart hWaveIn_Monitor
  501.     End If
  502. End Sub
  503.  
  504. ' =======
  505. ' Prepares monitoring
  506. ' =======
  507. Public Sub PrepareMonitoring()
  508.     Dim formatMonitor As WAVEFORMATEX
  509.     Dim i As Integer
  510.     
  511.     ' Set constant parameters for monitoring
  512.     With formatMonitor
  513.         .wFormatTag = 1
  514.         .nChannels = 2
  515.         .wBitsPerSample = 16
  516.         .nSamplesPerSec = 44100
  517.         .nBlockAlign = .nChannels * .wBitsPerSample / 8
  518.         .nAvgBytesPerSec = .nSamplesPerSec * .nBlockAlign
  519.     End With
  520.     
  521.     ' open recording (hWaveIn_Monitor) with format (formatMonitor), send callbacks
  522.     ' (CALLBACK_WINDOW) to main form (frmMain.hwnd)
  523.     ret = waveInOpen(hWaveIn_Monitor, 0, formatMonitor, hwnd, 0&, CALLBACK_WINDOW)
  524.     If ret <> 0 Then
  525.         ' Was there an error? Catch it and display
  526.         waveInGetErrorText ret, msg, Len(msg)
  527.         MessageBox 0&, Trim(msg), App.Title, MB_ICONERROR
  528.         ' quit
  529.         Exit Sub
  530.     End If
  531.     
  532.     ' Preparing buffers for monitoring
  533.     For i = 0 To BUFFERS_MONITOR
  534.         ' Allocate space buffer (size BUFFERSIZE_MONITOR)
  535.         ' Notice GMEM_FIXED, it's essential, because otherwise MM system won't be able
  536.         ' to write into it.
  537.         hmem_monitor(i) = GlobalAlloc(GMEM_FIXED, BUFFERSIZE_MONITOR)
  538.         
  539.         With hdr_monitor(i)
  540.             .lpData = GlobalLock(hmem_monitor(i)) ' Lock buffer (I don't know exactly why...)
  541.             .dwBufferLength = BUFFERSIZE_MONITOR  ' Set buffer length
  542.             .dwFlags = 0                          ' no flags
  543.             .dwLoops = 0                          ' no loops
  544.             .dwUser = CLng(i) + MONITOR           ' Here we put _ID_ of buffer
  545.             
  546.             ' Notice MONITOR constant (up). It's for callback function to recognize
  547.             ' whether it's montoring or recording data
  548.         End With
  549.     Next
  550.     
  551.     ' Prepare buffers + Add them to MM systemback function to recognize
  552.             ' wh   hWaveIn_Monitor = 0
  553. systembaOruSot r    Next
  554.         sysA systemback function tltMonito ThWave
  555.     ' Prepare buffers hR  Om    ' Sedata oops
  556.             .dwUser uSon waveInStop Lib "wt with format (formatM