{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       TnrWave class (VCL)                             }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 09 Dec 2006                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrwave;
interface
uses  nrclasses,nrcommtapi,nrwin32,nrwavebase, windows,mmsystem, classes;

Type

  TWaveDirection = (wdUseFile,wdStdDevice,wdTAPIDevice);

  TNotifyRead = function (P:pointer;MaxSz:integer):integer of object;

  TnrMiddleWave=class(TnrCustomWave)
  private
    flPlayStopping:boolean;
  protected
    function OpenPlaySrc:boolean; override;
    procedure BlockPlay(Sender:TObject); override;
    procedure PlayStop; override;
  public
    procedure MemBlockPlay(P:Pointer;Sz:integer);
    property nrCommTAPI;
  end;

  TnrWave=class(TnrCustomWave)
  private
    hFileOut:THandle;
    hFileIn:THandle;
    fTrueRecDest: TWaveDirection;       // current mode
    fRecDest: TWaveDirection;           // for published property
    fWavFilePlay:string;                // current played file
    fWavFileRecord:string;              // current recorded file
    FPlayFileName: string;              // for published property
    FRecFileName: string;               // for published property
    SecondWave:TnrMiddleWave;
    fSecondaryTAPI: TnrCommTAPI;
    function GetPlayFileName: string;
    function GetRecDest: TWaveDirection;
    function GetRecFileName: string;
    function GetSecondaryTAPI: TnrCommTAPI;
    procedure SetPlayFileName(const Value: string);
    procedure SetRecDest(const Value: TWaveDirection);
    procedure SetRecFileName(const Value: string);
    procedure SetSecondaryTAPI(const Value: TnrCommTAPI);
  protected
    function OpenPlaySrc:boolean; override;
    procedure ClosePlaySrc; override;
    function OpenFilePlay:boolean;
    procedure CloseFilePlay;
    function BlockRead(P:pointer;MaxSz:integer):integer;override;

    function OpenRecDest:boolean; override;
    procedure CloseRecDest; override;
    function OpenFileRec:boolean;
    procedure CloseFileRec;
    procedure BlockWrite(P:pointer;Sz:integer);   override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure PlayStart; override;
    procedure PlayStop; override;
    procedure RecordStart; override;
    procedure RecordStop; override;
    procedure Notification(AComponent: TComponent;
                       Operation: TOperation); override;
    property HandleOut;
    property HandleIn;
    property IsPlaying;
    property IsRecording;
  published
    property Log;
    property nrCommTAPI;
    property OnFatalError;
    property RecChannels;
    property RecBits;
    property RecHz;
    property RecDSecBlock;
    property RecSecMax;
    property RecOptions;
    property RecDest:TWaveDirection read GetRecDest write SetRecDest;
    property RecFileName:string read GetRecFileName write SetRecFileName;
    property PlaySecBlock;
    property PlayOptions;
    property PlayFileName:string read GetPlayFileName write SetPlayFileName;
    property AfterPlay;
    property AfterRecord;
    property RecDestTAPI:TnrCommTAPI read GetSecondaryTAPI write SetSecondaryTAPI;
    property OnBufferPlay;
    property OnBufferRecord;
  end;

implementation
Uses sysutils;

Const
  idChunkWAVE:cardinal = $45564157;
  idChunkFMT:cardinal  = $20746D66;
  idChunkDATA:cardinal = $61746164;
  idChunkFACT:cardinal = $74636166;

{ TnrWave }

constructor TnrWave.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sLogPrefix:='nrWave: ';
  SecondWave:=TnrMiddleWave.Create(Self);
  fRecDest:=wdUseFile;

//  fPlaySrc:=wdUseFile;
end;

destructor TnrWave.Destroy;
begin
  SecondWave.Free;
  inherited Destroy;
end;

//============================================================
// Playing ....

function TnrWave.OpenPlaySrc: boolean;
begin
  if (fPlayFileName = '') and Assigned(OnBufferPlay)
    then Result := True
    else Result := OpenFilePlay;
end;

procedure TnrWave.ClosePlaySrc;
begin
  if fPlayFileName <> ''
    then CloseFilePlay;
  fIsPlaying:=False;
  inherited;
end;

function TnrWave.OpenFilePlay:boolean;
label Err_bad_fmt_file;
var  i:integer;
     mmckInfoParent,mmckInfoSub:TMMCKINFO;
begin
  fWavFilePlay:=fPlayFileName;
  Result:=False;
  hFileOut:=mmioOpen(PChar(fWavFilePlay),nil, MMIO_READ or MMIO_ALLOCBUF);
  if hFileOut=0 then begin
    DoFatalErrors(ECC_NRWAVE,ntecWavFileOpen,nteWavFileOpen);
    exit
  end;

  mmckInfoParent.fccType:=idChunkWAVE;
  if(mmioDescend(hFileOut,@mmckInfoParent,nil,MMIO_FINDRIFF)<>MMSYSERR_NOERROR)
    then goto Err_bad_fmt_file;

  mmckInfoSub.ckid:=idChunkFMT;
  if(mmioDescend(hFileOut,@mmckInfoSub,@mmckInfoParent,MMIO_FINDCHUNK)<>MMSYSERR_NOERROR)
    then goto Err_bad_fmt_file;

  i:=mmckInfoSub.cksize;
  if mmioRead(hFileOut,@wavOutFmt,i)<>i
    then goto Err_bad_fmt_file;

  mmioAscend(hFileOut,@mmckInfoSub,0);
  mmckInfoSub.ckid:=idChunkDATA;
  if(mmioDescend(hFileOut,@mmckInfoSub,@mmckInfoParent,MMIO_FINDCHUNK)<>MMSYSERR_NOERROR)
    then goto Err_bad_fmt_file;

  if mmckInfoSub.cksize=0 then begin
Err_bad_fmt_file:
    mmioClose(hFileOut,0);
    DoFatalErrors(ECC_NRWAVE,ntecWavFileBad,nteWavFileBad);
    exit;
  end;
  fTotalOutSize:=mmckInfoSub.cksize;
  Result:=True;
end;

function TnrWave.BlockRead(P:pointer;MaxSz:integer):integer;
var flHandled:boolean;
begin
//  OutputDebugString(PChar('Play block '+ IntToStr(MaxSz)));
  Result := inherited BlockRead(P,MaxSz);
  flHandled := False;
  if not (woEventLast in PlayOptions) then begin
    //buffer preprocessing ....
    flHandled := IsPlayHandled(P, MaxSz);
    if flHandled then Result := MaxSz;
  end;

  if not flHandled then begin
    //buffer default processing ....
    Result := mmioRead(hFileOut,P,MaxSz);
    if MaxSz < Result then Result := MaxSz;
  end;

  if woEventLast in PlayOptions then
    //buffer postprocessing ....
    if IsPlayHandled(P, MaxSz) then Result := MaxSz;
end;

procedure TnrWave.CloseFilePlay;
begin
  mmioClose(hFileOut,0);
  hFileOut:=0;
end;

//============================================================
// Recording ....

function TnrWave.OpenRecDest: boolean;
begin
  Result := False;
  fTrueRecDest := fRecDest;

  if Assigned(OnBufferRecord) then begin
    // recording handled in event handler ...
    Result := ((fTrueRecDest = wdUseFile) and (fRecFileName = '')) or
              ((fTrueRecDest = wdTAPIDevice) and (not Assigned(fSecondaryTAPI)));
  end;

  if not Result then
    case fTrueRecDest of
      wdUseFile: Result := OpenFileRec;
      wdStdDevice,wdTAPIDevice:begin
        SecondWave.RecChannels:=RecChannels;
        SecondWave.RecBits:=RecBits;
        SecondWave.RecHz:=RecHz;
        SecondWave.RecDSecBlock:=RecDSecBlock;
        SecondWave.RecSecMax:=RecSecMax;
        if fTrueRecDest=wdStdDevice
          then SecondWave.nrCommTAPI:=nil
          else SecondWave.nrCommTAPI:=fSecondaryTAPI;
        SecondWave.Log := Log;
        SecondWave.PlayStart;
        Result:=SecondWave.IsPlaying;
      end;
    end;

  wavInFmt.wFormatTag:=WAVE_FORMAT_PCM;
  wavInFmt.nChannels:=RecChannels;
  wavInFmt.nSamplesPerSec:=RecHz;
  wavInFmt.wBitsPerSample:=RecBits;
  wavInFmt.nBlockAlign := wavInFmt.nChannels * (wavInFmt.wBitsPerSample div 8);
  wavInFmt.nAvgBytesPerSec:= wavInFmt.nBlockAlign * wavInFmt.nSamplesPerSec;
  wavInFmt.cbSize:=0;
end;

procedure TnrWave.CloseRecDest;
begin
  case fTrueRecDest of
    wdUseFile:CloseFileRec;
    wdStdDevice,wdTAPIDevice:SecondWave.PlayStop;
  end;
  fIsRecording:=False;
  inherited CloseRecDest;
end;

function TnrWave.OpenFileRec: boolean;
begin
  fWavFileRecord:=fRecFileName;
  Result:=False;
  hFileIn:=mmioOpen(PChar(fWavFileRecord),nil,MMIO_CREATE or MMIO_READWRITE);
  if hFileIn=0 then begin
    DoFatalErrors(ECC_NRWAVE,ntecWavFileOpen,nteWavFileOpen);
    exit
  end;
  Result:=True;
end;

procedure TnrWave.BlockWrite(P:pointer;Sz:integer);
var szData,i:integer;
    mmckInfo:TMMCKINFO;
    flHandled:boolean;
begin
  flHandled := False;

  if not (woEventLast in RecOptions) //buffer preprocessing ....
    then flHandled := IsRecordHandled(P, Sz);

  if (Sz = 0) or flHandled  then exit;

  case fTrueRecDest of
    wdUseFile: begin
  //    OutputDebugString('Block wrute 333!!!');
      szData:=Sz+Integer(fTotalRecSize);
      //writing/updating WAV header ....
      mmioSeek(hFileIn,0,SEEK_SET);
      mmckInfo.fccType:=idChunkWAVE;
      mmckInfo.cksize:=szData+50;
      mmioCreateChunk(hFileIn,@mmckInfo,MMIO_CREATERIFF);
      mmckInfo.fccType:=0;  //idChunkFMT;
      mmckInfo.ckid:=idChunkFMT;
      mmckInfo.cksize:=SizeOf(TWAVEFORMATEX);
      mmioCreateChunk(hFileIn,@mmckInfo,0);
      mmioWrite(hFileIn,@wavInFmt,SizeOf(TWAVEFORMATEX));
      mmckInfo.fccType:=0;  //idChunkFMT;
      mmckInfo.ckid:=idChunkFACT;
      mmckInfo.cksize:=4;
      mmioCreateChunk(hFileIn,@mmckInfo,0);
      i:=szData div wavInFmt.nBlockAlign;//i
      mmioWrite(hFileIn,@i,4);
      mmckInfo.fccType:=0;  //idChunkFMT;
      mmckInfo.ckid:=idChunkDATA;
      mmckInfo.cksize:=szData;
      mmioCreateChunk(hFileIn,@mmckInfo,0);
      mmioSeek(hFileIn,0,SEEK_END);
      //appending WAV data ....
      mmioWrite(hFileIn,P,Sz);

    end;
    wdStdDevice,wdTAPIDevice: begin
      if fIsRecording then SecondWave.MemBlockPlay(P,Sz);
    end;
  end;

  if woEventLast in RecOptions  //buffer postprocessing ....
    then IsRecordHandled(P, Sz);

end;

procedure TnrWave.CloseFileRec;
begin
  mmioClose(hFileIn,0);
  hFileIn:=0;
end;

procedure TnrWave.PlayStart;
begin
  inherited;
end;

procedure TnrWave.PlayStop;
begin
  inherited;
end;

procedure TnrWave.RecordStart;
begin
  inherited;
end;

procedure TnrWave.RecordStop;
begin
  inherited;
end;

procedure TnrWave.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation=opRemove then begin
    if AComponent=fSecondaryTAPI then fSecondaryTAPI := nil;
  end;
end;

function TnrWave.GetPlayFileName: string;
begin
  Result := fPlayFileName;
end;

function TnrWave.GetRecDest: TWaveDirection;
begin
  Result := fRecDest;
end;

function TnrWave.GetRecFileName: string;
begin
  Result := fRecFileName;
end;

function TnrWave.GetSecondaryTAPI: TnrCommTAPI;
begin
  Result := fSecondaryTAPI;
end;

procedure TnrWave.SetPlayFileName(const Value: string);
begin
  fPlayFileName:=Value;
end;

procedure TnrWave.SetRecDest(const Value: TWaveDirection);
begin
  fRecDest:=Value;
end;

procedure TnrWave.SetRecFileName(const Value: string);
begin
  FRecFileName:=Value;
end;

procedure TnrWave.SetSecondaryTAPI(const Value: TnrCommTAPI);
begin
  fSecondaryTAPI:=Value;
end;

{ TnrMiddleWave }

procedure TnrMiddleWave.BlockPlay(Sender: TObject);
var pWh:PWaveHdr;
begin
  EnterCriticalSection(csPlay);
  pWh:=Pointer(Sender);
  if (pWh<>nil)and(pWh<>@wavOutHdr)and(pWh<>@wavOutHdr2)then begin
    waveOutUnPrepareHeader(fHandleOut,pWh,SizeOf(TWaveHdr));
    LocalFree(Cardinal(pWh.lpData));
    LocalFree(Cardinal(pWh));
  end;
  LeaveCriticalSection(csPlay);
end;

procedure TnrMiddleWave.MemBlockPlay(P: Pointer; Sz: integer);
var pWh:PWaveHdr;
    i:integer;
begin
  if not flPlayStopping then begin
    EnterCriticalSection(csPlay);
    pWh:=Pointer(LocalAlloc(LPTR,SizeOf(TWaveHdr)));
    pWh.lpData:=Pointer(LocalAlloc(LPTR,Sz));
    pWh.dwBufferLength:=Sz;
    CopyMemory(pWh.lpData,P,Sz);
    LeaveCriticalSection(csPlay);
    i:=BlockPlayOut(pWh);
    if i<>MMSYSERR_NOERROR then begin
      LoggingFmt(dlDetail,' PlayOut Error %Xh',[i]);
    end else
      Logging(dlDetail,' PlayOut OK');
  end;
end;

function TnrMiddleWave.OpenPlaySrc: boolean;
begin
  Result:=True;
  with wavOutFmt do begin
    wFormatTag:=WAVE_FORMAT_PCM;
    nChannels:=RecChannels;
    nSamplesPerSec:=RecHz;
    wBitsPerSample:=RecBits;
    nBlockAlign := nChannels * (wBitsPerSample div 8);
    nAvgBytesPerSec:= nBlockAlign * nSamplesPerSec;
    cbSize:=0;
  end;
end;

procedure TnrMiddleWave.PlayStop;
begin
  if fIsPlaying then begin
    flPlayStopping:=True;
//    waveOutReset(fHandleOut);
//    waveOutStop(fHandleOut);
    //thrdOut.FreeOnTerminate:=False;
    //PostThreadMessage(thrdOut.ThreadID,WOM_CLOSE,0,0);
    //OutputDebugString('PlayStop 1111 ....');
    thrdOut.Terminate;
//    thrdOut.WaitFor;
    //OutputDebugString('PlayStop 222 ....');
    //thrdOut.Free; // wait for end ...
    ClosePlay;
    fIsPlaying:=False;
    flPlayStopping:=False;
  end;
end;

end.
