Hallo,

ich habe eine Threadklasse TCapture = class(TThread) geschrieben, die mit MMAudioAPI Funktionen eine wählbare Soundkarte ausliest und die Daten in einem Feld im Thread ablegt. Die Daten und Methoden im Thread sind komplett in TCapture abgekapselt .

Das funktioniert soweit alles gut, so lange ich den Thread nur einmal starte um eine einzige Soundkarte auszulesen.

Wenn ich den Thread aber gleichzeitig zweimal starte um zwei verschiedene Soundkarten auszulesen, kommt viel Datenmüll.

Ich starte die beiden Threads so:

markieren

Delphi-Quellcode:

var
  Capture: TCapture;
  Capture2: TCapture;
...
Capture := TCapture.Create(...);
Capture2 := TCapture.Create(...);

Nach meinem Verständnis habe ich so zwei unabhängige Threads erzeugt, die voneinander nichts wissen.

Ist das korrekt?

Wo liegt mein Denkfehler?

P.S. Ich lese die Daten erst aus, wenn beide Threads angehalten wurden, so, dass Multithreading bedingte Datenzugriffsprobleme wohl auszuschließen sind.

Soweit ok.

Jetzt die Frage, wie der Zugriff auf die Soundkarten erfolgt. Ist der Threadsicher? Es muss ja nicht immer am eigenen Code liegen.

Zitat:

Jetzt die Frage, wie der Zugriff auf die Soundkarten erfolgt. Ist der Threadsicher?

Da bin ich leider noch zu sehr Anfänger um dazu definitiv was zu sagen.
Ich poste einfach mal die Thread-Unit. Die Audiofunktionen sind ganz unten.

zusammenfalten · markieren

Delphi-Quellcode:

unit UThreadCapture;

interface

uses
  Classes, SysUtils, Windows, Messages, MMSystem;

type
  T24Bit = packed record
    Lo: Byte;
    Hi: SmallInt;
  end;

type
TCapBuffer= array of char;
TCapBuffers= array of TCapBuffer;

type
T_Capturesettings=Record
    Device: integer; //capture device number
    SampleRate: integer; //in samples per second
    Resolution: integer; //8,16,24 bit
    Channels: integer; //2=stereo
    BufSize: integer; //buffer size in (stereo) samples
    NumBufs: integer; //cyclic reuse if >0
    Receiver: hwnd; //handle of Window which has sent the capture request
    ReturnMsg: integer; //message to be sent to receiver handle upon available data
    end;

Type
tWAVEFORMATEX = packed record
    wFormatTag: Word; { format type }
    nChannels: Word; { number of channels (i.e. mono, stereo, etc.) }
    nSamplesPerSec: DWORD; { sample rate }
    nAvgBytesPerSec: DWORD; { for buffer estimation }
    nBlockAlign: Word; { block size of data }
    wBitsPerSample: Word; { number of bits per sample of mono data }
    cbSize: Word; { the count in bytes of the size of }
  end;

type
  TSamples = packed record
    case word of
      0: (wValidBitsPerSample: word); // bits of precision
      1: (wSamplesPerBlock: word); // valid if wBitsPerSample = 0
      2: (wReserved: word); // If neither applies, set to zero.
  end;

  PWAVEFORMATEXTENSIBLE = ^tWAVEFORMATEXTENSIBLE;
  tWAVEFORMATEXTENSIBLE = packed record
    Format: tWAVEFORMATEX;
    Samples: TSamples;
    dwChannelMask: longword; // which channels are present in stream
    SubFormat: TGUID;
  end;

const
  WAVE_FORMAT_EXTENSIBLE = $FFFE; // Microsoft ksmedia.h
  KSDATAFORMAT_SUBTYPE_PCM: TGUID = '{00000001-0000-0010-8000-00aa00389b71}';
                                      // Microsoft ksmedia.h

type
  TCapture = class(TThread)
  private
    { Private declarations }
    Fwnd: HWND;
    Cap: T_Capturesettings;
    CapBuf: TCapBuffer;
    Granularity: integer;
    ByteBufSize: integer;
    BufNum: integer;
    logging: boolean;
    WaveInHandle : hWaveIn; // Handle to soundcard
    WaveHdr : array of TWaveHdr; // Pointer to API communication block
    procedure WndProc(var Msg:TMessage);
    Procedure MMInDone (Var Msg : Tmessage);
      Message MM_WIM_DATA;
    function StartCapture: boolean;
// Audio functions
    Function LogInit (CallBack : THandle; DeviceID, SampleRate,
                       BitsPerSample, Channels : Integer ): boolean;
    Procedure LogClose;
    Function LogStart (PBuffer : Pointer; BufferSz : Cardinal; NBuf: integer): TLargeInteger;
    Function LogStop: boolean;
    Function LogRequeueBuffer(i: integer): boolean;
    Function LogAddBuffer (PBuffer : Pointer; BufferSz : Cardinal; i: integer): boolean;
    Function LoggedBytes: cardinal;
    Function LogCapabilities(Device: integer): string;
  protected
    procedure Execute; override;
  public
    CapBuffers: TCapBuffers;
    procedure ClearBuffer(i: integer);
    procedure ClearBuffers;
    function StereoSample(var L,R: integer; n: integer): boolean;
    procedure Terminate; reintroduce;
    constructor Create(Capture: T_Capturesettings;ThreadPriority: TThreadPriority);
  published
  end;

implementation

function TCapture.StereoSample(var L,R: integer; n: integer): boolean;
var
  n0,ni,nf: integer;
  x8: array[0..5] of char;
  x24: array [0..1] of T24Bit absolute x8;
  x16: array [0..1] of SmallInt absolute x8;
  i: integer;
begin
result:=false;
if Cap.Channels<>2 then exit;
n0:=length(CapBuffers);
ni:=n div Cap.BufSize;
nf:=n-ni*Cap.BufSize;
if ni>=n0 then exit;
for i:=0 to Granularity-1 do
  x8[i]:=CapBuffers[ni][nf*Granularity+i];
case Cap.Resolution of
  8: begin
        L:=byte(x8[0])-128;
        R:=byte(x8[1])-128;
      end;
  16: begin
        L:=x16[0];
        R:=x16[1];
      end;
  24: begin
        L:=x24[0].Lo+x24[0].Hi*256;
        R:=x24[1].Lo+x24[1].Hi*256;
      end;
  end;
result:=true;

//if length(CapBuffers)>i then SetLength(CapBuffers[i],0);
end;

procedure TCapture.ClearBuffer(i: integer);
begin
if length(CapBuffers)>i then SetLength(CapBuffers[i],0);
end;

procedure TCapture.ClearBuffers;
var i: integer;
begin
if not logging then
  for i:=0 to length(CapBuffers)-1 do
    ClearBuffer(i);
SetLength(CapBuffers,0);
end;

{ Important: Methods and properties of objects in VCL or CLX can only be used
  in a method called using Synchronize}

constructor TCapture.Create(Capture: T_Capturesettings;ThreadPriority: TThreadPriority);
begin
  inherited Create(true);
  Priority := ThreadPriority;
  WaveInHandle:=0;
  Cap:=Capture;
  Granularity:=Cap.Channels*Cap.Resolution div 8;
  ByteBufSize:=Cap.BufSize*Granularity;
  SetLength(CapBuf,Cap.NumBufs*ByteBufSize);
  Suspended:=false;
end;

procedure TCapture.Terminate;
begin
  inherited Terminate;
  LogClose;
  PostMessage(Fwnd, WM_QUIT , 0,0);
end;

{ TCapture }

Procedure TCapture.MMInDone (Var Msg : Tmessage);
var
  n,nb: integer;

Begin
if Logging then
  begin
    n:=Length(CapBuffers);
    SetLength(CapBuffers,n+1);
    SetLength(CapBuffers[n],ByteBufSize);
    move(CapBuf[BufNum*ByteBufSize],CapBuffers[n][0],ByteBufSize);
    LogRequeueBuffer(BufNum);
    BufNum:=(BufNum+1) mod Cap.NumBufs;
  end
  else
  begin
    LogStop;
    LogClose;
  end;
end;

function TCapture.StartCapture: boolean;
var
  LogOk: boolean;
  
begin
  Result:=false;
  BufNum:=0;
  Logging:=true;
  LogOK:=LogInit (Fwnd, Cap.Device, Cap.SampleRate, Cap.Resolution, Cap.Channels); //Win Message
  if LogOK then LogStart (CapBuf, ByteBufSize ,Cap.NumBufs);
  Result:=LogOK
end;

//main thread procedure
procedure TCapture.Execute;
var msg:Tmsg;
begin
  Fwnd:=allocatehwnd(WndProc); //hier ist jetzt dein Windowhandle für MMAudio
  try
    StartCapture;
    while getMessage(msg,0,0,0) do //warten auf Message
      DispatchMessage(msg); //verteilen auf das entsprechende Fenster (gibt hier allerdings eh nur eins)
  finally
    Deallocatehwnd(Fwnd);
  end;
  logging:=false;
  SetLength(CapBuf,0);
end;

procedure TCapture.WndProc(var Msg:TMessage);
begin
  dispatch(msg);
end;

//////MMAudio Functions
Function TCapture.LogCapabilities(Device: integer): string;
var
  WaveInCaps: TWaveInCaps;
begin
if waveInGetDevCaps(Device, @WaveInCaps,SizeOf(WaveInCaps)) = 0 then
  Result:=WaveInCaps.szPname
else
  Result:='not available';
end;

Function TCapture.LoggedBytes: cardinal;
var
  TimeInfo: TMMTime;
begin
If WaveInHandle = 0 Then
  begin
  Result:=0;
  exit;
  end;
TimeInfo.wType:=TIME_BYTES;
if WaveInGetPosition(WaveInHandle,@TimeInfo,SizeOf(TimeInfo)) <> 0 then
Raise
      Exception.Create ('Error retrieving capture position.')
else result:=TimeInfo.sample;
end;

Function TCapture.LogInit (CallBack : THandle; DeviceID, SampleRate,
                   BitsPerSample, Channels : Integer ): boolean;
(* Setup of soundcard input *)
Var
        WaveFormat : tWAVEFORMATEXTENSIBLE;
Begin
Result:=true;
With WaveFormat Do
  Begin;
  With Format Do
   Begin
      If BitsPerSample < 17 then WFormatTag := WAVE_FORMAT_PCM
                            else WFormatTag := WAVE_FORMAT_EXTENSIBLE;
      NChannels := Channels;
      NSamplesPerSec := SampleRate;
      NAvgBytesPerSec := SampleRate*Channels*BitsPerSample div 8;
      NBlockAlign := Channels*BitsPerSample div 8;
      wBitsPerSample := BitsPerSample;
      cbSize := 22;
   End;
  With Samples Do
   Begin
      wValidBitsPerSample := BitsPerSample;
      wSamplesPerBlock := 1;
      wReserved := 0;
   End;
  dwChannelMask := 3; //front left and right speaker
  SubFormat := KSDATAFORMAT_SUBTYPE_PCM;
  End;
Try
If WaveInOpen (Nil, DeviceID, @WaveFormat, 0, 0,
                  WAVE_FORMAT_QUERY) <> 0 Then Result:=false;
                  //Raise Exception.Create ('Requested format not supported.');

If WaveInOpen (@WaveInHandle, DeviceID, @WaveFormat,
                  CallBack, 0, CALLBACK_WINDOW) <> 0 Then Result:=false;
                  //Raise Exception.Create ('No handle to sound card.');
Except Result:=false; end;
End;


Procedure TCapture.LogClose;
(* Close connection with sound card *)

Begin
   If WaveInHandle <> 0 Then
   Begin
      WaveInClose (WaveInHandle);
      WaveInHandle := 0
   End;
End;

Function TCapture.LogRequeueBuffer(i: integer): boolean;
(* ReQueue i.th Buffer to soundcard. *)
Begin
   If WaveInPrepareHeader (WaveInHandle, @WaveHdr[i],
                                 SizeOf (WaveHdr[i])) <> 0 Then
      Raise Exception.Create ('In Prepare error');
   If WaveInAddBuffer (WaveInHandle, @WaveHdr[i],
                                 sizeof (WaveHdr[i])) <> 0 Then
      begin
        Raise Exception.Create ('Add buffer error');
      end;
End;

Function TCapture.LogAddBuffer (PBuffer : Pointer; BufferSz : Cardinal; i: integer): boolean;
(* Add a new buffer *)
Begin
Result:=true;
SetLength(WaveHdr,i+1);
// Initialization of API communication block
   With WaveHdr[i] Do
   Begin
      lpdata := PBuffer;
      dwbufferlength := BufferSz;
      dwbytesrecorded := 0;
      dwUser := 0;
      dwflags := 0;
      dwloops := 0;
      lpNext := Nil;
      reserved := 0;
   End;
   If WaveInPrepareHeader (WaveInHandle, @WaveHdr[i],
                                 SizeOf (WaveHdr[i])) <> 0 Then
      Raise Exception.Create ('In Prepare error');
   If WaveInAddBuffer (WaveInHandle, @WaveHdr[i],
                                 sizeof (WaveHdr[i])) <> 0 Then
      Raise Exception.Create ('Add buffer error');
End;

Function TCapture.LogStart (PBuffer : Pointer; BufferSz : Cardinal; NBuf: integer): TLargeInteger;
(* Start logging of soundcard data. *)
var i:integer;
    t:TLargeInteger;
Begin
SetLength(WaveHdr,NBuf);
for i:=0 to NBuf-1 do
 begin
// Initialization of API communication block
   With WaveHdr[i] Do
   Begin
      lpdata := PBuffer;
      dwbufferlength := BufferSz;
      dwbytesrecorded := 0;
      dwUser := 0;
      dwflags := 0;
      dwloops := 0;
      lpNext := Nil;
      reserved := 0;
   End;
   If WaveInPrepareHeader (WaveInHandle, @WaveHdr[i],
                                 SizeOf (WaveHdr[i])) <> 0 Then
      Raise Exception.Create ('In Prepare error');
   If WaveInAddBuffer (WaveInHandle, @WaveHdr[i],
                                 sizeof (WaveHdr[i])) <> 0 Then
      Raise Exception.Create ('Add buffer error');
   If WaveInStart (WaveInHandle) <> 0 Then
      Raise Exception.Create ('Error in starting logger');
   if i=0 then QueryPerformanceCounter(t);
   PBuffer:=Pointer(Cardinal(PBuffer)+BufferSz);
 End; //BufferHeaderLoop
Result:=t;
End;


Function TCapture.LogStop: boolean;
//Stop recording
var i:integer;
Begin
Result:=true;
If WaveInHandle <> 0 then
  begin
     WaveInReset(WaveInHandle); //mark all buffers as done
   For i:=0 to Length(WaveHdr)-1 do //unprepare all buffers
    If WaveInUnPrepareHeader (WaveInHandle, @WaveHdr[i], sizeof (TWavehdr)) <> 0
     Then Raise Exception.Create ('Error in UnPrepare Capture Buffers'); //result=33 => still playing
    SetLength(WaveHdr,0);
  end;
End;

end.

Das dürfte zwar das Problem nicht lösen, aber du rufst in Terminate "LogClose" auf. Und das ist nicht synchronisiert. Ruf doch LogClose am Ende von Execute auf (evtl. in einem Finally-Block)

Halte Dich fest, Sirius. Das wars! Jetzt scheint es stabil zu laufen.

Danke für den Tipp!