Запись звука (виснет остановка) , 2 почти одинаковые проги, всю сломал голову

[Jin X]

Есть 2 кода. Суть одна и та же (в плане записи звука), вот только в перовой всё работает нормально:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MMSystem, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Label1: TLabel;
    ComboBox1: TComboBox;
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Image1: TImage;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  WaveHdr: array [0..1] of TWAVEHDR;
  H: HWAVEIN;
  Buf: array [0..1, 0..1023] of Integer;
  N: Integer;
  F: File;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  DevIn: TWAVEINCAPS;
begin
  for i := -1 to waveInGetNumDevs-1 do
  begin
    waveInGetDevCaps(i, @DevIn, SizeOf(DevIn));
    ComboBox1.Items.Add(DevIn.szPname)
  end;
  ComboBox1.ItemIndex := 0;
  with Image1.Canvas do FillRect(ClipRect)
end;
 
procedure waveInProc(hwi: HWAVEIN; uMsg, dwInstance, dwParam1, dwParam2: DWord); stdcall;
begin
  if uMsg = MM_WIM_DATA then
  begin
    BlockWrite(F, Buf[N], SizeOf(Buf[N]));
    WaveHdr[N].dwFlags := 0;
    waveInPrepareHeader(H, @WaveHdr[N], SizeOf(WaveHdr[N]));
    waveInAddBuffer(H, @WaveHdr[N], SizeOf(WaveHdr[N]));
    N := N xor 1
  end;
  Form1.Edit1.Text := IntToStr(StrToInt(Form1.Edit1.Text)+1)
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  WaveFmt: TWAVEFORMATEX;
  i: Integer;
begin
  with WaveFmt do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1;
    nSamplesPerSec := 44100;
    wBitsPerSample := 16;
    nBlockAlign := nChannels*wBitsPerSample div 8;
    nAvgBytesPerSec := nSamplesPerSec*nBlockAlign;
    cbSize := 0
  end;
  if waveInOpen(@H, ComboBox1.ItemIndex-1, @WaveFmt, DWord(@waveInProc), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
  begin
    MessageBox(0, 'Не открывается девайс :(', 'Ошибка!', MB_OK or MB_ICONERROR or MB_TASKMODAL);
    Exit
  end;
  FillChar(WaveHdr, SizeOf(WaveHdr), 0);
  for i := 0 to 1 do
    with WaveHdr[i] do
    begin
      lpData := @Buf[i];
      dwBufferLength := SizeOf(Buf[i]);
      waveInPrepareHeader(H, @WaveHdr[i], SizeOf(WaveHdr[i]));
      waveInAddBuffer(H, @WaveHdr[i], SizeOf(WaveHdr[i]))
    end;
  AssignFile(F, 'D:\rec.wav');
  Rewrite(F, 1);
  waveInStart(H);
  Button1.Enabled := False;
  Button2.Enabled := True
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var i: Integer;
begin
  waveInStop(H);
  BlockWrite(F, Buf[N], WaveHdr[N].dwBytesRecorded);
  CloseFile(F);
  for i := 0 to 1 do
    waveInUnprepareHeader(H, @WaveHdr[i], SizeOf(WaveHdr[i]));
  waveInClose(H);
  Button1.Enabled := True;
  Button2.Enabled := False
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Button2.Enabled then Button2.Click
end;
 
end.

А вот тут проблема:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MMSystem, ComCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Label1: TLabel;
    cmbDevice: TComboBox;
    btnStart: TButton;
    btnStop: TButton;
    pbNow: TProgressBar;
    pbMax: TProgressBar;
    tmrBars: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure tmrBarsTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  TWAVEINCAPS2 = record
    Caps: TWAVEINCAPS;
    ManufacturerGuid, ProductGuid, NameGuid: TGUID
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
type
  TBuf = array [0..1023] of SmallInt;
  PBuf = ^TBuf;
var
  WaveHdr: array [0..1] of TWAVEHDR;
  WaveH: HWAVEIN;
  Buf: array [Low(WaveHdr)..High(WaveHdr)] of TBuf;
  Err: Integer;
  ErrMsg: array [0..256] of Char;
  WaveNow, WaveMax: Integer;
  Done: Integer;
 
procedure waveInProc(hwi: HWAVEIN; uMsg, dwInstance, dwParam1, dwParam2: DWord); stdcall;
var i, N, wMin, wMax: Integer;
begin
  if uMsg = MM_WIM_DATA then
  begin
    with PWAVEHDR(dwParam1)^ do
    begin
      WaveNow := 0;
      wMin := 0;
      wMax := 0;
      if dwBytesRecorded = 0 then Exit;
      for i := 0 to dwBytesRecorded div 2-1 do
      begin
        N := PBuf(lpData)^[i];
        if N < wMin then wMin := N;
        if N > wMax then wMax := N
      end;
      dwFlags := dwFlags and (not WHDR_DONE);
    end;
    N := (wMax - wMin) div 2;
    WaveNow := N;
    if N > WaveMax then WaveMax := N;
    if Done = 0 then waveInAddBuffer(WaveH, PWAVEHDR(dwParam1), SizeOf(WaveHdr[Low(WaveHdr)]))
    else Done := 2
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  DevIn: TWAVEINCAPS;
begin
  for i := -1 to waveInGetNumDevs-1 do
  begin
    FillChar(DevIn, SizeOf(DevIn), 0);
    waveInGetDevCaps(i, @DevIn, SizeOf(DevIn));
    cmbDevice.Items.Add(DevIn.szPname)
  end;
  cmbDevice.ItemIndex := 0
end;
 
procedure TForm1.btnStartClick(Sender: TObject);
var
  WaveFmt: TWAVEFORMATEX;
  i: Integer;
begin
  btnStart.Enabled := False;
 
  WaveNow := 0;
  WaveMax := 0;
  with WaveFmt do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1;
    nSamplesPerSec := 44100;
    wBitsPerSample := 16;
    nBlockAlign := nChannels*wBitsPerSample shr 3;
    nAvgBytesPerSec := nSamplesPerSec*nBlockAlign;
    cbSize := 0
  end;
  Err := waveInOpen(@WaveH, cmbDevice.ItemIndex-1, @WaveFmt, DWord(@waveInProc), 0, CALLBACK_FUNCTION);
  if Err <> MMSYSERR_NOERROR then
  begin
    waveInGetErrorText(Err, @ErrMsg, SizeOf(ErrMsg));
    MessageBox(0, ErrMsg, 'Ошибка!', MB_OK or MB_ICONERROR or MB_TASKMODAL);
    btnStart.Enabled := True;
    Exit
  end;
 
  for i := Low(WaveHdr) to High(WaveHdr) do
  begin
    with WaveHdr[i] do
    begin
      lpData := @Buf[i];
      dwBufferLength := SizeOf(Buf[i]);
    end;
    Err := waveInPrepareHeader(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]));
    if Err = MMSYSERR_NOERROR then Err := waveInAddBuffer(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]));
    if Err <> MMSYSERR_NOERROR then
    begin
      waveInGetErrorText(Err, @ErrMsg, SizeOf(ErrMsg));
      MessageBox(0, ErrMsg, 'Ошибка!', MB_OK or MB_ICONERROR or MB_TASKMODAL);
      btnStart.Enabled := True;
      Exit
    end
  end;
 
  Err := waveInStart(WaveH);
  if Err <> MMSYSERR_NOERROR then
  begin
    waveInGetErrorText(Err, @ErrMsg, SizeOf(ErrMsg));
    MessageBox(0, ErrMsg, 'Ошибка!', MB_OK or MB_ICONERROR or MB_TASKMODAL);
    btnStart.Enabled := True;
    Exit
  end;
 
  Done := 0;
  btnStop.Enabled := True;
  tmrBars.Enabled := True
end;
 
procedure TForm1.btnStopClick(Sender: TObject);
var i: Integer;
begin
  btnStop.Enabled := False;
 
  Done := 1;
  repeat
    Application.ProcessMessages
  until Done = 2;
 
  Err := waveInStop(WaveH);
  for i := Low(WaveHdr) to High(WaveHdr) do
    waveInUnprepareHeader(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]));
  Err := waveInClose(WaveH);
  if Err <> MMSYSERR_NOERROR then
  begin
    waveInGetErrorText(Err, @ErrMsg, SizeOf(ErrMsg));
    MessageBox(0, ErrMsg, 'Ошибка!', MB_OK or MB_ICONERROR or MB_TASKMODAL);
    btnStart.Enabled := True;
    Exit
  end;
 
  btnStart.Enabled := True;
  tmrBars.Enabled := False
end;
 
procedure TForm1.tmrBarsTimer(Sender: TObject);
begin
  pbNow.Position := Round(Ln(WaveNow+1)/Ln(32768)*100);
  pbMax.Position := Round(Ln(WaveMax+1)/Ln(32768)*100)
end;
 
end.

Если убрать переменную Done и всё, что с ней связано, а именно:

  Done := 1;
  repeat
    Application.ProcessMessages
  until Done = 2;

то после нажатии кнопки "Стоп" (btnStop) прога зависает на вызове waveInStop (если заменить её на waveInReset, будет то же самое)
waveInAddBuffer выдаёт 0, т.е. ошибок в этом месте нет. Индикаторы (ProgressBar'ы) pbNow и pbMax дёргаются исправно.
Но вот этот кусок с Application.ProcessMessages мне вообще не нравится и не нужен. Но ведь его нет в первой проге, и всё нормально работает.
В чём проблема???

[Prince]

program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,windows,  mmsystem;
 
const
      bufsize=4096;
      bufcount=10;
      freq=48000;
 
var
  fmt:twaveformatex;
  hwi:hwavein;
  bufcounter:integer=0;
  i,mode:integer;
  headers:array[0..bufcount-1] of pwavehdr;
 
procedure waveinproc(hwi:hwavein; umsg:uint;
          dwInstance, dwParam1, dwParam2: DWord);stdcall;
  begin
  case umsg of
    wim_open:
              begin
              //
              end;
    wim_data: begin
               if mode<>0 then
                begin
                waveinaddbuffer(hwi,PWAVEHDR(dwParam1),sizeof(twavehdr));
                end
                else begin
                      dec(bufcounter);
                     end;
                end;
  wim_close:
          begin
          //
          end;
  end;
end;
 
begin
 
  fmt.wFormatTag:=1;
  fmt.nChannels:=2;
  fmt.nSamplesPerSec:=freq;
  fmt.wBitsPerSample:=16;
  fmt.nBlockAlign:= fmt.wBitsPerSample shr 3 * fmt.nChannels;
  fmt.nAvgBytesPerSec:=fmt.nSamplesPerSec*fmt.nBlockAlign;
  fmt.cbSize:=0;
 
waveinopen(@hwi,0,@fmt,dword(@waveinproc),0,callback_function);
 
  for i:=0 to bufcount -1 do
    begin
      headers[i]:=allocmem(sizeof(twavehdr));
      headers[i].lpData:=allocmem(bufsize);
      headers[i].dwBufferLength:=bufsize;
      headers[i].dwFlags:=0;
      waveinprepareheader(hwi,headers[i],sizeof(twavehdr));
      waveinaddbuffer(hwi,headers[i],sizeof(twavehdr));
      inc(bufcounter);
    end;
 
  mode:=1;
  waveinstart(hwi);
 
  readln;
 
  mode:=0;
  waveinreset(hwi);
  repeat
  until bufcounter=0;
  for i:=0 to bufcount-1 do
    begin
      waveinunprepareheader(hwi,headers[i],sizeof(twavehdr));
      freemem(headers[i].lpData,bufsize);
      freemem(headers[i],sizeof(twavehdr));
    end;
  waveinclose(hwi);
 
 
end.

Добавлено 09.02.16, 18:08

Цитата

В чём проблема???

Приаттачил бы проект. Неудобно дебажить глазами.

[Jin X]

Цитата Prince @ 09.02.16, 18:05

Приаттачил бы проект. Неудобно дебажить глазами.

Ок, приаттачил
Закомментил тот кусок, чтобы было видно, как прога зависает на btnStopClick.
p.s. Прога working будет писать файл D:\rec.wav
Прикреплённый файлprojects.zip (9,34 Кбайт, скачиваний: 123)

[Pavia]

Jin X
У вас оба кода неправильных. А то что один из них работает просто везение или совпадение.

waveInStop, waveInReset
Дело в том что эти функции основаны на сообщениях. Сообщение хотя и отправлено драйверу и получено подтверждение о доставке. На самом деле драйвер его ещё не обработал его.

Нужно дождаться пока отработает waveInProc. И выставится бит Done.

А также вы не выполняете запрет

Цитата

A WaveProc function should not call other Wave* APIs; if it does, it will probably deadlock.

Добавлено 09.02.16, 21:55
Думаю тут нет лёгкого пути. Хотя.

Такой вопрос вас устроит статья виде?
Проблема - решение.
Просто если рассказывать почему именно выбрано такое решение, то боюсь получится целая книга.

[Jin X]

Цитата Pavia @ 09.02.16, 21:37

waveInStop, waveInReset
Дело в том что эти функции основаны на сообщениях. Сообщение хотя и отправлено драйверу и получено подтверждение о доставке. На самом деле драйвер его ещё не обработал его.
Нужно дождаться пока отработает waveInProc. И выставится бит Done.

Секунду. Как это так? Я кое-что понял. Дождаться нужно, когда выставится бит DONE именно перед тем, как сделать waveInUnprepareHeader (а не waveInReset, как это было у меня в закомментированном коде). Но(!) смысла в этом нет, т.к. waveInReset выйдет из цикла только тогда, когда закончатся все буферы (т.е. callback-функции перестанут добавлять буферы... кстати, если добавить хотя бы один буфер после вызова waveInReset, эта функция просто зависнет, при этом даже не будет вызвана callback-функция для оставшихся буферов, waveInReset зависает сразу – бред, но факт – проверено). И получается, что waveInStop – это реально аналог waveOutPause, только назвал по-другому зачем-то (во тупняк!) Потому что если заменить в приведённом от Prince коде waveInReset на waveInStop, то прога тоже зависнет на цикле repeat/until, т.к. callback-функция вызываться не будет (и уменьшать bufcounter).

У меня только 2 вопроса:
1. Почему waveInReset не вызывает callback-функцию для новых добавленных буферов с dwBytesRecorded = 0, а просто зависает (см. выше моя слова про бред)? Тогда бы прога завершала цикл на if dwBytesRecorded = 0 then Exit; и проблем бы не было!
2. Почему работает другой код? Потому что...

Цитата Pavia @ 09.02.16, 21:37

А то что один из них работает просто везение или совпадение.

это не объяснение.

Добавлено 10.02.16, 09:08
Минутку, кажется, разгадка близка...

Добавлено 10.02.16, 09:21
Я всё понял!
Первый код на самом деле не такой уж и работающий. Он просто не выдаёт сообщение об ошибке, т.к. там нет проверки на ошибку. А ошибка возникает при закрытии устройства, т.е. устройство не закрывается, т.к. запись не останавливается, а ПРИостанавливается (через waveInStop). Второй мой код выдаёт сообщение об ошибке, если вместо waveInReset поставить waveInStop (как в первом коде), что логично, т.к. там ЕСТЬ проверка на ошибку . Соответственно, если в первом коде вместо waveInStop написать waveInReset, он тоже зависнет
Правильный код (второй проги) выглядит так:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MMSystem, ComCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Label1: TLabel;
    cmbDevice: TComboBox;
    btnStart: TButton;
    btnStop: TButton;
    btnReset: TButton;
    pbNow: TProgressBar;
    pbMax: TProgressBar;
    tmrBars: TTimer;
    lblNow: TLabel;
    lblMax: TLabel;
    lblNowText: TLabel;
    lblMaxText: TLabel;
    btnGetDevList: TButton;
    lblBufsText: TLabel;
    edtBufs: TEdit;
    btnTest: TButton;
    function GetDevList: Integer;
    procedure FormCreate(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure tmrBarsTimer(Sender: TObject);
    procedure btnResetClick(Sender: TObject);
    procedure btnGetDevListClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
type
  TBuf = array [0..2205] of SmallInt;
  PBuf = ^TBuf;
const
  BufN = 10;
var
  WaveHdr: array [0..BufN-1] of TWAVEHDR;
  WaveH: HWAVEIN;
  Buf: array [0..BufN-1] of TBuf;
  ErrMsg: array [0..255] of Char;
  WaveNow, WaveMax, Bufs: Integer;
  Stop: Boolean;
 
procedure waveInProc(hwi: HWAVEIN; uMsg, dwInstance, dwParam1, dwParam2: DWord); stdcall;
var i, N, wMin, wMax: Integer;
begin
  if uMsg = MM_WIM_DATA then
  begin
    Inc(Bufs);
    with PWAVEHDR(dwParam1)^ do
    begin
      WaveNow := 0;
      wMin := 0;
      wMax := 0;
      for i := 0 to dwBytesRecorded div 2-1 do
      begin
        N := PBuf(lpData)^[i];
        if N < wMin then wMin := N;
        if N > wMax then wMax := N
      end;
      N := (wMax - wMin) div 2;
      WaveNow := N;
      if N > WaveMax then WaveMax := N;
      if not Stop then
      begin
        dwFlags := dwFlags and (not WHDR_DONE);
        dwBytesRecorded := 0;
        waveInAddBuffer(WaveH, PWAVEHDR(dwParam1), SizeOf(WaveHdr[0]));
      end
    end
  end
end;
 
//  Обновляет список устройств и возвращает номер выбранного устройства или -2, если устройство не найдено
function TForm1.GetDevList: Integer;
var
  i, N: Integer;
  DevIn: TWAVEINCAPS;
  S: String;
begin
  Result := -2;
  S := cmbDevice.Text;
  cmbDevice.Clear;
  N := 0;
  for i := -1 to waveInGetNumDevs-1 do
  begin
    FillChar(DevIn, SizeOf(DevIn), 0);
    if waveInGetDevCaps(i, @DevIn, SizeOf(DevIn)) = MMSYSERR_NOERROR then cmbDevice.Items.Add(DevIn.szPname);
    if DevIn.szPname = S then
    begin
      N := cmbDevice.Items.Count-1;
      Result := i
    end
  end;
  cmbDevice.ItemIndex := N
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  GetDevList
end;
 
procedure TForm1.btnStartClick(Sender: TObject);
var
  WaveFmt: TWAVEFORMATEX;
  i, DevID: Integer;
 
 function ProcessError(Err: Integer): Boolean;
 var i: Integer;
 begin
   Result := (Err <> MMSYSERR_NOERROR);
   if not Result then Exit;
   if WaveH <> 0 then
   begin
     for i := 0 to BufN-1 do
       if WaveHdr[i].dwFlags and WHDR_PREPARED > 0 then waveInUnprepareHeader(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]));
     waveInClose(WaveH)
   end;
   waveInGetErrorText(Err, @ErrMsg, SizeOf(ErrMsg));
   MessageBox(0, ErrMsg, PChar('Ошибка '+IntToStr(Err)), MB_OK or MB_ICONERROR or MB_TASKMODAL);
   btnStart.Enabled := True;
   cmbDevice.Enabled := True;
   btnGetDevList.Enabled := True;
 end;
 
begin
  edtBufs.Text := '0';
  DevID := GetDevList;
  if DevID = -2 then
    if MessageBox(0, PChar('Выбранное устройство было отключено.'#13'Продолжить запись с устройства по умолчанию?'), 'Предупреждение', MB_YESNO or MB_ICONWARNING or MB_TASKMODAL) = idNo then Exit;
  btnStart.Enabled := False;
  cmbDevice.Enabled := False;
  btnGetDevList.Enabled := False;
 
  with WaveFmt do
  begin
    wFormatTag := WAVE_FORMAT_PCM;
    nChannels := 1;
    nSamplesPerSec := 44100;
    wBitsPerSample := 16;
    nBlockAlign := nChannels*wBitsPerSample shr 3;
    nAvgBytesPerSec := nSamplesPerSec*nBlockAlign;
    cbSize := 0
  end;
  WaveH := 0;
  if ProcessError(waveInOpen(@WaveH, DevID, @WaveFmt, DWord(@waveInProc), 0, CALLBACK_FUNCTION)) then Exit;
 
  FillChar(WaveHdr, SizeOf(WaveHdr), 0);
  for i := 0 to BufN-1 do
  begin
    with WaveHdr[i] do
    begin
      lpData := @Buf[i];
      dwBufferLength := SizeOf(Buf[i])
    end;
    if ProcessError(waveInPrepareHeader(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]))) then Exit;
    if ProcessError(waveInAddBuffer(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]))) then Exit
  end;
 
  WaveNow := 0;
  WaveMax := 0;
  Bufs := 0;
  Stop := False;
  if ProcessError(waveInStart(WaveH)) then Exit;
 
  btnStop.Enabled := True;
  tmrBars.Enabled := True
end;
 
procedure TForm1.btnStopClick(Sender: TObject);
var i, Err: Integer;
begin
  btnStop.Enabled := False;
 
  Stop := True;
  waveInReset(WaveH);
 
  for i := 0 to BufN-1 do
    waveInUnprepareHeader(WaveH, @WaveHdr[i], SizeOf(WaveHdr[i]));
 
  Err := waveInClose(WaveH);
  if Err <> MMSYSERR_NOERROR then
  begin
    waveInGetErrorText(Err, @ErrMsg, SizeOf(ErrMsg));
    MessageBox(0, ErrMsg, PChar('Ошибка '+IntToStr(Err)), MB_OK or MB_ICONERROR or MB_TASKMODAL);
  end;
 
  tmrBarsTimer(nil);
  tmrBars.Enabled := False;
  GetDevList;
  cmbDevice.Enabled := True;
  btnGetDevList.Enabled := True;
  btnStart.Enabled := True
end;
 
procedure TForm1.btnResetClick(Sender: TObject);
begin
  WaveNow := 0;
  WaveMax := 0;
  tmrBarsTimer(nil)
end;
 
procedure TForm1.tmrBarsTimer(Sender: TObject);
begin
  pbNow.Position := Round(Ln(WaveNow+1)/Ln(32768)*100);
  if WaveNow = 0 then lblNow.Caption := '-Inf db'
  else lblNow.Caption := IntToStr(Round((Ln(WaveNow)-Ln(32767))/Ln(10)*20)) + ' db';
  pbMax.Position := Round(Ln(WaveMax+1)/Ln(32768)*100);
  if WaveMax = 0 then lblMax.Caption := '-Inf db'
  else lblMax.Caption := IntToStr(Round((Ln(WaveMax)-Ln(32767))/Ln(10)*20)) + ' db';
  edtBufs.Text := IntToStr(Bufs)
end;
 
procedure TForm1.btnGetDevListClick(Sender: TObject);
begin
  GetDevList
end;
 
end.

[Prince]

Цитата

Потому что если заменить в приведённом от Prince коде waveInReset на waveInStop, то прога тоже зависнет на цикле repeat/until, т.к. callback-функция вызываться не будет (и уменьшать bufcounter).

колбек будет вызван, но один раз. счётчик буферов в очереди уменьшиться с 10 до 9. И естественно, цикл будет бесконечным.

Так что, смотреть проект, или ты уже разобрался, почему виснет?

[Jin X]

Цитата Prince @ 10.02.16, 09:22

колбек будет вызван, но один раз

Да, точно!

Цитата Prince @ 10.02.16, 09:22

Так что, смотреть проект, или ты уже разобрался, почему виснет?

Нет, см. выше

Всем спасибо!

[Prince]

Цитата

Этот код я убираю, т.к. смысла в неё нет, поскольку waveInReset завершится только тогда, когда все буферы обработаются

Ну в принципе да. Так как колбек при обработке wim_data вызывается в доп. потоке, который убивается после вызова waveinreset. Так что да, возможно, waveinreset запускает процесс очистки очереди в доп. потоке, где в цикле происходит вызов колбек по количеству оставшихся в очереди буферов, а затем убивает сам поток. При этом, waveinreset совершенно не заботит, будут ли обработаны сообщения wim_data и что произойдёт с заголовками и буферами дальше.
Получается, счётчик буферов и цикл тоже лишние(?), как и цикл с processmessages.

[Jin X]

А вопрос, оказывается, ещё не решён. Новая проблема, возникшая в ходе экспериментов
Итак, запускаю программу для записи через "Переназначение звуковых устр." По умолчанию стоит звуковая карта №1. Нажимаю "Старт", идёт запись – всё нормально.
Теперь я меняю устройство по умолчанию на звуковую карту №2 и... запись прекращается. Просто перестаёт вызываться callback-функция и всё. А при попытке остановить запись (waveInStop, waveInReset, waveInClose даже) прога просто зависает.
Пробовал проделать это в стандартной проге "Звукозапись" – она записывает нормально. И даже переключает устройства прямо во время записи.
В чём проблема, что не так?

[Jin X]

И ещё меня такой момент волнует. Смотрю диспетчер задач. При запуске процесс имеет 2 потока. Нажимаю "Старт" (записи) – 6 потоков. Нажимаю "Стоп" - 4 потока. Почему не 2 ???
При повторных запусках и остановках – так же 6 и 4.
p.s. Это к проблеме со сменой устройств отношение не имеет.

Добавлено 10.02.16, 14:31
Причём, даже если сделать waveInOpen и сразу waveInClose, то же самое.

[Prince]

waveinopen создаёт дополнительный поток. waveinaddbuffer - ещё один, который рулит очередью записи и в нём же происходит вызов колбек для обработки wim_data. После waveinreset этот поток убивается. А вот тот, что создаётся после waveinopen остаётся после закрытия устройства до окончания работы процесса. Это факт, а почему так, и что выполняется в том потоке -

Цитата

Итак, запускаю программу для записи через "Переназначение звуковых устр."

В смысле, указываешь wave_mapper в waveinopen? И при переназначении дефолтного устройства всё виснет?

[Jin X]

Цитата Prince @ 10.02.16, 14:56

В смысле, указываешь wave_mapper в waveinopen? И при переназначении дефолтного устройства всё виснет?

Да, именно так.
Виснет, конечно, не всё, но перестаёт вызываться callback (в т.ч. о завершении текущего записываемого буфера, не говоря уже о тех, что в очереди и новых) и виснет waveInStop/Reset/Close.

Добавлено 10.02.16, 15:26
Причём, если я выбираю не WAVE_MAPPER, а конкретное устройство и во время записи отключаю его, то callback'и перестают вызываться, но остановка выполняется. Правда, если я начинаю дебагить, то прога тоже виснет (не всегда, но как правило).
А вот если я во время записи отключаю устройство, а затем снова его подключаю, то и callback'и не вызываются, и остановка не выполняется (виснет).

Добавлено 10.02.16, 15:33
А вот ещё прикол!

Цитата Jin X @ 10.02.16, 15:09

если я выбираю не WAVE_MAPPER, а конкретное устройство и во время записи отключаю его, то callback'и перестают вызываться, но остановка выполняется

Одна единственная callback-функция всё-таки вызывается, но это происходит через пару секунд. Так вот, запись останавливается нормально, только если эта заторможенная callback-функция не успевает вызваться, т.е. если я нажимаю на "Стоп" достаточно быстрою. Если не успеваю, то виснет при остановке. Ппц.

Добавлено 10.02.16, 15:42
А вот при изменении устройства по умолчанию последний вызов callback-функции тоже происходит, но он не заторможенный, а в обычном режиме (правда, не знаю что туда записывается под конец). Это я проверил, установив очень большой буфер (на 10 секунд) и счётчик буферов в callback-функции, который выводится на экран (в таймере).
Так вот, если после смены устройства по умолчанию (при открытии устройства WAVE_MAPPER) успеть нажать на стоп, пока последняя callback-функция не вызовется, то зависания при остановке не происходит!

[Jin X]

Итак, внимание, вердикт!
Глюки происходят из-за вызова waveInAddBuffer в callback-функции. Когда я сделал размер буфера равным 2 секунды (а буферов 8 шт) и отключил функцию waveInAddBuffer в callback-функции, остановка перестала зависать. А запись, кстати, продолжала выполняться с того устройства, которое было до смены устройства по умолчанию. При отключении же звуковой карты (это уже для случая, когда используется не WAVE_MAPPER, а конкретное устройство) происходит быстрый вызов callback-функции для всех оставшихся буферов.
Таким образом, полагаю, что перед waveInAddBuffer нужно делать какую-то проверку на то – живо ли ещё то устройство, с которого ведётся запись (и, более того, стоит ли оно по умолчанию). Осталось выяснить что это за проверка и как переключить устройство по умолчанию на новое (как это делает программа "Звукозапись")

Добавлено 10.02.16, 16:20
Зависание происходит именно на функции waveInAddBuffer.

[Prince]

Цитата

Таким образом, полагаю, что перед waveInAddBuffer нужно делать какую-то проверку на то – живо ли ещё то устройство, с которого ведётся запись (и, более того, стоит ли оно по умолчанию).

https://msdn.microsoft.com/en-us/library/wi...2(v=vs.85).aspx
?
У меня сейчас нет возможности проверить.

Сообщение отредактировано: Prince - 10.02.16, 16:26

[Jin X]

Ну... функция работает. Но прикол в том, что она всё время выдаёт НОЛЬ, т.к. оказывается, аудиоустройство по умолчанию всегда первое (нулевое)
А вызывать каждый раз в callback'е waveInGetDevCaps и сравнивать название с предыдущим — это как-то тупо, ИМХО.
Я думаю, что должно быть более изящное решение...

Добавлено 10.02.16, 20:41
А вот DRVM_MAPPER_PREFERRED_SET почему-то работать не хочет вообще никак. Всё время выдаёт ошибку 8 (функция не поддерживается). Ну если только в качестве первого параметра не указать несуществующий идентификатор устройства. Тогда будет ошибка 2 (указано несуществующее устройство). Но это, судя по всему, происходит потому, что сначала проверяется параметр hwi (первый), а потом уже uMsg (второй).

waveInMessage(WAVE_MAPPER, DRVM_MAPPER_PREFERRED_SET, 1, 0)