Включенный в код модуль RECUNIT делает всю изнурительную работу по извлечению звука со входа звуковой карты.
Var WaveRecorder : TWaveRecorder; WaveRecorder := TwaveRecorder(2048, 4); // 4 размером 2048 байт { Устанавливает параметры дискретизации }With WaveRecorder.pWavefmtEx DoBeginwFormatTag := WAVE_FORMAT_PCM;nChannels := 1;nSamplesPerSec := 20000;wBitsPerSample := 16;nAvgBytesPerSec := nSamplesPerSec*(wBitsPerSample div 8)*nChannels;End; // Затем используем вариантную запись, поскольку я не знаю// как получить адрес самого объекта WaveRecorder.SetupRecord(@WaveRecorder); // Начинаем записьWaveRecorder.StartRecord; ... При каждом заполнении буфера вызываетсяпроцедура WaveRecorder.Processbuffer. // Заканчиваем записьWaveRecorder.StopRecord;WaveRecorder.Destroy; |
{ Имя файла: RECUNIT.PAS V 1.01Создан: Авг 19 1996 в 21:56 на IBM ThinkPadРевизия #7: Авг 22 1997, 15:01 на IBM ThinkPad-John Mertus Данный модуль содержит необходимые процедуры для записи звука. Версия 1.00 - первый релиз1.01 - добавлен TWaveInGetErrorText} {-----------------Unit-RECUNIT---------------------John Mertus---Авг 96---} Unit RECUNIT; {*************************************************************************} Interface Uses Windows, MMSystem, SysUtils, MSACM; { Ниже определен класс TWaveRecorder для обслуживания входа звуковой } { карты. Ожидается, что новый класс будет производным от TWaveRecorder } { и перекроет TWaveRecorder.ProcessBuffer. После начала записи данная } { процедура вызывается каждый раз при наличии в буфере аудио-данных. } Const MAX_BUFFERS = 8; type PWaveRecorder = ^TWaveRecorder;TWaveRecorder = class(TObject)Constructor Create(BfSize, TotalBuffers : Integer);Destructor Destroy; Override;Procedure ProcessBuffer(uMsg : Word; P : Pointer; n : Integer);Virtual; privatefBufferSize : Integer; // Размер буфераBufIndex : Integer;fTotalBuffers : Integer; pWaveHeader : Array [0..MAX_BUFFERS-1] of PWAVEHDR;hWaveHeader : Array [0..MAX_BUFFERS-1] of THANDLE;hWaveBuffer : Array [0..MAX_BUFFERS-1] of THANDLE;hWaveFmtEx : THANDLE;dwByteDataSize : DWORD;dwTotalWaveSize : DWORD; RecordActive : Boolean;bDeviceOpen : Boolean; { Внутренние функции класса }Function InitWaveHeaders : Boolean;Function AllocPCMBuffers : Boolean;Procedure FreePCMBuffers; Function AllocWaveFormatEx : Boolean;Procedure FreeWaveFormatEx; Function AllocWaveHeaders : Boolean;Procedure FreeWaveHeader; Function AddNextBuffer : Boolean;Procedure CloseWaveDeviceRecord; public{ Public declarations }pWaveFmtEx : PWaveFormatEx;WaveBufSize : Integer; // Размер поля nBlockAlignInitWaveRecorder : Boolean;RecErrorMessage : String;QueuedBuffers,ProcessedBuffers : Integer;pWaveBuffer : Array [0..MAX_BUFFERS-1] of lpstr;WaveIn : HWAVEIN; { Дескриптор Wav-устройства } Procedure StopRecord;Function 477576218068StartRecord : Boolean;Function477576218068 SetupRecord(P : PWaveRecorder) : Boolean; end; {*************************************************************************} implementation {-------------TWaveInGetErrorText-----------John Mertus---14-Июнь--97--} Function TWaveInGetErrorText(iErr : Integer) : String; { Выдает сообщения об ошибках WaveIn в формате Pascal } { iErr - номер ошибки } { } {**********************************************************************} Var PlayInErrorMsgC : Array [0..255] of Char; Begin waveInGetErrorText(iErr,PlayInErrorMsgC,255);TWaveInGetErrorText := StrPas(PlayInErrorMsgC);End; {-------------InitWaveHeaders---------------John Mertus---14-Июнь--97--} Function TWaveRecorder.AllocWaveFormatEx : Boolean; { Распределяем формат большого размера, требуемый для инсталляции ACM-в} { } {**********************************************************************} Var MaxFmtSize : UINT; BEGIN { maxFmtSize - сумма sizeof(WAVEFORMATEX) + pwavefmtex.cbSize }If( acmMetrics( 0, ACM_METRIC_MAX_SIZE_FORMAT, maxFmtSize ) <> 0) >ThenBeginRecErrorMessage := 'Ошибка получения размера формата максимального сжатия';AllocWaveFormatEx := False;Exit;End; { распределяем структуру WAVEFMTEX }hWaveFmtEx := GlobalAlloc(GMEM_MOVEABLE, maxFmtSize);If (hWaveFmtEx = 0) ThenBeginRecErrorMessage := 'Ошибка распределения памяти для структуры WaveFormatEx';AllocWaveFormatEx := False;Exit;End; pWaveFmtEx := PWaveFormatEx(GlobalLock(hWaveFmtEx));If (pWaveFmtEx = Nil) ThenBeginRecErrorMessage := 'Ошибка блокировки памяти WaveFormatEx';AllocWaveFormatEx := False;Exit;End; { инициализация формата в стандарте PCM }ZeroMemory( pwavefmtex, maxFmtSize );pwavefmtex.wFormatTag := WAVE_FORMAT_PCM;pwavefmtex.nChannels := 1;pwavefmtex.nSamplesPerSec := 20000;pwavefmtex.nBlockAlign := 1;pwavefmtex.wBitsPerSample := 16;pwavefmtex.nAvgBytesPerSec := pwavefmtex.nSamplesPerSec*(pwavefmtex.wBitsPerSample div 8)*pwavefmtex.nChannels;pwavefmtex.cbSize := 0; { Все успешно, идем домой }AllocWaveFormatEx := True;end; {-------------InitWaveHeaders---------------John Mertus---14-Июнь--97--} Function TWaveRecorder.InitWaveHeaders : Boolean; { Распределяем память, обнуляем заголовок wave и инициализируем } { } {**********************************************************************} Var i : Integer; BEGIN { делаем размер буфера кратным величине блока... }WaveBufSize := fBufferSize - (fBufferSize mod pwavefmtex.nBlockAlign); { Устанавливаем wave-заголовки }For i := 0 to fTotalBuffers-1 DoWith pWaveHeader[i]^ DoBeginlpData := pWaveBuffer[i]; // адрес буфера waveformdwBufferLength := WaveBufSize; // размер, в байтах, буфераdwBytesRecorded := 0; // смотри нижеdwUser := 0; // 32 бита данных пользователяdwFlags := 0; // смотри нижеdwLoops := 0; // смотри нижеlpNext := Nil; // зарезервировано; должен быть нольreserved := 0; // зарезервировано; должен быть нольEnd; InitWaveHeaders := TRUE;END; {-------------AllocWaveHeader----------------John Mertus---14-Июнь--97--} Function TWaveRecorder.AllocWaveHeaders : Boolean; { Распределяем и блокируем память заголовка } { } {***********************************************************************} Var i : Integer; BEGIN For i := 0 to fTotalBuffers-1 Dobeginhwaveheader[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE orGMEM_ZEROINIT, sizeof(TWAVEHDR)); if (hwaveheader[i] = 0) Thenbegin{ Примечание: Это может привести к утечке памяти, надеюсь скоро исправить }RecErrorMessage := 'Ошибка распределения памяти для wave-заголовка';AllocWaveHeaders := FALSE;Exit;end; pwaveheader[i] := GlobalLock (hwaveheader[i]);If (pwaveheader[i] = Nil ) Thenbegin{ Примечание: Это может привести к утечке памяти, надеюсь скоро исправить }RecErrorMessage := 'Не могу заблокировать память заголовка для записи';AllocWaveHeaders := FALSE;Exit;end; End; AllocWaveHeaders := TRUE;END; {---------------FreeWaveHeader---------------John Mertus---14-Июнь--97--} Procedure TWaveRecorder.FreeWaveHeader; { Просто освобождаем распределенную AllocWaveHeaders память. } { } {***********************************************************************} Var i : Integer; BEGIN For i := 0 to fTotalBuffers-1 DobeginIf (hWaveHeader[i] <> 0) ThenBeginGlobalUnlock(hwaveheader[i]);GlobalFree(hwaveheader[i]);hWaveHeader[i] := 0;Endend;END; {-------------AllocPCMBuffers----------------John Mertus---14-Июнь--97--} Function TWaveRecorder.AllocPCMBuffers : Boolean; { Распределяем и блокируем память waveform. } { } {***********************************************************************} Var i : Integer; BEGIN For i := 0 to fTotalBuffers-1 DobeginhWaveBuffer[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE, fBufferSize );If (hWaveBuffer[i] = 0) Thenbegin{ Здесь возможна утечка памяти }RecErrorMessage := 'Ошибка распределения памяти wave-буфера';AllocPCMBuffers := False;Exit;end; pWaveBuffer[i] := GlobalLock(hWaveBuffer[i]);If (pWaveBuffer[i] = Nil) Thenbegin{ Здесь возможна утечка памяти }RecErrorMessage := 'Ошибка блокирования памяти wave-буфера';AllocPCMBuffers := False;Exit;end;pWaveHeader[i].lpData := pWaveBuffer[i];End; AllocPCMBuffers := TRUE;END; {--------------FreePCMBuffers----------------John Mertus---14-Июнь--97--} Procedure TWaveRecorder.FreePCMBuffers; { Освобождаем использованную AllocPCMBuffers память. } { } {***********************************************************************} Var i : Integer; BEGIN For i := 0 to fTotalBuffers-1 DobeginIf (hWaveBuffer[i] <> 0) ThenBeginGlobalUnlock( hWaveBuffer[i] );GlobalFree( hWaveBuffer[i] );hWaveBuffer[i] := 0;pWaveBuffer[i] := Nil;End;end;END; {--------------FreeWaveFormatEx--------------John Mertus---14-Июнь--97--} Procedure TWaveRecorder.FreeWaveFormatEx; { Просто освобождаем заголовки ExFormat headers } { } {***********************************************************************} BEGIN If (pWaveFmtEx = Nil) Then Exit;GlobalUnlock(hWaveFmtEx);GlobalFree(hWaveFmtEx);pWaveFmtEx := Nil;END; {-------------TWaveRecorder.Create------------John Mertus-----Авг--97--} Constructor TWaveRecorder.Create(BFSize, TotalBuffers : Integer); { Устанавливаем wave-заголовки, инициализируем указатели данных и } { и распределяем буферы дискретизации } { BFSize - размер буфера в байтах } { } {**********************************************************************} Var i : Integer;BEGIN Inherited Create;For i := 0 to fTotalBuffers-1 DoBeginhWaveHeader[i] := 0;hWaveBuffer[i] := 0;pWaveBuffer[i] := Nil;pWaveFmtEx := Nil;End;fBufferSize := BFSize; fTotalBuffers := TotalBuffers;{ распределяем память для структуры wave-формата }If(Not AllocWaveFormatEx) ThenBeginInitWaveRecorder := FALSE;Exit;End; { ищем устройство, совместимое с доступными wave-характеристиками }If (waveInGetNumDevs < 1 ) ThenBeginRecErrorMessage := 'Не найдено устройств, способных записывать звук';InitWaveRecorder := FALSE;Exit;End; { распределяем память wave-заголовка }If (Not AllocWaveHeaders) ThenBeginInitWaveRecorder := FALSE;Exit;End; { распределяем память буфера wave-данных }If (Not AllocPCMBuffers) ThenBeginInitWaveRecorder := FALSE;Exit;End; InitWaveRecorder := TRUE; END; {---------------------Destroy----------------John Mertus---14-Июнь--97--} Destructor TWaveRecorder.Destroy; { Просто освобождаем всю память, распределенную InitWaveRecorder. } { } {***********************************************************************} BEGIN FreeWaveFormatEx;FreePCMBuffers;FreeWaveHeader;Inherited Destroy;END; {------------CloseWaveDeviceRecord-----------John Mertus---14-Июнь--97--} Procedure TWaveRecorder.CloseWaveDeviceRecord; { Просто освобождаем (закрываем) waveform-устройство. } { } {***********************************************************************} Var i : Integer; BEGIN { если устройство уже закрыто, то выходим }If (Not bDeviceOpen) Then Exit; { работа с заголовками - unprepare }For i := 0 to fTotalBuffers-1 DoIf (waveInUnprepareHeader(WaveIn, pWaveHeader[i], sizeof(TWAVEHDR)) <> 0 )Then RecErrorMessage := 'Ошибка в waveInUnprepareHeader'; { сохраняем общий объем записи и обновляем показ }dwTotalwavesize := dwBytedatasize; { закрываем входное wave-устройство }If (waveInClose(WaveIn) <> 0) ThenRecErrorMessage := 'Ошибка закрытия входного устройства'; { сообщаем вызвавшей функции, что устройство закрыто }bDeviceOpen := FALSE; END; {------------------StopRecord-----------------John Mertus---14-Июнь--97--} Procedure TWaveRecorder.StopRecord; { Останавливаем запись и устанавливаем некоторые флаги. } { } {***********************************************************************} Var iErr : Integer; BEGIN RecordActive := False;iErr := waveInReset(WaveIn);{ прекращаем запись и возвращаем стоящие в очереди буферы }If (iErr <> 0) ThenBeginRecErrorMessage := 'Ошибка в waveInReset';End; CloseWaveDeviceRecord;END; {--------------AddNextBuffer------------------John Mertus---14-Июнь--97--} Function TWaveRecorder.AddNextBuffer : Boolean; { Добавляем буфер ко входной очереди и переключаем буферный индекс. } { } {***********************************************************************} Var iErr : Integer; BEGIN { ставим буфер в очередь для получения очередной порции данных }iErr := waveInAddBuffer(WaveIn, pwaveheader[bufindex], sizeof(TWAVEHDR));If (iErr <> 0) ThenbeginStopRecord;RecErrorMessage := 'Ошибка добавления буфера' + TWaveInGetErrorText(iErr);AddNextBuffer := FALSE;Exit;end; { переключаемся на следующий буфер }bufindex := (bufindex+1) mod fTotalBuffers;QueuedBuffers := QueuedBuffers + 1; AddNextBuffer := TRUE;END; {--------------BufferDoneCallBack------------John Mertus---14-Июнь--97--} Procedure BufferDoneCallBack(hW : HWAVE; // дескриптор waveform-устройстваuMsg : DWORD; // посылаемое сообщениеdwInstance : DWORD; // экземпляр данныхdwParam1 : DWORD; // определяемый приложением параметрdwParam2 : DWORD; // определяемый приложением параметр); stdcall; { Вызывается при наличии у wave-устройства какой-либо информации, } { например при заполнении буфера } { } {***********************************************************************} Var BaseRecorder : PWaveRecorder;BEGIN BaseRecorder := Pointer(DwInstance);With BaseRecorder^ DoBeginProcessBuffer(uMsg, pWaveBuffer[ProcessedBuffers Mod fTotalBuffers],WaveBufSize); If (RecordActive) ThenCase uMsg ofWIM_DATA:BeginBaseRecorder.AddNextBuffer;ProcessedBuffers := ProcessedBuffers+1;End;End;End;END; {------------------StartRecord---------------John Mertus---14-Июнь--97--} Function TWaveRecorder.StartRecord : Boolean; { Начало записи. } { } {***********************************************************************} Var iErr, i : Integer; BEGIN { начало записи в первый буфер }iErr := WaveInStart(WaveIn);If (iErr <> 0) ThenbeginCloseWaveDeviceRecord;RecErrorMessage := 'Ошибка начала записи wave: ' +TWaveInGetErrorText(iErr); end; RecordActive := TRUE; { ставим в очередь следующие буферы }For i := 1 to fTotalBuffers-1 DoIf (Not AddNextBuffer) ThenBeginStartRecord := FALSE;Exit;End; StartRecord := True;END; {-----------------SetupRecord---------------John Mertus---14-Июнь--97--} Function TWaveRecorder.SetupRecord(P : PWaveRecorder) : Boolean; { Данная функция делает всю работу по созданию waveform-"записывателя". } { } {***********************************************************************} Var iErr, i : Integer; BEGIN dwTotalwavesize := 0;dwBytedatasize := 0;bufindex := 0;ProcessedBuffers := 0;QueuedBuffers := 0; { открываем устройство для записи }iErr := waveInOpen(@WaveIn, WAVE_MAPPER, pWaveFmtEx,Integer(@BufferDoneCallBack), Integer(P), CALLBACK_FUNCTION + WAVE_ALLOWSYNC );If (iErr <> 0) ThenBeginRecErrorMessage := 'Не могу открыть входное устройство для записи: ' + ^M+ TWaveInGetErrorText(iErr);SetupRecord := FALSE;Exit;End; { сообщаем CloseWaveDeviceRecord(), что устройство открыто }bDeviceOpen := TRUE; { подготавливаем заголовки } InitWaveHeaders(); For i := 0 to fTotalBuffers-1 DoBeginiErr := waveInPrepareHeader( WaveIn, pWaveHeader[I], sizeof(TWAVEHDR));If (iErr <> 0) ThenbeginCloseWaveDeviceRecord;RecErrorMessage := 'Ошибка подготовки заголовка для записи: ' + ^M +TWaveInGetErrorText(iErr);SetupRecord := FALSE;Exit;end;End; { добавляем первый буфер }If (Not AddNextBuffer) ThenbeginSetupRecord := FALSE;Exit;end; SetupRecord := TRUE;END; {-----------------ProcessBuffer---------------John Mertus---14-Июнь--97--} Procedure TWaveRecorder.ProcessBuffer(uMsg: Word; P : Pointer; n :Integer); { Болванка процедуры, вызываемой при готовности буфера. } { } {***********************************************************************} BEGIN END; END. |
[000242]