(*
  this file is a part of audio components suite v 2.3.
  copyright (c) 2002-2005 andrei borovsky. all rights reserved.
  see the license file for more details.
  you can contact me at mail@z0m3ie.de
*)

{
$Log: acs_wave.pas,v $
Revision 1.11  2006/08/03 17:31:09  z0m3ie
*** empty log message ***

Revision 1.10  2006/07/04 17:12:45  z0m3ie
ACS 2.4 alt wiederhergestellt (unterschiedliche Sampleformate ...)

Revision 1.5  2005/12/30 13:24:28  z0m3ie
waveformat corrections, localizing

Revision 1.4  2005/12/30 11:10:57  z0m3ie
some corrections to lazarus-linux depending things

Revision 1.3  2005/12/29 20:45:59  z0m3ie
fixed some problems with vorbis in lazarus

Revision 1.2  2005/12/26 17:31:39  z0m3ie
fixed some problems in acs_dsfiles
fixed some problems in acs_vorbis
reworked all buffers

Revision 1.1  2005/12/19 18:36:38  z0m3ie
*** empty log message ***

Revision 1.6  2005/12/18 17:01:54  z0m3ie
delphi compatibility

Revision 1.5  2005/12/04 16:54:34  z0m3ie
All classes are renamed, Style TACS... than T... to avoid conflicts with other components (eg TMixer is TACSMixer now)

Revision 1.4  2005/11/28 21:57:24  z0m3ie
mostly FileOut fixes
moved PBuffer to PBuffer8
set all to dynamically Buffering

Revision 1.3  2005/10/02 16:51:01  z0m3ie
*** empty log message ***

Revision 1.2  2005/09/13 04:04:50  z0m3ie
First release without Components for Fileformats
only TFileIn and TFileOut are Visible

Revision 1.1  2005/09/12 22:04:52  z0m3ie
modified structure again, fileformats are now in an sperat folder.
all File In/Out classes are capsulated from TFileIn and TFileOut

Revision 1.2  2005/08/22 20:17:01  z0m3ie
changed Headers to log
changed mail adress

}

unit acs_wave;

{$ifdef fpc}
{$mode delphi}
{$endif}

interface

uses

// This is required to enable TWaveIn read MS ACM (MP3-encoded) files.
  {$IFDEF WIN32}
  MMSYSTEM, MSAcm, waveconverter,
  {$ENDIF}

  {$IFDEF LINUX}
  Math, MAD,
  {$ENDIF}
  ACS_File, Classes, SysUtils, ACS_Types, ACS_Classes,ACS_Strings;

type

  TWavType = (wtUnsupported, wtPCM, wtDVIADPCM, wtMSADPCM, wtACM);

  TWaveHeader = record
    // RIFF file header
    RIFF: array [0..3] of Char;          // = 'RIFF'
    FileSize: Integer;                   // = FileSize - 8
    RIFFType: array [0..3] of Char;      // = 'WAVE'
    // Format chunk
    FmtChunkId: array [0..3] of Char;    // = 'fmt'
    FmtChunkSize: Integer;               // = 16
    FormatTag: Word;                     // One of WAVE_FORMAT_XXX constants
    Channels: Word;                      // = 1 - mono = 2 - stereo
    SampleRate: Integer;
    BytesPerSecond: Integer;
    BlockAlign: Word;
    BitsPerSample: Word;                 // = 8, 16 or 32 Bits/sample
    // Data Chunk
    DataChunkId: array [0..3] of Char;   // = 'data'
    DataSize: Integer;   // Data size in bytes
  end;

  TDVIADPCMHeader = record
    // RIFF file header
    RIFF: array [0..3] of Char;          // = 'RIFF'
    FileSize: Integer;                   // = FileSize - 8
    RIFFType: array [0..3] of Char;      // = 'WAVE'
    // Format chunk
    FmtChunkId: array [0..3] of Char;    // = 'fmt'
    FmtChunkSize: Integer;               // = 20
    FormatTag: Word;                     // WAVE_FORMAT_DVI_ADPCM
    Channels: Word;                      // = 1 - mono = 2 - stereo
    SampleRate: Integer;
    BytesPerSecond: Integer;
    BlockAlign: Word;
    BitsPerSample: Word;                // = 3, 4 Bits/sample
    cbSize : Word;                      // The size in bytes of the extra information
    SamplesPerBlock : Word;             // number of samples per channel per Block
    // Fact Chunk
    FactChunkId: array [0..3] of Char;  // = 'fact'
    FactChunkSize : Integer;            // = 4
    DataLength : Integer;
    // Data Chunk
    DataChunkId: array [0..3] of Char;   // = 'data'
    DataSize: Integer;   // Data size in bytes
  end;


  TDVI_ADPCM_INFO = record
    BlockLength : Word;
    SamplesPerBlock : Word;
    DataSize : Integer;
  end;

  TDVI_ADPCM_STATE_STEREO = packed record
    valprev_l : SmallInt;      // Previous output value
    index_l : Byte;            // Index into stepsize table
    valprev_r : SmallInt;      // Previous output value
    index_r : Byte;            // Index into stepsize table
  end;

  TDVI_ADPCM_ENCODE_STATE_STEREO = packed record
    PredSamp_l : SmallInt;
    Index_l : Byte;
    PredSamp_r : SmallInt;
    Index_r : Byte;
  end;

  TMS_ADPCM_COEF_SET = packed record
    Coef1, Coef2 : SmallInt;
  end;

  TMS_ADPCM_INFO = record
    BlockLength : Word;
    SamplesPerBlock : Word;
    DataSize : Integer;
    NumCoeff : Word;
    CoefSets : array[0..31] of TMS_ADPCM_COEF_SET; // Is that enough?
  end;

  TMSADPCMBlockHeaderMono = packed record
    predictor : Byte;
    Delta : SmallInt;
    Samp1 : SmallInt;
    Samp2 : SmallInt;
  end;

  TMSADPCMBlockHeaderStereo = packed record
    predictor : array[0..1] of Byte;
    Delta : array[0..1] of SmallInt;
    Samp1 : array[0..1] of SmallInt;
    Samp2 : array[0..1] of SmallInt;
  end;

const
  //Hack : Wave is the only format where i must use an const buffer
  //all dynamic buffers crash on Move in GetData no matter why
  BUFFER_SIZE = $8000;

type

  { TWaveIn }

  TWaveIn = class(TACSCustomFileIn)
  private
    buf : array[0..BUFFER_SIZE] of byte;
    _WavType : TWavType;
    DVI_ADPCM_INFO : TDVI_ADPCM_INFO;
    DVI_ADPCM_STATE : TDVI_ADPCM_STATE_STEREO;
    MS_ADPCM_INFO : TMS_ADPCM_INFO;
    MS_ADPCM_STATE : TMSADPCMBlockHeaderStereo;
    HeaderSize : Word;
    _MS : TMemoryStream;
    OldStream : TStream;
    OldStreamAssigned : Boolean;
    {$IFDEF LINUX}
    // MS ACM stuff
    HasFirstFrame : Boolean;
    InputDone : Boolean;
    Data : Pointer;
    DataLen : Integer;
    {$ENDIF}
    procedure SetBufferSize(S : Integer);override;
    function ReadDVIADPCMBlock(aData : Pointer) : Boolean;
    function ReadMSADPCMBlock(bData : Pointer) : Boolean;
    function GetWavType : TWavType;
    procedure ReadRIFFHeader;
    procedure DecodeDVIADPCMMono(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
    procedure DecodeDVIADPCMStereo(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
    procedure DecodeMSADPCMMono(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
    procedure DecodeMSADPCMStereo(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
  protected
    procedure OpenFile; override;
    procedure CloseFile; override;
  public
    property WavType : TWavType read GetWavType;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetData(Buffer : Pointer; aBufferSize : Integer): Integer; override;
    function Seek(SampleNum : Integer) : Boolean; override;
  end;

  TWaveOut = class(TACSCustomFileOut)
  private
    EndOfInput : Boolean;
    FWavType : TWavType;
    FEncodeState : TDVI_ADPCM_ENCODE_STATE_STEREO;
    FPrevSR : Integer;
    FPrevCh : Word;
    FPrevBPS : Word;
    FPrevLen : Integer;
    FLenOffs : Integer;
    FPrevDataSize : Integer;
    FDataSizeOffs : Integer;
    FPrevWavType : TWavType;
    HeaderSize : Integer;
    FBlockAlign : Word;
    procedure SetWavType(WT : TWavType);
    procedure ReadRIFFHeader;
    procedure FillHeaderPCM(var Header : TWaveHeader);
    procedure FillHeaderDVIADPCM(var Header : TDVIADPCMHeader);
    procedure SetBlockSize(BS : Word);
    procedure EncodeDVIADPCMMono(InData : PACSBuffer16; OutData : PACSBuffer8);
    procedure EncodeDVIADPCMStereo(InData : PACSBuffer16; OutData : PACSBuffer8);
  protected
    procedure Done; override;
    function DoOutput(Abort : Boolean):Boolean; override;
    procedure Prepare; override;
    procedure SetFileMode(aMode : TACSFileOutputMode); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property WavType : TWavType read FWavType write SetWavType;
    property BlockSize : Word read FBlockAlign write SetBlockSize;
  end;

implementation

const

  WaveHeaderOffs = 44;
  DataSizeOffs = 40;
  WAVE_FORMAT_PCM = 1;
  WAVE_FORMAT_ADPCM = 2;
  WAVE_FORMAT_ALAW = 6;
  WAVE_FORMAT_MULAW = 7;
  WAVE_FORMAT_DVI_IMA_ADPCM = 17;
  WAVE_FORMAT_IMA_ADPCM = 17;
  WAVE_FORMAT_MP3 = 85;

type

  TDVIADPCMBlockHeader = packed record
    Samp0 : SmallInt;
    StepTableIndex : Byte;
    Reserved : Byte;
  end;

const

  // DVI IMA ADPCM stuff

  StepTab : array[0..88] of Integer = (
                    7,     8,     9,    10,    11,    12,    13,    14,
                   16,    17,    19,    21,    23,    25,    28,    31,
                   34,    37,    41,    45,    50,    55,    60,    66,
                   73,    80,    88,    97,   107,   118,   130,   143,
                  157,   173,   190,   209,   230,   253,   279,   307,
                  337,   371,   408,   449,   494,   544,   598,   658,
                  724,   796,   876,   963,  1060,  1166,  1282,  1411,
                 1552,  1707,  1878,  2066,  2272,  2499,  2749,  3024,
                 3327,  3660,  4026,  4428,  4871,  5358,  5894,  6484,
                 7132,  7845,  8630,  9493, 10442, 11487, 12635, 13899,
                15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794,
                32767 );

  IndexTab : array[0..15] of Integer = ( -1, -1, -1, -1, 2, 4, 6, 8,
                               -1, -1, -1, -1, 2, 4, 6, 8 );

  // MS ADPCM Stuff

  adaptive : array[0..15] of SmallInt =
	(
		230, 230, 230, 230, 307, 409, 512, 614,
		768, 614, 512, 409, 307, 230, 230, 230
	);



  procedure TWaveIn.DecodeDVIADPCMMono(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
  var
    i, j, SP : Integer;
    Diff, PSample : Integer;
    Code : Byte;
    Index : Integer;
 begin
    OutData^[0] := DVI_ADPCM_STATE.valprev_l;
    SP := 0;
    PSample := DVI_ADPCM_STATE.valprev_l;
    Index := DVI_ADPCM_STATE.index_l;
    for i := 0 to (Len shl 1) -1 do
    begin
      j := i shr 1;
      Code := InData^[j];
      if (i and 1) = 0 then
      Code := Code and 15
      else Code := Code shr 4;
      Diff := (StepTab[Index] shr 3 );
      if (Code and 4) <> 0 then
      Diff := Diff + StepTab[Index];
      if (Code and 2) <> 0 then
      Diff := Diff + (StepTab[Index] shr 1);
      if (Code and 1) <> 0 then
      Diff := Diff + (StepTab[Index] shr 2);
      if (Code and 8) <> 0 then	Diff := -Diff;
      PSample := PSample + Diff;
      if PSample > 32767 then PSample := 32767;
      if PSample < -32767 then PSample := -32767;
      SP:=SP+1;
      OutData^[SP] := PSample;
      Index := Index + IndexTab[Code];
      if Index > 88 then Index := 88;
      if Index < 0 then Index := 0;
    end;
    Len := SP+1;
  end;

  procedure TWaveIn.DecodeDVIADPCMStereo(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
  var
    i, j, SP : Integer;
    Diff, PSample : Integer;
    Code : Byte;
    Index : Integer;
 begin
    OutData^[0] := DVI_ADPCM_STATE.valprev_l;
    SP := 0;
    PSample := DVI_ADPCM_STATE.valprev_l;
    Index := DVI_ADPCM_STATE.index_l;
    for i := 0 to (Len -1) do
    begin
      j := i shr 1;
      Code := InData^[(j div 4)*8 + (j mod 4)];
      if (i and 1) = 0 then
      Code := Code and 15
      else Code := Code shr 4;
      Diff := (StepTab[Index] shr 3 );
      if (Code and 4) <> 0 then
      Diff := Diff + StepTab[Index];
      if (Code and 2) <> 0 then
      Diff := Diff + (StepTab[Index] shr 1);
      if (Code and 1) <> 0 then
      Diff := Diff + (StepTab[Index] shr 2);
      if (Code and 8) <> 0 then	Diff := -Diff;
      PSample := PSample + Diff;
      if PSample > 32767 then PSample := 32767;
      if PSample < -32767 then PSample := -32767;
      SP:=SP+2;
      OutData^[SP] := PSample;
      Index := Index + IndexTab[Code];
      if Index > 88 then Index := 88;
      if Index < 0 then Index := 0;
    end;
    i := 1;
    OutData^[i] := DVI_ADPCM_STATE.valprev_r;
    SP := 1;
    PSample := DVI_ADPCM_STATE.valprev_r;
    Index := DVI_ADPCM_STATE.index_r;
    for i := 0 to (Len -1) do
    begin
      j := i shr 1;
      Code := InData^[(j div 4)*8 + (j mod 4) + 4];
      if (i and 1) = 0 then
      Code := Code and 15
      else Code := Code shr 4;
      Diff := (StepTab[Index] shr 3 );
      if (Code and 4) <> 0 then
      Diff := Diff + StepTab[Index];
      if (Code and 2) <> 0 then
      Diff := Diff + (StepTab[Index] shr 1);
      if (Code and 1) <> 0 then
      Diff := Diff + (StepTab[Index] shr 2);
      if (Code and 8) <> 0 then	Diff := -Diff;
      PSample := PSample + Diff;
      if PSample > 32767 then PSample := 32767;
      if PSample < -32767 then PSample := -32767;
      SP:=SP+2;
      OutData^[SP] := PSample;
      Index := Index + IndexTab[Code];
      if Index > 88 then Index := 88;
      if Index < 0 then Index := 0;
    end;
    Len := (SP div 2)+1;
  end;

  procedure TWaveIn.DecodeMSADPCMMono(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
  var
    pos, i, PredSamp, ErrorDelta : Integer;
  begin
    pos := 0;
    OutData^[pos] := MS_ADPCM_STATE.Samp2[0];
    Inc(pos);
    OutData^[pos] := MS_ADPCM_STATE.Samp1[0];
    Inc(pos);
    for i := 0 to (Len shr 1) - 1 do
    begin
      PredSamp := (MS_ADPCM_STATE.Samp1[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef1 +
                   MS_ADPCM_STATE.Samp2[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef2) div 256;
      ErrorDelta := InData^[i] shr 4;
      if (ErrorDelta and 8) <> 0 then
      PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta - 16)
      else
      PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta);
      if PredSamp > 32767 then PredSamp := 32767;
      if PredSamp < -32768 then PredSamp := -32768;
      OutData^[pos] := PredSamp;
      Inc(pos);
      MS_ADPCM_STATE.Delta[0] := (MS_ADPCM_STATE.Delta[0]*adaptive[ErrorDelta]) div 256;
      if MS_ADPCM_STATE.Delta[0] < 16 then MS_ADPCM_STATE.Delta[0] := 16;
      MS_ADPCM_STATE.Samp2[0] := MS_ADPCM_STATE.Samp1[0];
      MS_ADPCM_STATE.Samp1[0] := PredSamp;

      PredSamp := (MS_ADPCM_STATE.Samp1[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef1 +
                   MS_ADPCM_STATE.Samp2[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef2) div 256;
      ErrorDelta := InData^[i] and 15;
      if (ErrorDelta and 8) <> 0 then
      PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta - 16)
      else
      PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta);
      if PredSamp > 32767 then PredSamp := 32767;
      if PredSamp < -32768 then PredSamp := -32768;
      OutData^[pos] := PredSamp;
      Inc(pos);
      MS_ADPCM_STATE.Delta[0] := (MS_ADPCM_STATE.Delta[0]*adaptive[ErrorDelta]) div 256;
      if MS_ADPCM_STATE.Delta[0] < 16 then MS_ADPCM_STATE.Delta[0] := 16;
      MS_ADPCM_STATE.Samp2[0] := MS_ADPCM_STATE.Samp1[0];
      MS_ADPCM_STATE.Samp1[0] := PredSamp;
    end;
    Len := pos*2;
  end;

  procedure TWaveIn.DecodeMSADPCMStereo(InData : PACSBuffer8; OutData : PACSBuffer16; var Len : Integer);
  var
    pos, i, PredSamp, ErrorDelta : Integer;
  begin
    pos := 0;
    OutData^[pos] := MS_ADPCM_STATE.Samp2[0];
    Inc(pos);
    OutData^[pos] := MS_ADPCM_STATE.Samp2[1];
    Inc(pos);
    OutData^[pos] := MS_ADPCM_STATE.Samp1[0];
    Inc(pos);
    OutData^[pos] := MS_ADPCM_STATE.Samp1[1];
    Inc(pos);
    for i := 0 to Len - 1 do
    begin
      PredSamp := (MS_ADPCM_STATE.Samp1[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef1 +
                   MS_ADPCM_STATE.Samp2[0]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[0]].Coef2) div 256;
      ErrorDelta := InData^[i] shr 4;
      if (ErrorDelta and 8) <> 0 then
      PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta - 16)
      else
      PredSamp := PredSamp + MS_ADPCM_STATE.Delta[0]*(ErrorDelta);
      if PredSamp > 32767 then PredSamp := 32767;
      if PredSamp < -32768 then PredSamp := -32768;
      OutData^[pos] := PredSamp;
      Inc(pos);
      MS_ADPCM_STATE.Delta[0] := (MS_ADPCM_STATE.Delta[0]*adaptive[ErrorDelta]) div 256;
      if MS_ADPCM_STATE.Delta[0] < 16 then MS_ADPCM_STATE.Delta[0] := 16;
      MS_ADPCM_STATE.Samp2[0] := MS_ADPCM_STATE.Samp1[0];
      MS_ADPCM_STATE.Samp1[0] := PredSamp;

      PredSamp := (MS_ADPCM_STATE.Samp1[1]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[1]].Coef1 +
                   MS_ADPCM_STATE.Samp2[1]*MS_ADPCM_INFO.CoefSets[MS_ADPCM_STATE.predictor[1]].Coef2) div 256;
      ErrorDelta := InData^[i] and 15;
      if (ErrorDelta and 8) <> 0 then
      PredSamp := PredSamp + MS_ADPCM_STATE.Delta[1]*(ErrorDelta - 16)
      else
      PredSamp := PredSamp + MS_ADPCM_STATE.Delta[1]*(ErrorDelta);
      if PredSamp > 32767 then PredSamp := 32767;
      if PredSamp < -32768 then PredSamp := -32768;
      OutData^[pos] := PredSamp;
      Inc(pos);
      MS_ADPCM_STATE.Delta[1] := (MS_ADPCM_STATE.Delta[1]*adaptive[ErrorDelta]) div 256;
      if MS_ADPCM_STATE.Delta[1] < 16 then MS_ADPCM_STATE.Delta[1] := 16;
      MS_ADPCM_STATE.Samp2[1] := MS_ADPCM_STATE.Samp1[1];
      MS_ADPCM_STATE.Samp1[1] := PredSamp;
    end;
    Len := pos*2;
  end;

  function Compare4(S1, S2 : PChar) : Boolean;
  var
    i, Diff : Byte;
  begin
    Result := False;
    for i := 0 to 3 do
    begin
      Diff := Byte(S1[i]) - Byte(S2[i]);
      if not (Diff in [0, 32, 224]) then Exit;
    end;
    Result := True;
  end;

{$IFDEF LINUX}

   function InputFunc(CData : Pointer; Stream : p_mad_stream) : Integer; cdecl;
   var
     WI : TWaveIn;
   begin
     WI := TWaveIn(CData);
     if WI.InputDone then
     begin
       Result := MAD_FLOW_STOP;
       Exit;
     end;
     WI.InputDone := True;
     mad_stream_buffer(Stream, WI.Data, WI.DataLen);
     Result := MAD_FLOW_CONTINUE;
   end;

   function OutputFunc(CData : Pointer; Header : p_mad_header; pcm : p_mad_pcm) : Integer; cdecl;
   var
     WI : TWaveIn;
     WH : TWaveHeader;
     i, framesize : Integer;
     outsamples : array[0..2303] of SmallInt;
     text : array[0..4] of Char;
   begin
     WI := TWaveIn(CData);
     if not WI.HasFirstFrame then
     begin
       WI.FSR := pcm^.samplerate;
       WI.FChan := pcm^.channels;
       WI.FBPS := 16;
       framesize := Ceil(144*Header^.bitrate/Header^.samplerate);
       WI.FSize := Round(WI.DataLen/framesize*1152)*WI.FChan*2;
       WI.FValid := True;
       text := 'RIFF';
       Move(text[0], WH.RIFF[0], 4);
       WH.FileSize := WI.FSize + 44;
       text := 'WAVE';
       Move(text[0], WH.RIFFType[0], 4);
       text := 'fmt ';
       Move(text[0], WH.FmtChunkId[0], 4);
       WH.FmtChunkSize := 16;
       WH.FormatTag := 1;
       WH.Channels := WI.FChan;
       WH.SampleRate := WI.FSR;
       WH.BitsPerSample := 16;
       WH.BlockAlign := 2*WI.FChan;
       WH.BytesPerSecond := WI.FSR * WH.BlockAlign;
       text := 'data';
       Move(text[0], WH.DataChunkId[0], 4);
       WH.DataSize := WI.FSize;
       WI.FStream.Size :=WI.FSize + 44;
       WI.FStream.Seek(0, soFromBeginning);
       WI.FStream.Write(WH, 44);
       WI.HasFirstFrame := True;
     end;
     if pcm^.channels = 2 then
     begin
       for i := 0 to pcm^.length -1 do
       begin
         if pcm^.samples[0][i] >= MAD_F_ONE then
         pcm^.samples[0][i] := MAD_F_ONE - 1;
         if pcm^.samples[0][i] < -MAD_F_ONE then
         pcm^.samples[0][i] := -MAD_F_ONE;
         pcm^.samples[0][i] := pcm^.samples[0][i] shr (MAD_F_FRACBITS + 1 - 16);
         outsamples[i shl 1] := pcm^.samples[0][i];
         if pcm^.samples[1][i] >= MAD_F_ONE then
         pcm^.samples[1][i] := MAD_F_ONE - 1;
         if pcm^.samples[1][i] < -MAD_F_ONE then
         pcm^.samples[1][i] := -MAD_F_ONE;
         pcm^.samples[1][i] := pcm^.samples[1][i] shr (MAD_F_FRACBITS + 1 - 16);
         outsamples[(i shl 1)+1] := pcm^.samples[1][i];
       end;
       WI.FStream.Write(outsamples[0], pcm^.length*4);
     end else
     begin
       for i := 0 to pcm^.length -1 do
       begin
         if pcm^.samples[0][i] >= MAD_F_ONE then
         pcm^.samples[0][i] := MAD_F_ONE - 1;
         if pcm^.samples[0][i] < -MAD_F_ONE then
         pcm^.samples[0][i] := -MAD_F_ONE;
         pcm^.samples[0][i] := pcm^.samples[0][i] shr (MAD_F_FRACBITS + 1 - 16);
         outsamples[i] := pcm^.samples[0][i];
       end;
       WI.FStream.Write(outsamples[0], pcm^.length*2);
     end;
     Result := MAD_FLOW_CONTINUE;
   end;

   function ErrorFunc(CData : Pointer; Stream : p_mad_stream; Frame : p_mad_frame) : Integer; cdecl;
   begin
     Result := MAD_FLOW_CONTINUE;
   end;

{$ENDIF}

const
  LookingForRIFF = 0;
  LookingForWave = 1;
  LookingForFMT = 2;
  LookingForFACT = 3;
  LookingForDATA = 4;

  constructor TWaveIn.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    BufferSize := $8000;
    _WavType := wtUnsupported;
  end;

  destructor TWaveIn.Destroy;
  begin
    inherited Destroy;
  end;

  procedure TWaveIn.OpenFile;
  var
  {$IFDEF WIN32}
    WaveConverter: TWaveConverter;
    ValidItems: LongWord;
    Res: MMResult;
  {$ENDIF}
  {$IFDEF LINUX}
    _decoder : mad_decoder;
  {$ENDIF}
  begin
    FValid := True;
    if FOpened = 0 then
    begin
      _WavType := wtUnsupported;
      if not FStreamAssigned then
      FStream := TFileStream.Create(FFileName, fmOpenRead) as TFileStream;
      ReadRIFFHeader;
      case Self._WavType of
        wtUnsupported :
        begin
          FValid := False;
          Inc(FOpened);
          Exit;
        end;
        wtPCM:
        begin
          FSize := FStream.Size;
          FTotalSamples := FSize div ((FBPS shr 3) * FChan);
        end;
        wtDVIADPCM :
        begin
          if FBPS <> 4 then
          FValid := False;
          FBPS := 16;
          FTotalSamples := DVI_ADPCM_INFO.DataSize;
          FSize := FTotalSamples*2*FChan;
        end;
        wtMSADPCM :
        begin
          FBPS := 16;
          FSize := MS_ADPCM_INFO.DataSize*2*FChan;
          FTotalSamples := MS_ADPCM_INFO.DataSize;
        end;
        wtACM :
        begin

{$IFDEF WIN32}

          (* Checking if the file is ACM encoded and if it is, decoding it.
             Thanks to Jan Henrik Ejme, <jan.h.ejme@xhlp.com> for the
             provided converter units. *)
          try
            WaveConverter := TWaveConverter.Create;
            FStream.Position := 0;
            WaveConverter.LoadStream(FStream);
            with WaveConverter.NewFormat.Format do
            begin
              wFormatTag := WAVE_FORMAT_PCM;
              ValidItems := ACM_FORMATSUGGESTF_WFORMATTAG;
              Res := acmFormatSuggest(nil, WaveConverter.CurrentFormat.format,
              WaveConverter.NewFormat.Format, SizeOf(TACMWaveFormat), ValidItems);
            end;
            if Res <> 0 then
            begin
              FValid := False;
              WaveConverter.Free;
              Exit;
            end;
            if WaveConverter.Convert <> 0 then
            begin
              FValid := False;
              WaveConverter.Free;
              Exit;
            end else
            begin
              _MS := TMemoryStream.Create;
              OldStream := FStream;
              OldStreamAssigned := FStreamAssigned;
              FStream := _MS;
              _MS.Position := 0;
              WaveConverter.SaveWavToStream(_MS);
              FSize := _MS.Size;
              _MS.Seek(0, soFromBeginning);
              ReadRIFFHeader;
              //WaveConverter.CurrentFormat.Format.wFormatTag;
              WaveConverter.Free;
              _wavType := wtACM;
            end;
          except
            WaveConverter.Free;
          end;
{$ENDIF}
{$IFDEF LINUX}
          if not MADLibLoaded then
          raise EACSException.Create(Format(strCoudntloadLib,['madlib']));
          DataLen := FStream.Size;
          GetMem(Data, DataLen);
          FStream.Read(Data^, DataLen);
          _MS := TMemoryStream.Create;
          OldStream := FStream;
          OldStreamAssigned := FStreamAssigned;
          FStream := _MS;
          HasFirstFrame := False;
          InputDone := False;
          mad_decoder_init(@_decoder, Self, InputFunc, nil, nil, OutputFunc, ErrorFunc, nil);
          mad_decoder_run(@_decoder, MAD_DECODER_MODE_SYNC);
          mad_decoder_finish(@_decoder);
          FreeMem(Data);
          FStream.Seek(0, soFromBeginning);
          ReadRIFFHeader;
          _wavType := wtACM;
{$ENDIF}
        end;
      end;
    end;
    Inc(FOpened);
  end;

  procedure TWaveIn.CloseFile;
  begin
    if FOpened = 1 then
    begin
      if not FStreamAssigned then FStream.Free
      else if FSeekable then FStream.Seek(0, soFromBeginning);
      if _WavType = wtACM then
      begin
        if Assigned(_MS) then
        begin
          if OldStreamAssigned then
          FStream := OldStream
          else
          begin
            FStream := nil;
            OldStream.Free;
          end;
//        _MS.Free;
          _MS := nil;
        end;
      end;
    end;
    if FOpened > 0 then Dec(FOpened);
  end;

  function TWaveIn.GetData(Buffer : Pointer; aBufferSize : Integer): Integer;
  var
    l, csize : Integer;
    offs : Integer;
    Data : Pointer;
  begin
    if not Busy then  raise EACSException.Create(strStreamnotopen);
    if BufStart > BufEnd then
    begin
      case _WavType of
        wtDVIADPCM :
        begin
          if FOffset <> 0 then
          begin
            offs := (FStream.Position div DVI_ADPCM_INFO.BlockLength)
            * DVI_ADPCM_INFO.SamplesPerBlock + Round((FOffset/100)*FTotalSamples);
            if offs < 0 then offs := 0;
            Seek(offs);
            FPosition := (FStream.Position div DVI_ADPCM_INFO.BlockLength)
            * DVI_ADPCM_INFO.SamplesPerBlock;
            FPosition := FPosition*2*FChan;
            FOffset := 0;
          end;
          if FSeekable then
          begin
            if FPosition >= FSize then
            begin
              if FLoop then
              begin
                Flush;
                Init;
              end else
              begin
                Result := 0;
                Exit;
              end;
            end;
          end;
          BufStart := 1;
          csize := DVI_ADPCM_INFO.BlockLength - FChan*4;
          GetMem(Data, csize);
          if ReadDVIADPCMBlock(Data) then
          begin
            if FChan = 2 then
            begin
              DecodeDVIADPCMStereo(Data, @buf[1], csize);
              BufEnd := (csize)*4;
            end else
            begin
              DecodeDVIADPCMMono(Data, @buf[1], csize);
              BufEnd := (csize)*2;
              FreeMem(Data);
            end;
          end else
          begin
            FreeMem(Data);
            if not Seekable then
            begin
             Result := 0;
             Exit;
            end
            else BufEnd := 0;
          end;
        end;
        wtMSADPCM :
        begin
          if FOffset <> 0 then
          begin
            offs := (FStream.Position div MS_ADPCM_INFO.BlockLength)
            * MS_ADPCM_INFO.SamplesPerBlock + Round((FOffset/100)*FTotalSamples);
            if offs < 0 then offs := 0;
            Seek(offs);
            FPosition := (FStream.Position div MS_ADPCM_INFO.BlockLength)
            * MS_ADPCM_INFO.SamplesPerBlock;
            FPosition := FPosition*2*FChan;
            FOffset := 0;
          end;
          if FPosition >= FSize then
          begin
            if FLoop then
            begin
              Flush;
              Init;
            end else
            begin
              Result := 0;
              Exit;
            end;
          end;
          BufStart := 1;
          if FChan = 2 then
          begin
            csize := MS_ADPCM_INFO.BlockLength-SizeOf(TMSADPCMBlockHeaderStereo);
            GetMem(Data, csize);
            if ReadMSADPCMBlock(Data) then
            begin
              csize := MS_ADPCM_INFO.SamplesPerBlock-2;
              DecodeMSADPCMStereo(Data, @buf, csize);
              BufEnd := csize;
              FreeMem(Data);
            end else BufEnd := 0;
          end else
          begin
            csize := MS_ADPCM_INFO.BlockLength-SizeOf(TMSADPCMBlockHeaderMono);
            GetMem(Data, csize);
            if ReadMSADPCMBlock(Data) then
            begin
              csize := MS_ADPCM_INFO.SamplesPerBlock-2;
              DecodeMSADPCMMono(Data, @buf, csize);
              BufEnd := csize;
              FreeMem(Data);
            end else BufEnd := 0;
          end;
        end;
        wtPCM:
        begin
          if FOffset <> 0 then
          begin
            offs := Round((FOffset/100)*FSize);
            FPosition := FPosition + offs;
            if FPosition < 0 then FPosition := 0
            else if FPosition > FSize then FPosition := FSize;
            FStream.Seek((FPosition shr 2) shl 2, soFromBeginning); // align to 4-byte frame
            FOffset := 0;
          end;
          BufStart := 1;
          l := FStream.Read(buf, aBufferSize);
          if FPosition+l >= FSize then
            l := FSize - FPosition;
          if l <=0 then
          begin
            if FLoop then
            begin
              Flush;
              Init;
            end else
            begin
              Result := 0;
              Exit;
            end;
          end;
          if l = 0 then
          begin
            if FLoop then
            begin
              Flush;
              Init;
              l := FStream.Read(buf, aBufferSize);
            end else
            begin
              Result := 0;
              Exit;
            end;
          end;
          BufEnd := l;
        end;
        wtACM:
        begin
          if FOffset <> 0 then
          begin
            offs := Round((FOffset/100)*FSize);
            FPosition := FPosition + offs;
            if FPosition < 0 then FPosition := 0
            else if FPosition > FSize then FPosition := FSize;
            FStream.Seek((FPosition shr 2) shl 2, soFromBeginning); // align to 4-byte frame
            FOffset := 0;
          end;
          BufStart := 1;
          l := FStream.Read(buf, aBufferSize);
          if FPosition+l >= FSize then
            l := FSize - FPosition;
          if l <=0 then
          begin
            if FLoop then
            begin
              Flush;
              Init;
            end else
            begin
              Result := 0;
              Exit;
            end;
          end;
          BufEnd := l;
        end;
      end;
    end;
    if aBufferSize < (BufEnd - BufStart + 1) then
      Result := aBufferSize
    else
      Result := BufEnd - BufStart + 1;

    Move(buf[BufStart-1], Buffer^, Result);
    Inc(BufStart, Result);
    Inc(FPosition, Result);
  end;

  function TWaveIn.Seek(SampleNum : Integer) : Boolean;
  begin
    Result := False;
    if not FSeekable then Exit;
    Result := True;
    OpenFile;
    case _WavType of
      wtPCM :
      begin
        Stream.Seek(SampleNum*(Self.FBPS shr 3)*FChan+HeaderSize, soFromBeginning);
      end;
      wtDVIADPCM:
      begin
        Stream.Seek((SampleNum div DVI_ADPCM_INFO.SamplesPerBlock)*DVI_ADPCM_INFO.BlockLength + HeaderSize, soFromBeginning);
      end;
      wtMSADPCM:
      begin
        Stream.Seek((SampleNum div MS_ADPCM_INFO.SamplesPerBlock)*MS_ADPCM_INFO.BlockLength + HeaderSize, soFromBeginning);
      end;
      else
      begin
        Result := False;
      end;
    end;
    CloseFile;
  end;

procedure TWaveOut.FillHeaderPCM(var Header : TWaveHeader);
var
  text : array[0..4] of Char;
begin
  text := 'RIFF';
  Move(text[0], Header.RIFF[0], 4);
  Header.FileSize := FInput.Size + WaveHeaderOffs;
  text := 'WAVE';
  Move(text[0], Header.RIFFType[0], 4);
  text := 'fmt ';
  Move(text[0], Header.FmtChunkId[0], 4);
  Header.FmtChunkSize := 16;
  Header.FormatTag := WAVE_FORMAT_PCM;
  Header.Channels := FInput.Channels;
  Header.SampleRate := FInput.SampleRate;
  Header.BitsPerSample := FInput.BitsPerSample;
  Header.BlockAlign := (Header.BitsPerSample * Header.Channels) shr 3;
  Header.BytesPerSecond := Header.SampleRate * Header.BlockAlign;
  text := 'data';
  Move(text[0], Header.DataChunkId[0], 4);
  Header.DataSize := FInput.Size;
end;

procedure TWaveOut.FillHeaderDVIADPCM(var Header : TDVIADPCMHeader);
var
  text : array[0..4] of Char;
  samples : Integer;
begin
  text := 'RIFF';
  Move(text[0], Header.RIFF[0], 4);
  text := 'WAVE';
  Move(text[0], Header.RIFFType[0], 4);
  text := 'fmt ';
  Move(text[0], Header.FmtChunkId[0], 4);
  Header.FmtChunkSize := 20;
  Header.FormatTag := WAVE_FORMAT_DVI_IMA_ADPCM;
  Header.Channels := FInput.Channels;
  Header.SampleRate := FInput.SampleRate;
  Header.BitsPerSample := 4;
  Header.BlockAlign := FBlockAlign;
  Header.SamplesPerBlock := (Header.BlockAlign- 4*FInput.Channels) * (2 div FInput.Channels) + 1;
  Header.cbSize := 2;
  Header.BytesPerSecond := (FInput.SampleRate div Header.SamplesPerBlock)*Header.BlockAlign;
  samples := (FInput.Size div (FInput.BitsPerSample shr 3)) div FInput.Channels;
  Header.DataSize := Round(samples/Header.SamplesPerBlock)*Header.BlockAlign;
  Header.FileSize := Header.DataSize + SizeOf(TDVIADPCMHeader);
  text := 'data';
  Move(text[0], Header.DataChunkId[0], 4);
  text := 'fact';
  Move(text[0], Header.FactChunkId[0], 4);
  Header.FactChunkSize := 4;
  Header.DataLength := samples;
end;

procedure TWaveOut.EncodeDVIADPCMMono(InData : PACSBuffer16; OutData : PACSBuffer8);
var
  i, j, Diff, PredSamp, Index : Integer;
  Code : Byte;
  Header : TDVIADPCMBlockHeader;
begin
  FillChar(OutData[0], FBlockAlign, 0);
  Header.Samp0 := FEncodeState.PredSamp_l;
  Header.StepTableIndex := FEncodeState.Index_l;
  Move(Header, OutData[0], SizeOf(Header));
  PredSamp := FEncodeState.PredSamp_l;
  Index := FEncodeState.Index_l;
  for i := 0 to (FBlockAlign-4)*2 - 1 do
  begin
    Diff := InData[i] - PredSamp;
    if Diff < 0 then
    begin
      Code := 8;
      Diff := -Diff;
    end else Code := 0;
    if Diff >= StepTab[Index] then
    begin
      Code := Code or 4;
      Diff := Diff-StepTab[Index];
    end;
    if Diff >= (StepTab[Index] shr 1) then
    begin
      Code := Code or 2;
      Diff := Diff - (StepTab[Index] shr 1);
    end;
    if Diff >= (StepTab[Index] shr 2) then
    Code := Code or 1;
    j := (i shr 1)+4;
    if (i and 1) = 0 then
      OutData[j] := Code
    else
    OutData[j] := OutData[j] or (Code shl 4);
    Diff := (StepTab[Index] shr 3);
    if (Code and 4) <> 0 then Diff := Diff + StepTab[Index];
    if (Code and 2) <> 0 then Diff := Diff + (StepTab[Index] shr 1);
    if (Code and 1) <> 0 then Diff := Diff + (StepTab[Index] shr 2);
    if (Code and 8) <> 0 then Diff := -Diff;
    PredSamp := PredSamp + Diff;
    if PredSamp > 32767 then PredSamp := 32767;
    if PredSamp < -32767 then PredSamp := -32767;
    Index := Index + IndexTab[Code];
    if Index > 88 then Index := 88;
    if Index < 0 then Index := 0;
  end;
  FEncodeState.Index_l := Index;
//  State.PredSamp_l := PredSamp;
end;

procedure TWaveOut.EncodeDVIADPCMStereo(InData : PACSBuffer16; OutData : PACSBuffer8);
var
  i, j, Diff, bPos, PredSamp, Index : Integer;
  Code : Byte;
  Header : TDVIADPCMBlockHeader;
begin
  FillChar(OutData[0], FBlockAlign, 0);
  Header.Samp0 := FEncodeState.PredSamp_l;
  Header.StepTableIndex := FEncodeState.Index_l;
  Move(Header, OutData[0], SizeOf(Header));
  Header.Samp0 := FEncodeState.PredSamp_r;
  Header.StepTableIndex := FEncodeState.Index_r;
  i := 4;
  Move(Header, OutData[i], SizeOf(Header));
  PredSamp := FEncodeState.PredSamp_l;
  Index := FEncodeState.Index_l;
  for i := 0 to FBlockAlign - 9 do
  begin
    Diff := InData[i shl 1] - PredSamp;
    if Diff < 0 then
    begin
      Code := 8;
      Diff := -Diff;
    end else Code := 0;
    if Diff >= StepTab[Index] then
    begin
      Code := Code or 4;
      Diff := Diff-StepTab[Index];
    end;
    if Diff >= (StepTab[Index] shr 1) then
    begin
      Code := Code or 2;
      Diff := Diff - (StepTab[Index] shr 1);
    end;
    if Diff >= (StepTab[Index] shr 2) then
    Code := Code or 1;
    j := i shr 1;
    bPos := (j div 4)*8 + (j mod 4) + 8;
    if (i and 1) = 0 then
      OutData[bPos] := Code
    else
    OutData[bPos] := OutData[bPos] or (Code shl 4);
    Diff := (StepTab[Index] shr 3);
    if (Code and 4) <> 0 then Diff := Diff + StepTab[Index];
    if (Code and 2) <> 0 then Diff := Diff + (StepTab[Index] shr 1);
    if (Code and 1) <> 0 then Diff := Diff + (StepTab[Index] shr 2);
    if (Code and 8) <> 0 then Diff := -Diff;
    PredSamp := PredSamp + Diff;
    if PredSamp > 32767 then PredSamp := 32767;
    if PredSamp < -32767 then PredSamp := -32767;
    Index := Index + IndexTab[Code];
    if Index > 88 then Index := 88;
    if Index < 0 then Index := 0;
  end;
  FEncodeState.Index_l := Index;
  FEncodeState.PredSamp_l := PredSamp;
  PredSamp := FEncodeState.PredSamp_r;
  Index := FEncodeState.Index_r;
  for i := 0 to FBlockAlign - 9 do
  begin
    Diff := InData[(i shl 1)+1] - PredSamp;
    if Diff < 0 then
    begin
      Code := 8;
      Diff := -Diff;
    end else Code := 0;
    if Diff >= StepTab[Index] then
    begin
      Code := Code or 4;
      Diff := Diff-StepTab[Index];
    end;
    if Diff >= (StepTab[Index] shr 1) then
    begin
      Code := Code or 2;
      Diff := Diff - (StepTab[Index] shr 1);
    end;
    if Diff >= (StepTab[Index] shr 2) then
    Code := Code or 1;
    j := i shr 1;
    bPos := (j div 4)*8 + (j mod 4) + 12;
    if i and 1 = 0 then
    OutData[bPos] := Code
    else
    OutData[bPos] := OutData[bPos] or (Code shl 4);
    Diff := (StepTab[Index] shr 3);
    if (Code and 4) <> 0 then Diff := Diff + StepTab[Index];
    if (Code and 2) <> 0 then Diff := Diff + (StepTab[Index] shr 1);
    if (Code and 1) <> 0 then Diff := Diff + (StepTab[Index] shr 2);
    if (Code and 8) <> 0 then Diff := -Diff;
    PredSamp := PredSamp + Diff;
    if PredSamp > 32767 then PredSamp := 32767;
    if PredSamp < -32767 then PredSamp := -32767;
    Index := Index + IndexTab[Code];
    if Index > 88 then Index := 88;
    if Index < 0 then Index := 0;
  end;
   FEncodeState.Index_r := Index;
   FEncodeState.PredSamp_r := PredSamp;
end;

constructor TWaveOut.Create;
begin
  inherited Create(AOwner);
  FBufferSize := $4000;
  FWavType := wtPCM;
  FBlockAlign := 512;
end;

destructor TWaveOut.Destroy;
begin
  inherited Destroy;
end;

procedure TWaveOut.SetWavType;
begin
  if Busy then Exit;
  if (WT = wtPCM) or (WT = wtDVIADPCM) then
  FWavType := WT;
end;

  procedure TWaveOut.Prepare;
  var
    Header : TWaveHeader;
    DVIADPCMHeader : TDVIADPCMHeader;
  begin
    GetMem(FBuffer,FBufferSize);
    EndOfInput := False;
    if not FStreamAssigned then
    begin
      if FFileName = '' then raise EACSException.Create(strFilenamenotassigned);
      if (not FileExists(FFileName)) or (FFileMode = foRewrite) then
      FStream := TFileStream.Create(FFileName, fmCreate or fmShareExclusive, FAccessMask)
      else FStream := TFileStream.Create(FFileName, fmOpenReadWrite or fmShareExclusive, FAccessMask);
    end;
    FInput.Init;
    if (FFileMode = foAppend) and (FStream.Size <> 0) then
    begin
      ReadRIFFHeader;
      if not (FPrevWavType in [wtPCM, wtDVIADPCM]) then
      begin
        FInput.Flush;
        if not FStreamAssigned then
        begin
          FStream.Free;
          FStream := nil;
        end;
        raise EACSException.Create('Cannot append data to this .wav file.');
      end;
      FWavType := FPrevWavType;
    end;
    case FWavType of
      wtPCM :
      begin
        if (FFileMode = foAppend) and (FStream.Size <> 0) then
        begin
          if (FPrevSR <> FInput.SampleRate) or
             (FPrevBPS <> FInput.BitsPerSample) or
             (FPrevCh <> FInput.Channels) then
          begin
            FInput.Flush;
            if not FStreamAssigned then
            begin
              FStream.Free;
              FStream := nil;
            end;
            raise EACSException.Create('Cannot append data in different audio format.');
          end;
          FStream.Seek(0, soFromEnd);
        end else
        begin
          FillHeaderPCM(Header);
          FStream.Write(Header, WaveHeaderOffs);
        end;
      end;
      wtDVIADPCM :
      begin
        if FInput.BitsPerSample <> 16 then
        begin
          FInput.Flush;
          if not FStreamAssigned then
          begin
            FStream.Free;
            FStream := nil;
          end;
          raise EACSException.Create('Cannot encode 8 bit sound into ADPCM.');
        end;
//        FBlockAlign := 512;
        if (FFileMode = foAppend) and (FStream.Size <> 0) then
        begin
          if (FPrevSR <> FInput.SampleRate) or
             (FPrevCh <> FInput.Channels) then
          begin
            FInput.Flush;
            if not FStreamAssigned then
            begin
              FStream.Free;
              FStream := nil;
            end;
            raise EACSException.Create('Cannot append data in different audio format.');
          end;
          FStream.Seek(0, soFromEnd);
        end else
        begin
          FillHeaderDVIADPCM(DVIADPCMHeader);
          FStream.Write(DVIADPCMHeader, SizeOf(DVIADPCMHeader));
          FEncodeState.Index_l := 0;
          FEncodeState.Index_r := 0;
        end;
      end;
    end;
  end;

  procedure TWaveOut.Done;
  var
    Size : Integer;
    Hdr : TDVIADPCMHeader;
  begin
    if ((FInput.Size < 0) or (FFileMode = foAppend)) and (FStream <> nil) then
    begin
      case FWavType of
        wtPCM:
        begin
          if FFileMode = foAppend then
          begin
            FStream.Seek(FDataSizeOffs, soFromBeginning);
            Size := FStream.Size - HeaderSize;
            FStream.Write(Size, 4);
          end else
          begin
            Size := FStream.Size - 44;
            FStream.Seek(DataSizeOffs, soFromBeginning);
            FStream.Write(Size, 4);
          end;
        end;
        wtDVIADPCM:
        begin
          if FFileMode = foAppend then
          begin
            FStream.Seek(FDataSizeOffs, soFromBeginning);
            Size := FStream.Size - HeaderSize;
            FStream.Write(Size, 4);
            FStream.Seek(FLenOffs, soFromBeginning);
            Size := (Size div FBlockAlign)*((FBlockAlign-FPrevCh*4)*(2 div FPrevCh) + 1);
            FStream.Write(Size, 4);
          end else
          begin
            Size := FStream.Size - SizeOf(TDVIADPCMHeader);
            FStream.Seek(0, soFromBeginning);
            Fstream.Read(Hdr, SizeOf(Hdr));
            Hdr.DataSize := Size;
            Hdr.DataLength := (Hdr.DataSize div Hdr.BlockAlign) * Hdr.SamplesPerBlock;
            FStream.Seek(0, soFromBeginning);
            FStream.Write(Hdr, SizeOf(Hdr));
          end;
        end;
      end;
      Size := FStream.Size;
      FStream.Seek(4, soFromBeginning);
      FStream.Write(Size, 4);
    end;
    if (not FStreamAssigned) and (FStream <> nil) then FStream.Free;
    FInput.Flush;
    FreeMem(FBuffer);
  end;

  function TWaveOut.DoOutput(Abort : Boolean):Boolean;
  var
    Len, l, m : Integer;
    DVIInBuf : PACSBuffer16;
    DVIOutBuf : PACSBuffer8;
    P : PACSBuffer8;
    BlockDataSize : Integer;
  begin
    // No exceptions Here
    Result := True;
    if not CanOutput then Exit;
    Len := 0;
    if Abort then
    begin
      (* We don't close file here to avoide exceptions
        if output componenet's Stop method is called *)
      Result := False;
      Exit;
    end;
    if EndOfInput then
    begin
      Result := False;
      Exit;
    end;
    case FWavType of
      wtPCM :
      begin
        try
          while InputLock do;
          InputLock := True;
          Len := Finput.GetData(@FBuffer[0], FBufferSize);
          InputLock := False;
          FStream.Write(FBuffer[0], Len);
        except
        end;
        if Len > 0 then Result := True
        else Result := False;
      end;
      wtDVIADPCM :
      begin
        BlockDataSize := (FBlockAlign - 4*FInput.Channels)*4 +2*FInput.Channels;
        GetMem(DVIInBuf, BlockDataSize);
        GetMem(DVIOutBuf, FBlockAlign);
        P := PACSBuffer8(DVIInBuf);
        try
          if FInput.Channels = 2 then
          begin
            l := 0;
            FillChar (DVIInBuf[0], BlockDataSize, 0);
            while InputLock do;
            InputLock := True;
            while l <> BlockDataSize do
            begin
              m := Finput.GetData(@P[l], BlockDataSize-l);
              if m = 0 then
              begin
                EndOfInput := True;
                Break;
              end;
              Inc(l, m);
            end;
            Len := FBlockAlign;
            InputLock := False;
            FEncodeState.PredSamp_l := DVIInBuf[0];
            m := 1;
            FEncodeState.PredSamp_r := DVIInBuf[m];
            m := 2;
            EncodeDVIADPCMStereo(@DVIInBuf[m], @DVIOutBuf[0]);
            FStream.Write(DVIOutBuf[0], FBlockAlign);
          end else
          begin
            l := 0;
            FillChar (DVIInBuf[0], BlockDataSize, 0);
            while InputLock do;
            InputLock := True;
            while l <> BlockDataSize do
            begin
              m := Finput.GetData(@P[l], BlockDataSize-l);
              if m = 0 then
              begin
                EndOfInput := True;
                Break;
              end;
              Inc(l, m);
            end;
            Len := FBlockAlign;
            InputLock := False;
            FEncodeState.PredSamp_l := DVIInBuf[0];
            m := 1;
            EncodeDVIADPCMMono(@DVIInBuf[m], @DVIOutBuf[0]);
            FStream.Write(DVIOutBuf[0], FBlockAlign);
          end;
        except
        end;
        FreeMem(DVIInBuf);
        FreeMem(DVIOutBuf);
        if Len > 0 then Result := True
        else Result := False;
      end;
    end;
  end;

  function TWaveIn.GetWavType : TWavType;
  begin
    OpenFile;
    Result := _WavType;
    CloseFile;
  end;

  procedure TWaveOut.SetFileMode;
  begin
    FFileMode := aMode;
  end;

  procedure TWaveIn.SetBufferSize(S: Integer);
  begin
  end;

  function TWaveIn.ReadDVIADPCMBlock(aData : Pointer) : Boolean;
  var
    block : array of Byte;
    BH : TDVIADPCMBlockHeader;
  begin
    Result := False;
    if Seekable then
    if FStream.Position >= FStream.Size then Exit;
    SetLength(Block, DVI_ADPCM_INFO.BlockLength);
    if FStream.Read(Block[0], Length(Block))= 0 then Exit;
    Result := True;
    Move(Block[0], BH, SizeOf(BH));
    DVI_ADPCM_STATE.valprev_l := BH.Samp0;
    DVI_ADPCM_STATE.index_l := BH.StepTableIndex;
    if FChan = 2 then
    begin
      Move(Block[4], BH, SizeOf(BH));
      DVI_ADPCM_STATE.valprev_r := BH.Samp0;
      DVI_ADPCM_STATE.index_r := BH.StepTableIndex;
      Move(Block[8], aData^, DVI_ADPCM_INFO.BlockLength-8);
    end else
    Move(Block[4], aData^, DVI_ADPCM_INFO.BlockLength-4);
  end;

  function TWaveIn.ReadMSADPCMBlock(bData : Pointer) : Boolean;
  var
    block : array of Byte;
    BHM : TMSADPCMBlockHeaderMono;
    BHS : TMSADPCMBlockHeaderStereo;
  begin
    Result := False;
    if FStream.Position >= FStream.Size then Exit;
    Result := True;
    SetLength(Block, MS_ADPCM_INFO.BlockLength);
    FStream.Read(Block[0], Length(Block));
    if FChan = 1 then
    begin
      Move(Block[0], BHM, SizeOf(BHM));
      MS_ADPCM_STATE.predictor[0] := BHM.predictor;
      MS_ADPCM_STATE.Delta[0] := BHM.Delta;
      MS_ADPCM_STATE.Samp1[0] := BHM.Samp1;
      MS_ADPCM_STATE.Samp2[0] := BHM.Samp2;
      Move(Block[SizeOf(BHM)], bData^, MS_ADPCM_INFO.BlockLength-SizeOf(BHM));
    end else
    begin
      Move(Block[0], BHS, SizeOf(BHS));
      MS_ADPCM_STATE := BHS;
      Move(Block[SizeOf(BHS)], bData^, MS_ADPCM_INFO.BlockLength-SizeOf(BHS));
    end;
  end;

  procedure TWaveIn.ReadRIFFHeader;
  var
    i : Integer;
    WordVal : Word;
    IntVal : Integer;
    Buff : array[0..$fff] of Char;
    State : Integer;
    ChunkSize : Integer;
  begin
    _WavType := wtUnsupported;
    State := LookingForRIFF;
    i := 4;
    FStream.Read(Buff[0], 4);
    while i < $2000 do
    begin
      case State of
        LookingForRIFF :
        begin
          if not Compare4(@Buff[i-4], 'RIFF') then
          begin
            FStream.Read(Buff[i], 1);
            Inc(i);
          end else
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            State := LookingForWAVE;
          end;
        end;
        LookingForWAVE :
        begin
          if not Compare4(@Buff[i-4], 'WAVE') then
          begin
            FStream.Read(Buff[i], 1);
            Inc(i);
          end else
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            State := LookingForFMT;
          end;
        end;
        LookingForFMT :
        begin
          if not Compare4(@Buff[i-4], 'fmt ') then
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
          end else
          begin
            Stream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            Move(Buff[i-ChunkSize], WordVal, 2);
            case WordVal of
              WAVE_FORMAT_PCM : _WavType := wtPCM;
              WAVE_FORMAT_IMA_ADPCM : _WavType := wtDVIADPCM;
              WAVE_FORMAT_ADPCM : _WavType := wtMSADPCM;
              WAVE_FORMAT_MP3 : _WavType := wtACM;
              else Exit;
            end;
            Move(Buff[i+2-ChunkSize], WordVal, 2);
            FChan := WordVal;
            Move(Buff[i+4-ChunkSize], IntVal, 4);
            FSR := IntVal;
            Move(Buff[i+12-ChunkSize], WordVal, 2);
            if _WavType = wtDVIADPCM then
            DVI_ADPCM_INFO.BlockLength := WordVal else
            MS_ADPCM_INFO.BlockLength := WordVal;
            Move(Buff[i+14-ChunkSize], WordVal, 2);
            FBPS := WordVal;
            if _WavType in [wtDVIADPCM, wtMSADPCM, wtACM] then
            begin
              Move(Buff[i+18-ChunkSize], WordVal, 2);
              if _WavType = wtDVIADPCM then
              DVI_ADPCM_INFO.SamplesPerBlock := WordVal
              else MS_ADPCM_INFO.SamplesPerBlock := WordVal;
              if _WavType = wtMSADPCM then
              begin
                Move(Buff[i+20-ChunkSize], WordVal, 2);
                MS_ADPCM_INFO.NumCoeff := WordVal;
                Move(Buff[i+22-ChunkSize], MS_ADPCM_INFO.CoefSets[0], MS_ADPCM_INFO.NumCoeff*SizeOf(TMS_ADPCM_COEF_SET));
              end;
              State := LookingForFACT;
            end else State := LookingForDATA;
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
          end;
        end;
        LookingForFACT :
        begin
          if not Compare4(@Buff[i-4], 'fact') then
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
          end else
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            Move(Buff[i-ChunkSize], IntVal, 4);
            if _WavType = wtDVIADPCM then
            DVI_ADPCM_INFO.DataSize := IntVal
            else
            MS_ADPCM_INFO.DataSize := IntVal;
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            State := LookingForDATA;
          end;
        end;
        LookingForDATA :
        begin
          if not Compare4(@Buff[i-4], 'data') then
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
          end else
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            if _WavType = wtPCM then
            Move(Buff[i-4], FSize, 4);
            HeaderSize := i;
            Exit;
          end;
        end;
      end;
      if Seekable then
      if FStream.Position >= FStream.Size then Break;
    end;
    _WavType := wtUnsupported
  end;

  procedure TWaveOut.ReadRIFFHeader;
  var
    i : Integer;
    WordVal : Word;
    Buff : array[0..$fff] of Char;
    State : Integer;
    ChunkSize : Integer;
  begin
    FPrevWavType := wtUnsupported;
    State := LookingForRIFF;
    i := 4;
    FStream.Read(Buff[0], 4);
    while i < $2000 do
    begin
      case State of
        LookingForRIFF :
        begin
          if not Compare4(@Buff[i-4], 'RIFF') then
          begin
            FStream.Read(Buff[i], 1);
            Inc(i);
          end else
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            State := LookingForWAVE;
          end;
        end;
        LookingForWAVE :
        begin
          if not Compare4(@Buff[i-4], 'WAVE') then
          begin
            FStream.Read(Buff[i], 1);
            Inc(i);
          end else
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            State := LookingForFMT;
          end;
        end;
        LookingForFMT :
        begin
          if not Compare4(@Buff[i-4], 'fmt ') then
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
          end else
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            Move(Buff[i-ChunkSize], WordVal, 2);
            case WordVal of
              WAVE_FORMAT_PCM : FPrevWavType := wtPCM;
              WAVE_FORMAT_IMA_ADPCM : FPrevWavType := wtDVIADPCM;
              else Exit;
            end;
            Move(Buff[i+2-ChunkSize], FPrevCh, 2);
            Move(Buff[i+4-ChunkSize], FPrevSR, 4);
            Move(Buff[i+12-ChunkSize], FBlockAlign, 2);
            Move(Buff[i+14-ChunkSize], FPrevBPS, 2);
            if FPrevWavType = wtDVIADPCM then
            State := LookingForFACT
            else State := LookingForDATA;
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
          end;
        end;
        LookingForFACT :
        begin
          if not Compare4(@Buff[i-4], 'fact') then
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
          end else
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FLenOffs := i;
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            Move(Buff[i-ChunkSize], FPrevLen, 4);
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            State := LookingForDATA;
          end;
        end;
        LookingForDATA :
        begin
          if not Compare4(@Buff[i-4], 'data') then
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            Move(Buff[i-4], ChunkSize, 4);
            FStream.Read(Buff[i], ChunkSize);
            Inc(i, ChunkSize);
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
          end else
          begin
            FStream.Read(Buff[i], 4);
            Inc(i, 4);
            FDataSizeOffs := i-4;
            Move(Buff[i-4], FPrevDataSize, 4);
            HeaderSize := i;
            Exit;
          end;
        end;
      end;
      if FStream.Position >= FStream.Size then Break;
    end;
    FPrevWavType := wtUnsupported
  end;

  procedure TWaveOut.SetBlockSize;
  begin
    if not Busy then
    if BS <> 0 then
    if (BS mod 4) = 0 then FBlockAlign := BS;
  end;

initialization

  FileFormats.Add('wav','Waveform Audio',TWaveOut);
  FileFormats.Add('wav','Waveform Audio',TWaveIn);

end.
