unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, MMSystem;

const
 WM_FINISHED = WM_USER + $200;

type
 TForm1 = class(TForm)
 Button1: TButton;
 Button2: TButton;
 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 private
 fData: PChar;
 fWaveHdr: PWAVEHDR;
 fWaveOutHandle: HWAVEOUT;

 procedure ReversePlay(const szFileName: string);
 procedure WaveOutProc(hwo: HWAVEOUT; uMsg: UINT; dwParam1,
 dwParam2: DWORD);
 procedure WmFinished(var Msg: TMessage); message WM_FINISHED;

 { Private declarations }
 public
 { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure Interchange(hpchPos1, hpchPos2: PChar; wLength: Word);
var
 wPlace: word;
 bTemp: char;
begin
 for wPlace := 0 to wLength - 1 do
 begin
 bTemp := hpchPos1[wPlace];
 hpchPos1[wPlace] := hpchPos2[wPlace];
 hpchPos2[wPlace] := bTemp
 end
end;

{
 Callback function to be called during waveform-audio playback
 to process messages related to the progress of t he playback.
 }

procedure waveOutPrc(hwo: HWAVEOUT; uMsg: UINT; dwInstance,
 dwParam1, dwParam2: DWORD); stdcall;
begin
 TForm1(dwInstance).WaveOutProc(hwo, uMsg, dwParam1, dwParam2)
end;

procedure TForm1.WaveOutProc(hwo: HWAVEOUT; uMsg: UINT; dwParam1,
 dwParam2: DWORD);
begin
 case uMsg of
 WOM_OPEN: ;
 WOM_CLOSE:
 fWaveOutHandle := 0;
 WOM_DONE:
 PostMessage(Handle, WM_FINISHED, 0, 0);
 end
end;

procedure TForm1.ReversePlay(const szFileName: string);
var
 mmioHandle: HMMIO;
 mmckInfoParent: MMCKInfo;
 mmckInfoSubChunk: MMCKInfo;
 dwFmtSize, dwDataSize: DWORD;
 pFormat: PWAVEFORMATEX;
 wBlockSize: word;
 hpch1, hpch2: PChar;
begin
 { The mmioOpen function opens a file for unbuffered or buffered I/O }
 mmioHandle := mmioOpen(PChar(szFileName), nil, MMIO_READ or MMIO_ALLOCBUF);
 if mmioHandle = 0 then
 raise Exception.Create('Unable to open file ' + szFileName);

 try
 { mmioStringToFOURCC converts a null-terminated string to a four-character code }
 mmckInfoParent.fccType := mmioStringToFOURCC('WAVE', 0);
 { The mmioDescend function descends into a chunk of a RIFF file }
 if mmioDescend(mmioHandle, @mmckinfoParent, nil, MMIO_FINDRIFF) <>
 MMSYSERR_NOERROR then
 raise Exception.Create(szFileName + ' is not a valid wave file');

 mmckinfoSubchunk.ckid := mmioStringToFourCC('fmt ', 0);
 if mmioDescend(mmioHandle, @mmckinfoSubchunk, @mmckinfoParent,
 MMIO_FINDCHUNK) <> MMSYSERR_NOERROR then
 raise Exception.Create(szFileName + ' is not a valid wave file');

 dwFmtSize := mmckinfoSubchunk.cksize;
 GetMem(pFormat, dwFmtSize);

 try
 { The mmioRead function reads a specified number of bytes from a file }
 if DWORD(mmioRead(mmioHandle, PChar(pFormat), dwFmtSize)) <>
 dwFmtSize then
 raise Exception.Create('Error reading wave data');

 if pFormat^.wFormatTag <> WAVE_FORMAT_PCM then
 raise Exception.Create('Invalid wave file format');

 { he waveOutOpen function opens the given waveform-audio output device for playback }
 if waveOutOpen(@fWaveOutHandle, WAVE_MAPPER, pFormat, 0, 0,
 WAVE_FORMAT_QUERY) <> MMSYSERR_NOERROR then
 raise Exception.Create('Cannot play format');

 mmioAscend(mmioHandle, @mmckinfoSubchunk, 0);
 mmckinfoSubchunk.ckid := mmioStringToFourCC('data', 0);
 if mmioDescend(mmioHandle, @mmckinfoSubchunk, @mmckinfoParent,
 MMIO_FINDCHUNK) <> MMSYSERR_NOERROR then
 raise Exception.Create('No data chunk');

 dwDataSize := mmckinfoSubchunk.cksize;
 if dwDataSize = 0 then
 raise Exception.Create('Chunk has no data');

 if waveOutOpen(@fWaveOutHandle, WAVE_MAPPER, pFormat,
 DWORD(@WaveOutPrc), Integer(Self), CALLBACK_FUNCTION) <> MMSYSERR_NOERROR
 then
 begin
 fWaveOutHandle := 0;
 raise Exception.Create('Failed to open output device');
 end;

 wBlockSize := pFormat^.nBlockAlign;

 ReallocMem(pFormat, 0);
 ReallocMem(fData, dwDataSize);

 if DWORD(mmioRead(mmioHandle, fData, dwDataSize)) <> dwDataSize then
 raise Exception.Create('Unable to read data chunk');

 hpch1 := fData;
 hpch2 := fData + dwDataSize - 1;

 while hpch1 < hpch2 do
 begin
 Interchange(hpch1, hpch2, wBlockSize);
 Inc(hpch1, wBlockSize);
 Dec(hpch2, wBlockSize)
 end;

 GetMem(fWaveHdr, SizeOf(WAVEHDR));
 fWaveHdr^.lpData := fData;
 fWaveHdr^.dwBufferLength := dwDataSize;
 fWaveHdr^.dwFlags := 0;
 fWaveHdr^.dwLoops := 0;
 fWaveHdr^.dwUser := 0;

 { The waveOutPrepareHeader function prepares a waveform-audio data block for playback. }
 if waveOutPrepareHeader(fWaveOutHandle, fWaveHdr,
 SizeOf(WAVEHDR)) <> MMSYSERR_NOERROR then
 raise Exception.Create('Unable to prepare header');

 { The waveOutWrite function sends a data block to the given waveform-audio output device.}
 if waveOutWrite(fWaveOutHandle, fWaveHdr, SizeOf(WAVEHDR)) <>
 MMSYSERR_NOERROR then
 raise Exception.Create('Failed to write to device');

 finally
 ReallocMem(pFormat, 0)
 end
 finally
 mmioClose(mmioHandle, 0)
 end
end;

// Play a wave file

procedure TForm1.Button1Click(Sender: TObject);
begin
 Button1.Enabled := False;
 try
 ReversePlay('C:\myWaveFile.wav')
 except
 Button1.Enabled := True;
 raise
 end
end;

// Stop Playback

procedure TForm1.Button2Click(Sender: TObject);
begin
 { The waveOutReset function stops playback on the given waveform-audio output device }
 WaveOutReset(fWaveOutHandle);
end;

procedure TForm1.WmFinished(var Msg: TMessage);
begin
 WaveOutUnprepareHeader(fWaveOutHandle, fWaveHdr, SizeOf(WAVEHDR));
 WaveOutClose(fWaveOutHandle);
 ReallocMem(fData, 0);
 ReallocMem(fWaveHdr, 0);
 Button1.Enabled := True;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 WaveOutReset(fWaveOutHandle);
 while fWaveOutHandle <> 0 do
 Application.ProcessMessages
end;

end.