Запись во временный буфер, фреймы, подпись пакетов

[ImmortalAlexSan]

Пишу программу, которая будет передавать звук по сети, знаю основные этапы клиента и сервера, но не знаю как реализовать. Вопрос такой: как организовать запись во временный буфер звука с микрофона, далее разбить его на фреймы и подписать пакеты? Можно хотя бы с одним вопросом помочь, с первым. Я использую компоненты ACS и написал программу для записи звука с микрофона в файл. вот код:

procedure TForm1.Button2Click(Sender: TObject);
Var ext:String;
begin
SaveDialog1.Execute;
ext:=ExtractFileExt(SaveDialog1.FileName);
If ext='.wav' then
Output:=WaveOut1;
Output.FileName := SaveDialog1.FileName;
Output.Run;
end;

end.

С буфером дел не имел вообще. Какая разница между TStream и TThread?

[raxp]

...берете любой пример получения сигнала с микрофона, там создается два буфера, для накопления и вывода, они уже готовые ...как пример:

procedure waveInProc2(hwi: HWAVEIN; uMsg,dwInstance,dwParam1,dwParam2: DWORD);stdcall;
var i      : integer;
    data16 : PData16;
    temp   : pWaveHdr;
    //
    a,f,cntval: double;
begin
 if (uMsg=WIM_DATA)and(stp) then begin
  temp:= adr2;
  if adr2= @bufhead1 then adr2:= @bufhead2
   else adr2:= @bufhead1;
  //
  if stp then WaveInAddBuffer(hwi,adr2,SizeOf(TWaveHdr));
  data16:= PData16(temp.lpData); - ВОТ ОН ВАШ БУФЕР, все остальное лишнее

  if (not lock) then try inwav.Clear; outwav.Clear; spektr.Clear;
  for i := 0 to BufSize - 1 do begin //набиваем-
   inwav.add(data16^[i])
  end;

{
  //TDTMF(dwInstance).FFTQuad(inwav, outwav, fcntpp);
  FFTQuad(inwav, outwav, fcntpp);

  //спектр и 2-x проходный поиск -----
  a1:= -1000;
  cntval:= header.nSamplesPerSec / outwav.YValues.Count;
  for i:= 0 to (outwav.YValues.Count)-1 do begin //
   a:= outwav.YValues[i];
   f:= i * cntval;
   if a>=0 then spektr.AddXY(f,a)
    else spektr.AddXY(f,0);

   if a > a1 then begin a1:= a; f1:= f end                  //частота для 1-
  end;
  a2:= -1000;
  for i:= (outwav.YValues.Count)-1 downto 0 do begin
   a:= outwav.YValues[i];
   f:= i * cntval;
   if (a > a2)and(a<>a1) then begin a2:= a; f2:= f end      //частота для 2-
  end;
  
  //идентификация-
  signal:= '';
  for i:= 1 to 16 do begin
   if (DTMF2[i]*0.98<f1)and(DTMF2[i]*1.02>f1)and  //1 амплитуда >2
    (DTMF1[i]*0.98<f2)and(DTMF1[i]*1.02>f2)then begin
      signal:= keys[i];
      break
     end;
   if (DTMF1[i]*0.98<f1)and(DTMF1[i]*1.02>f1)and  //1 амплитуда >2
    (DTMF2[i]*0.98<f2)and(DTMF2[i]*1.02>f2)then begin
      signal:= keys[i];
      break
     end;
  end;
  //
  spektr.Title:= 'DTMF('+ signal +'):  ' +
                 format('A1= %.2n',[a1])+ formatfloat(' [0 Hz]  ',f1) +
                 format('A2= %.2n',[a2])+ formatfloat(' [0 Hz]',f2);
}
  //-----------------------------------
  except end
 end else Exit
end;

p.s.:
1- в либе ACS есть спецкомпоненты для передачи-приема звукового потока с любого аудиослота TDXAudioin/TStreamOut/TStreamIn по сети
2- ACMWaveIn, ACMWaveOut больше подходят под вашу задачу скачать

сопутствующие темы 1 2 3

[ImmortalAlexSan]

Спасибо, raxp, буду разбираться с кодом. А вот компоненты ACMWaveIn, ACMWaveOut у меня есть и даже пример программы на них есть, но вот только этот пример не работает, если бы работал, то у меня сразу отпали бы все вопросы... А можно ещё попросить вас объяснить вот эти строчки?

type
TData16 = array [0..127] of smallint;
PData16 = ^TData16;
...
var
  data16:PData16;
  temp:pWaveHdr;
...
data16:=PData16(temp.lpData);
...

А то я сам чувствую не пойму...

[raxp]

...получение массива данных через указатель на область памяти ...полный вид таков:

procedure waveInProc2(hwi: HWAVEIN; uMsg,dwInstance,
                     dwParam1,dwParam2: DWORD);stdcall;
var i: integer;
    data16: PData16;
    temp: pWaveHdr;
begin
 if (uMsg=WIM_DATA)and(stp2) then begin
  temp:= adr2;
  if adr2= @bufhead1 then adr2:= @bufhead2
   else adr2:= @bufhead1;
  //
  if stp2 then WaveInAddBuffer(hwi,adr2,SizeOf(TWaveHdr));
  //
  data16:= PData16(temp.lpData);
  try inwav.Clear;
  for i := 0 to BufSize - 1 do begin //набиваем-
   inwav.add(data16^[i]) // тут для наглядности можно вывести в TChart
  end;

  except end
 end else Exit
end;


procedure wcard;
const rbuf=6;
var BufLen: word;
    buf: pointer;
begin
 try
 //
 stp2:=not stp2;
 if stp2 then begin

  BufSize:= rbuf * 500 + 5;
  with header do begin
   wFormatTag:= WAVE_FORMAT_PCM;
   nChannels := 2;
   nSamplesPerSec:= 44100;
   wBitsPerSample:= 16;
   nBlockAlign:= nChannels * (wBitsPerSample div 8);
   nAvgBytesPerSec:= nSamplesPerSec * nBlockAlign;
   cbSize:= 0;
  end;

  WaveInOpen(Addr(hwi2), WAVE_MAPPER, addr(header),integer(@waveInProc2),
             0,CALLBACK_FUNCTION);

  BufLen:= header.nBlockAlign * BufSize;
  hBuf:= GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
  Buf:= GlobalLock(hBuf);

  with BufHead1 do begin
   lpData:= Buf;
   dwBufferLength:= BufLen;
   dwFlags:= 0;
  end;

  with BufHead2 do begin
   lpData:= Buf;
   dwBufferLength:= BufLen;
   dwFlags:= 0;
  end;

  adr2:= @BufHead1;
  waveInPrepareHeader(hwi2, Addr(BufHead1), sizeof(BufHead1));
  waveInPrepareHeader(hwi2, Addr(BufHead2), sizeof(BufHead2));
  WaveInAddBuffer(hwi2, addr(BufHead1), sizeof(BufHead1));
  GetMem(pnt, BufSize * sizeof(TPoint));
  WaveInStart(hwi2);
 //стоп
 end else begin

  WaveInReset(hwi2);
  WaveInUnPrepareHeader(hwi2, addr(BufHead1), sizeof(BufHead1));
  WaveInClose(hwi2);
  GlobalUnlock(hBuf); GlobalFree(hBuf);
 end; except end
end;

но поверьте, в asmin все тоже самое...

[ImmortalAlexSan]

Я вот тут немного разобрался с считыванием звука с микрофона. Нашел код и разобрался ПОЧТИ в нем, т.е. я большую часть понимаю, а пару каких-то строк в каждой процедуре - не понимаю! И от этого непонимая становится ещё больше, чем могло бы быть при полном непонимании кода!

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, MMSystem, ScktComp, SyncObjs,
  ACS_Classes, ACS_Wave, ACS_DXAudio, clipbrd, ACS_WinMedia;
type
  TWavArrayBuf = array[0..1023]of byte;
  PWavArrayBuf = ^TWavArrayBuf;
TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    WaveFormat: TWaveFormatEx;
    WaveIn: PHWaveIn;
    procedure WndProc(var Msg: TMessage); override;
    function InitWaveIn: Boolean;
    procedure CloseWaveIn;
end;
var
  Form1: TForm1;

implementation
uses Math;

{$R *.DFM}

function TForm1.InitWaveIn: Boolean;   
var  
  I, Err: Integer;   
  WaveHdr: PWaveHdr;
  WavBuff: PWavArrayBuf;
    
  procedure FreeData;
  begin  
    if WavBuff <> nil then Dispose(WavBuff);
    if WaveHdr <> nil then Dispose(WaveHdr);   
    if WaveIn <> nil then Dispose(WaveIn);
  end;
begin  
  Result := False;
  WaveFormat.wFormatTag := WAVE_FORMAT_PCM; //ЧУТЬЕ МНЕ ГОВОРИТ ЧТО ПРОБЛЕМА ЗДЕСЬ!!!
  WaveFormat.nChannels := 1;    
  WaveFormat.nSamplesPerSec := 44100;
  WaveFormat.nAvgBytesPerSec := 44100;
  WaveFormat.nBlockAlign := 4;
  WaveFormat.wBitsPerSample := 8;   
  WaveIn := New(PHWaveIn);   
  Err := WaveInOpen(WaveIn, 0, @WaveFormat, Handle, 0, CALLBACK_WINDOW);
  if Err <> 0 then Exit;
  for i:=1 to 8 do  
  begin  
    WavBuff := New(PWavArrayBuf);   
    WaveHdr := New(PWaveHdr);   
    with WaveHdr^ do  
    begin
      lpData := Pointer(WavBuff);   
      dwBufferLength := SizeOf(WavBuff);   
      dwBytesRecorded := 0;   
      dwUser := 0;   
      dwFlags := 0;   
      dwLoops := 0;   
    end;   
    Err := WaveInPrepareHeader(WaveIn^, WaveHdr, SizeOf(TWaveHdr));   
    if Err <> 0 then  
    begin
      FreeData;   
      Exit;   
    end;   
    Err := WaveInAddBuffer(WaveIn^, WaveHdr, Sizeof(TWaveHdr));   
    if Err <> 0 then  
    begin  
      FreeData;   
      Exit;   
    end;   
  end;
  Err := WaveInStart(WaveIn^);   
  if Err <> 0 then  
  begin  
    FreeData;   
    Exit;   
  end;   
  Result := True;   
end;

Procedure Tform1.WndProc(var Msg: TMessage);
var  
  Hdr: PWaveHdr;   
  I: Integer;   
  R: Real;   
begin  
  inherited;   
  case Msg.Msg of  
    MM_WIM_DATA:   
    begin  
      Hdr := PWaveHdr(Msg.LParam);
      if Hdr^.dwBytesRecorded = 0 then Exit;   
      R := IfThen(Hdr^.dwBytesRecorded > 0,   
        ClientWidth / Hdr^.dwBytesRecorded, 0);   
      PatBlt(Canvas.Handle, 0, 0, ClientWidth,  ClientHeight, PATCOPY);   
      Canvas.Pen.Color:=clRed;   
      Canvas.MoveTo(0, 127);   
      Canvas.LineTo(ClientWidth, 127);   
      Canvas.Pen.Color := clMaroon;   
      for I := 1 to 12 do  
      begin
        Canvas.MoveTo(Round(R * (I * 100)), 0);   
        Canvas.LineTo(Round(R * (I * 100)), 255);   
      end;   
      Canvas.Pen.Color:=clLime;   
      Canvas.MoveTo(0, PWavArrayBuf(Hdr.lpData)^[0]);   
      for I := 0 to Hdr^.dwBytesRecorded - 1 do  
        Canvas.LineTo(Round(R * I), PWavArrayBuf(Hdr.lpData)^[I]);   
    
      WaveInUnprepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr));   
      Dispose(hdr.lpData);
      DisPose(hdr);   
    
      Hdr := New(PWaveHdr);   
      Hdr^.lpData := Pointer(New(PWavArrayBuf));   
      Hdr^.dwBufferLength := 1024;   
      Hdr^.dwBytesRecorded := 0;   
      Hdr^.dwUser := 0;   
      Hdr^.dwFlags := 0;   
      Hdr^.dwLoops := 0;   

      WaveInPrepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr));   
      WaveInAddBuffer(WaveIn^, Hdr, Sizeof(TWaveHdr));   
    end;   
  end;   
end;   
    
procedure TForm1.CloseWaveIn;   
begin  
  WaveInStop(WaveIn^);   
  if WaveIn <> nil then
  begin  
    WaveInReset(WaveIn^);   
    WaveInClose(WaveIn^);   
  end;   
  Dispose(WaveIn);   
end;   
    
procedure TForm1.FormCreate(Sender: TObject);   
begin  
  DoubleBuffered := True;
  Height := 282;   
  Width := 1000;   
  Color := clBlack;   
  if not InitWaveIn then ShowMessage(SysErrorMessage(GetLastError));   
end;   

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseWaveIn;
end;


end.

Дело в том, что при запуске кода выбивает сообщение: "Операция успешно завершена" и всё! Дальше ничего не происходит, я стучу, говорю, кричу в микрофон, эффекта - ноль! Нет красных линий на черной форме!!! Вот та строка, что я отметил, может быть в ней проблема? Типа не может определить формат и так далее. Я столько нового за сегодня узнал, что голова готова взорваться! Что мне делать?

[raxp]

...постом выше приведена готовая процедура получения аудиоданных, используйте ее (весь код http://pblog.ru/?p=658)
...проверить вашу не могу, голый браузер на машине сейчас, но у себя проверьте - происходит-ли работа в вашем WndProc(), если нет - то переназначьте WaveInOpen(WaveIn, 0, @WaveFormat, Handle, 0, CALLBACK_WINDOW) на WaveInOpen(WaveIn, WAVE_MAPPER, @WaveFormat,integer(@waveInProc), 0,CALLBACK_FUNCTION), ну и соответственно событие перепишите.

[ImmortalAlexSan]

Спасибо за статью, изучу сегодня. А под событием что вы понимаете? Я просто не все в коде этом понимаю...

[raxp]

...получение WIM_DATA.

[ImmortalAlexSan]

Вернемся к разобранному. Скажите пожалуйста, где у меня в коде ошибка:

procedure TMainForm.Button2Click(Sender: TObject);
Var
   hwi:integer;
   WaveIn:PHWAVEIN;
   WaveFormat: tWAVEFORMATEX;
   WaveHdr:PWaveHdr;
   T:TWaveHdr;
   BufferSize:integer; //áóôåð äëÿ çàïèñè 10 ñåêóíä çâóêà
begin
hwi:=0;
With WaveFormat do
begin
wFormatTag:=WAVE_FORMAT_4S16;
nChannels:=2;
nSamplesPerSec:=44100;
nAvgBytesPerSec:=44100;
nBlockAlign:=4;
wBitsPerSample:=16;
cbSize:=0;
end;
waveInOpen(WaveIn,hwi,@WaveFormat,Handle,0,CALLBACK_WINDOW);
BufferSize:=WaveFormat.nBlockAlign*WaveFormat.nSamplesPerSec*10;
WaveHdr.lpData:=@Buffersize;
WaveHdr.dwBufferLength:=BufferSize;
waveInPrepareHeader(hwi,@WaveHdr,Sizeof(WaveHdr));
waveInAddBuffer(hwi,@WaveHdr,Sizeof(WaveHdr));
waveInStart(hwi);
waveInUnprepareHeader(hwi,@WaveHdr, sizeof(WaveHdr));
FreeMemory(@WaveHdr.lpData);
waveInClose(hwi);
end;

[raxp]

1- waveInOpen(WaveIn,hwi,
2-

waveInOpen(WaveIn,hwi,@WaveFormat,Handle,0,CALLBACK_WINDOW);
BufferSize:=WaveFormat.nBlockAlign*WaveFormat.nSamplesPerSec*10;
WaveHdr.lpData:=@Buffersize;
WaveHdr.dwBufferLength:=BufferSize;
waveInPrepareHeader(hwi,@WaveHdr,Sizeof(WaveHdr));
waveInAddBuffer(hwi,@WaveHdr,Sizeof(WaveHdr));
waveInStart(hwi);

// перед этим инициировали и тут-же обломали
waveInUnprepareHeader(hwi,@WaveHdr, sizeof(WaveHdr));
FreeMemory(@WaveHdr.lpData);
waveInClose(hwi);

3- вы пример c поста #6 смотрели, там достаточно скопировать код 1:1