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.