Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.04.2010, 15:44   #1
ImmortalAlexSan
Участник клуба
 
Аватар для ImmortalAlexSan
 
Регистрация: 13.01.2009
Сообщений: 1,353
По умолчанию Запись во временный буфер, фреймы, подпись пакетов

Пишу программу, которая будет передавать звук по сети, знаю основные этапы клиента и сервера, но не знаю как реализовать. Вопрос такой: как организовать запись во временный буфер звука с микрофона, далее разбить его на фреймы и подписать пакеты? Можно хотя бы с одним вопросом помочь, с первым. Я использую компоненты 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?
"Тебе то может на меня и насрать, но твои глаза меня обожают!"

Последний раз редактировалось ImmortalAlexSan; 05.04.2010 в 18:22.
ImmortalAlexSan вне форума Ответить с цитированием
Старый 05.04.2010, 18:57   #2
raxp
Старожил
 
Регистрация: 29.09.2009
Сообщений: 9,742
По умолчанию

...берете любой пример получения сигнала с микрофона, там создается два буфера, для накопления и вывода, они уже готовые ...как пример:
Код:
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
Разработки и научно-технические публикации :: Видеоблог :: Твиттер
Radar systems engineer & Software developer of industrial automation
raxp вне форума Ответить с цитированием
Старый 05.04.2010, 19:10   #3
ImmortalAlexSan
Участник клуба
 
Аватар для ImmortalAlexSan
 
Регистрация: 13.01.2009
Сообщений: 1,353
По умолчанию

Спасибо, raxp, буду разбираться с кодом. А вот компоненты ACMWaveIn, ACMWaveOut у меня есть и даже пример программы на них есть, но вот только этот пример не работает, если бы работал, то у меня сразу отпали бы все вопросы... А можно ещё попросить вас объяснить вот эти строчки?
Код:
type
TData16 = array [0..127] of smallint;
PData16 = ^TData16;
...
var
  data16:PData16;
  temp:pWaveHdr;
...
data16:=PData16(temp.lpData);
...
А то я сам чувствую не пойму...
"Тебе то может на меня и насрать, но твои глаза меня обожают!"

Последний раз редактировалось ImmortalAlexSan; 05.04.2010 в 19:22.
ImmortalAlexSan вне форума Ответить с цитированием
Старый 05.04.2010, 20:56   #4
raxp
Старожил
 
Регистрация: 29.09.2009
Сообщений: 9,742
По умолчанию

...получение массива данных через указатель на область памяти ...полный вид таков:
Код:
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 все тоже самое...
Разработки и научно-технические публикации :: Видеоблог :: Твиттер
Radar systems engineer & Software developer of industrial automation
raxp вне форума Ответить с цитированием
Старый 05.04.2010, 23:39   #5
ImmortalAlexSan
Участник клуба
 
Аватар для ImmortalAlexSan
 
Регистрация: 13.01.2009
Сообщений: 1,353
По умолчанию

Я вот тут немного разобрался с считыванием звука с микрофона. Нашел код и разобрался ПОЧТИ в нем, т.е. я большую часть понимаю, а пару каких-то строк в каждой процедуре - не понимаю! И от этого непонимая становится ещё больше, чем могло бы быть при полном непонимании кода!
Код:
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.
Дело в том, что при запуске кода выбивает сообщение: "Операция успешно завершена" и всё! Дальше ничего не происходит, я стучу, говорю, кричу в микрофон, эффекта - ноль! Нет красных линий на черной форме!!! Вот та строка, что я отметил, может быть в ней проблема? Типа не может определить формат и так далее. Я столько нового за сегодня узнал, что голова готова взорваться! Что мне делать?
"Тебе то может на меня и насрать, но твои глаза меня обожают!"
ImmortalAlexSan вне форума Ответить с цитированием
Старый 06.04.2010, 11:44   #6
raxp
Старожил
 
Регистрация: 29.09.2009
Сообщений: 9,742
По умолчанию

...постом выше приведена готовая процедура получения аудиоданных, используйте ее (весь код http://pblog.ru/?p=658)
...проверить вашу не могу, голый браузер на машине сейчас, но у себя проверьте - происходит-ли работа в вашем WndProc(), если нет - то переназначьте WaveInOpen(WaveIn, 0, @WaveFormat, Handle, 0, CALLBACK_WINDOW) на WaveInOpen(WaveIn, WAVE_MAPPER, @WaveFormat,integer(@waveInProc), 0,CALLBACK_FUNCTION), ну и соответственно событие перепишите.
Разработки и научно-технические публикации :: Видеоблог :: Твиттер
Radar systems engineer & Software developer of industrial automation
raxp вне форума Ответить с цитированием
Старый 06.04.2010, 11:55   #7
ImmortalAlexSan
Участник клуба
 
Аватар для ImmortalAlexSan
 
Регистрация: 13.01.2009
Сообщений: 1,353
По умолчанию

Спасибо за статью, изучу сегодня. А под событием что вы понимаете? Я просто не все в коде этом понимаю...
"Тебе то может на меня и насрать, но твои глаза меня обожают!"
ImmortalAlexSan вне форума Ответить с цитированием
Старый 06.04.2010, 12:09   #8
raxp
Старожил
 
Регистрация: 29.09.2009
Сообщений: 9,742
По умолчанию

...получение WIM_DATA.
Разработки и научно-технические публикации :: Видеоблог :: Твиттер
Radar systems engineer & Software developer of industrial automation
raxp вне форума Ответить с цитированием
Старый 07.04.2010, 15:48   #9
ImmortalAlexSan
Участник клуба
 
Аватар для ImmortalAlexSan
 
Регистрация: 13.01.2009
Сообщений: 1,353
По умолчанию

Вернемся к разобранному. Скажите пожалуйста, где у меня в коде ошибка:
Код:
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;
"Тебе то может на меня и насрать, но твои глаза меня обожают!"
ImmortalAlexSan вне форума Ответить с цитированием
Старый 07.04.2010, 16:01   #10
raxp
Старожил
 
Регистрация: 29.09.2009
Сообщений: 9,742
По умолчанию

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
Разработки и научно-технические публикации :: Видеоблог :: Твиттер
Radar systems engineer & Software developer of industrial automation
raxp вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
WEB - программист. Временный сотрудник - работа дому. Julia G Фриланс 2 23.03.2010 21:45
Как найти временный файл bakabul JavaScript, Ajax 1 01.11.2008 09:44
Временный проект по DirectX (Москва) _HR Фриланс 1 19.02.2008 13:14
Запись в буфер Delphi & Asm SteelRat Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 14 27.02.2007 22:49