const WAVE_FORMAT_UNKNOWN =$00;
     WAVE_FORMAT_PCM    = $01;
     WAVE_FORMAT_GSM610 = $31;
     WAVE_FORMAT_ROCKWELLADPCM = $101;
     WAVE_FORMAT_OMNIADPCM = $102;

type
    TWaveInfo = record
          FormatTag: WORD;
          Channels: WORD;
          SamplesPerSec: DWORD;
          AvgBytesPerSec: DWORD;
          BitsPerSample: WORD;
          DataPos: DWORD;
          DataSize: DWORD;
          AllDataSize: DWORD;
    end;
    TWaveHeader = packed record
          riff: array[1..4] of Char;
          filesize: Longint;
          wave: array[1..4] of Char;
          fmt: array[1..4] of Char;
          schunk: Longint;
          wtype: Word;
          mono_stereo: Word;
          sample_rate: Longint;
          byte_sec: Longint;
          blockal: Word;
          bits_sample: Longint;
          data: array[1..4] of Char;
          datasize: Longint;
    end;

 procedure WaveOutProc(hwo: HWAVEOUT; uMsg, dwInstance, dwParam1,dwParam2: DWORD);stdcall;
 function  GetWaveStreamParams(WaveStm: TStream; var WaveInfo:TWaveInfo):boolean;

var
 BuffOutLenMSec:integer;
 FBuffer:TMemoryStream; yBuffer:boolean;
 WavHandle : HWAVEOUT;
 wh1,wh2: TWaveHdr;
 address: PWaveHdr;

procedure TForm1.Button1Click(Sender: TObject);
var wfx : TWAVEFORMATEX;
   BufPlayLen:Cardinal;
   hBufPlay1,hBufPlay2 : THandle;
   Buf1,Buf2:Pointer;
   M:TMemoryStream;
   WaveInfo:TWaveInfo;
label vuhod1,vuhod2;
begin
   M:=TMemoryStream.Create;
   M.LoadFromFile('vce3.wav');
   GetWaveStreamParams(M, WaveInfo);
   BuffOutLenMSec:=100;
   if WaveInfo.Channels=0 then BufPlayLen:=1
   else BufPlayLen:= WaveInfo.BitsPerSample div 8 * WaveInfo.Channels;
   BufPlayLen := Trunc(BufPlayLen * WaveInfo.SamplesPerSec / 1000 * BuffOutLenMSec);
   if BufPlayLen=0 then BufPlayLen:=1024;
      M.Seek(0, soFromBeginning);
      FillChar(wfx,Sizeof(TWAVEFORMATEX),#0);
      with wfx do begin
           wFormatTag     := WaveInfo.FormatTag;
           nChannels      := WaveInfo.Channels;
           nSamplesPerSec := WaveInfo.SamplesPerSec;
           wBitsPerSample := WaveInfo.BitsPerSample;
           nBlockAlign := wBitsPerSample div 8 * nChannels;
           nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
           cbSize := 0;
      end;
      if waveOutOpen(@WavHandle, WAVE_MAPPER, @wfx, Integer(@WaveOutProc), 0{Integer(@FWave)}, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then begin
         goto vuhod1;
      end;
      hBufPlay1 := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufPlayLen);
      hBufPlay2 := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufPlayLen);
      Buf1 := GlobalLock(hBufPlay1); Buf2 := GlobalLock(hBufPlay1);
      wh1.lpData := Buf1; wh1.dwBufferLength := BufPlayLen; wh1.dwUser:=0; wh1.dwFlags := WHDR_DONE;
      wh2.lpData := Buf2; wh2.dwBufferLength := BufPlayLen; wh2.dwUser:=0; wh2.dwFlags := WHDR_DONE;
      address:=@wh1;
      if (WaveOutPrepareHeader(WavHandle, @wh1, SizeOf(TWaveHdr)) <> MMSYSERR_NOERROR) Or
         (WaveOutPrepareHeader(WavHandle, @wh2, SizeOf(TWaveHdr)) <> MMSYSERR_NOERROR) then begin
         goto vuhod2;
      end;
      while  M.Position<M.Size do begin
         FBuffer.Clear;
         FBuffer.CopyFrom(M,Min(BufPlayLen,M.Size-M.Position));
         FBuffer.Seek(0,soFromBeginning);
         yBuffer := FBuffer.Size>0;
         if (wh1.dwUser=0) And yBuffer then begin
            FBuffer.Read(wh1.lpData^, FBuffer.Size);
            yBuffer:=false; wh1.dwUser:=1;
            if WaveOutWrite(WavHandle, @wh1, SizeOf(TWaveHdr)) <> MMSYSERR_NOERROR then begin
               goto vuhod2;
            end;
         end;
         if (wh2.dwUser=0) And yBuffer then begin
            FBuffer.Read(wh2.lpData^, FBuffer.Size);
            yBuffer:=false; wh2.dwUser:=1;
            if WaveOutWrite(WavHandle, @wh2, SizeOf(TWaveHdr)) <> MMSYSERR_NOERROR then begin
               goto vuhod2;
            end;
         end;
         while (wh1.dwUser=1) And (wh2.dwUser=1) And yBuffer do Sleep(1);
      end;
      while (wh1.dwUser=1) And (wh2.dwUser=1) do Sleep(1);
      waveOutReset(WavHandle);
      waveOutUnprepareHeader(WavHandle, @wh1, sizeof(WAVEHDR)); waveOutUnprepareHeader(WavHandle, @wh2, sizeof(WAVEHDR));
      WaveOutClose(WavHandle);
   vuhod2:
      GlobalUnlock(hBufPlay1); GlobalFree(hBufPlay1);
      GlobalUnlock(hBufPlay2); GlobalFree(hBufPlay2);
   vuhod1:
end;

procedure WaveOutProc(hwo: HWAVEOUT; uMsg, dwInstance, dwParam1,dwParam2: DWORD);stdcall;
var temp: pWaveHdr;
begin
  if (uMsg=WOM_DONE) then begin
        if yBuffer then begin
           FBuffer.Read(pWaveHdr(dwParam1)^.lpData^, FBuffer.Size);
           yBuffer:=false;
           if WaveOutWrite(hwo,pWaveHdr(dwParam1),SizeOf(TWaveHdr)) <> MMSYSERR_NOERROR
           then pWaveHdr(dwParam1)^.dwUser:=3;
        end else pWaveHdr(dwParam1)^.dwUser:=0;
  end;
end;

function GetWaveStreamParams(WaveStm: TStream; var WaveInfo:TWaveInfo):boolean;
var FMT, RIFF: Longint;
   i: WORD;
   wh: TWaveHeader;
begin
 Result:=true;
 WaveStm.Seek(0, soFromBeginning);  WaveStm.Read(RIFF, 4);
 WaveStm.Seek(12, soFromBeginning); WaveStm.Read(FMT, 4);
 if (RIFF <> $46464952) Or (FMT <> $20746D66) then  begin
    WaveStm.Seek(0, soFromBeginning);
    WaveInfo.FormatTag := WAVE_FORMAT_UNKNOWN; WaveInfo.DataSize := WaveStm.Size;
    Result:=false; Exit;
 end;
 WaveStm.Seek(20, soFromBeginning); WaveStm.Read(i, 2);
 WaveStm.Seek(0, soFromBeginning);
 case i of
 WAVE_FORMAT_PCM:
      begin     //PCM
        WaveStm.Read(wh, SizeOf(wh));
        WaveInfo.FormatTag     := wh.wtype;
        WaveInfo.Channels      := wh.mono_stereo;
        WaveInfo.SamplesPerSec := wh.sample_rate;
        WaveInfo.AvgBytesPerSec:= wh.byte_sec;
        WaveInfo.BitsPerSample := wh.bits_sample;
        WaveInfo.DataPos       := SizeOf(wh);
        WaveInfo.DataSize      := wh.datasize;
        WaveInfo.AllDataSize   := wh.datasize;
      end;
 else begin
        WaveInfo.FormatTag     := WAVE_FORMAT_UNKNOWN;
        WaveInfo.DataSize      := WaveStm.Size;
        WaveInfo.AllDataSize   := WaveStm.Size;
        Result:=false;
      end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBuffer:=TMemoryStream.Create; yBuffer:=false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FBuffer.Free;
end;

end.