How to generate a wave file and play it backwards

Problem/Question/Abstract:

How to generate a wave file and play it backwards

Answer:

Here's some code that plays a *.wav file backwards. It shows how *.wav files are generated.


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;

procedure ReversePlay(const szFileName: string);
var
  mmioHandle: HMMIO;
  mmckInfoParent: MMCKInfo;
  mmckInfoSubChunk: MMCKInfo;
  dwFmtSize, dwDataSize: DWORD;
  pFormat: PWAVEFORMATEX;
  wBlockSize: word;
  hpch1, hpch2: PChar;
  waveOutHAndle: Integer;
  data: PChar;
  waveHdr: PWAVEHDR;
begin
  data := nil;
  mmioHandle := mmioOpen(PChar(szFileName), nil, MMIO_READ or MMIO_ALLOCBUF);
  if mmioHandle = 0 then
    raise Exception.Create('Unable to open file ' + szFileName);
  try
    mmckInfoParent.fccType := mmioStringToFOURCC('WAVE', 0);
    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
      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');
      if waveOutOpen(@waveOutHandle, WAVE_MAPPER, pFormat, 0, 0,
        WAVE_FORMAT_QUERY) <> MMSYSERR_NOERROR then
        raise Exception.Create('Can''t 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(@waveOutHandle, WAVE_MAPPER, pFormat, 0, 0,
        CALLBACK_NULL) <> MMSYSERR_NOERROR then
      begin
        waveOutHandle := 0;
        raise Exception.Create('Failed to open output device');
      end;
      wBlockSize := pFormat^.nBlockAlign;
      ReallocMem(pFormat, 0);
      ReallocMem(data, dwDataSize);
      if DWORD(mmioRead(mmioHandle, data, dwDataSize)) <> dwDataSize then
        raise Exception.Create('Unable to read data chunk');
      hpch1 := data;
      hpch2 := data + dwDataSize - 1;
      while hpch1 < hpch2 do
      begin
        Interchange(hpch1, hpch2, wBlockSize);
        Inc(hpch1, wBlockSize);
        Dec(hpch2, wBlockSize)
      end;
      GetMem(waveHdr, sizeof(WAVEHDR));
      waveHdr^.lpData := data;
      waveHdr^.dwBufferLength := dwDataSize;
      waveHdr^.dwFlags := 0;
      waveHdr^.dwLoops := 0;
      waveHdr^.dwUser := 0;
      if waveOutPrepareHeader(WaveOutHandle, WaveHdr,
        sizeof(WAVEHDR)) <> MMSYSERR_NOERROR then
        raise Exception.Create('Unable to prepare header');
      if waveOutWrite(WaveOutHandle, WaveHdr, sizeof(WAVEHDR)) <> MMSYSERR_NOERROR then
        raise Exception.Create('Failed to write to device');
    finally
      ReallocMem(pFormat, 0)
    end;
  finally
    mmioClose(mmioHandle, 0)
  end;
end;