[poli-smen]

Сообщение от Dmitry_DM

Нет, я просто спрашиваю то, над чем мучаюсь 2 месяца. И некому помочь. С вами немного разобрался в завале. За что вам и огромное спасибо!

Вот полный исходный код (ошибки возможны - особо не тестировал, но вроде работает):

Код:

type
  EWavError = class(Exception);

  TWaveFormat = packed record
    wFormatTag: Word;
    nChannels: Word;
    nSamplesPerSec: DWORD;
    nAvgBytesPerSec: DWORD;
    nBlockAlign: Word;
    wBitsPerSample: Word;
  end;

  TWavInfo = record
    WaveFormat: TWaveFormat;
    Samples: array of array of Word;
  end;

const
  WAVE_FORMAT_PCM = $0001;

procedure RaiseWavError(const Msg: string);
begin
  raise EWavError.Create(Msg);
end;

procedure ReadWavInfo(const FileName: string; var WavInfo: TWavInfo);
type
  TChunkName = packed array[0..3] of AnsiChar;

  TRiffChunk = packed record
    RiffSign: TChunkName;
    RiffSize: Longword;
    WaveSign: TChunkName;
  end;

  TChunk = packed record
    Name: TChunkName;
    Size: Longword;
  end;

var
  fs: TFileStream;
  RiffChunk: TRiffChunk;
  Chunk: TChunk;
  FmtPos, DataPos, NewPos: Int64;
  DataSize, NumSamples, BytsPerSample, I, J: Longword;

  procedure DecRiffSize(Size: Longword);
  begin
    if RiffChunk.RiffSize < Size then RaiseWavError('Wav-файл повреждён');
    Dec(RiffChunk.RiffSize, Size);
  end;

begin
  Finalize(WavInfo);
  FillChar(WavInfo, SizeOf(WavInfo), 0);

  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
  try
    fs.ReadBuffer(RiffChunk, SizeOf(RiffChunk));
    if (RiffChunk.RiffSign <> 'RIFF') or (RiffChunk.WaveSign <> 'WAVE') then RaiseWavError('Это не wav-файл');

    DecRiffSize(SizeOf(RiffChunk.WaveSign));

    FmtPos := 0;
    DataPos := 0;

    while RiffChunk.RiffSize > 0 do
    begin
      fs.ReadBuffer(Chunk, SizeOf(Chunk));
      DecRiffSize(SizeOf(Chunk));
      DecRiffSize(Chunk.Size);

      if Chunk.Name = 'fmt ' then
      begin
        if FmtPos <> 0 then RaiseWavError('Встретилось несколько секций "fmt"');
        if Chunk.Size < SizeOf(WavInfo.WaveFormat) then RaiseWavError('Неверный размер секции "fmt"');
        FmtPos := fs.Position;
      end else
        if Chunk.Name = 'data' then
        begin
          if DataPos <> 0 then RaiseWavError('Встретилось несколько секций "data"');
          DataPos := fs.Position;
          DataSize := Chunk.Size;
        end;

      NewPos := fs.Position + Chunk.Size;
      fs.Position := NewPos;
      if fs.Position <> NewPos then RaiseWavError('Wav-файл повреждён');
    end;

    if FmtPos = 0 then RaiseWavError('Отсутствует секция "fmt"');

    if DataPos = 0 then RaiseWavError('Отсутствует секция "data"');

    fs.Position := FmtPos;
    fs.ReadBuffer(WavInfo.WaveFormat, SizeOf(WavInfo.WaveFormat));

    if WavInfo.WaveFormat.wFormatTag = WAVE_FORMAT_PCM then
    begin
      if WavInfo.WaveFormat.nChannels = 0 then RaiseWavError('Отсутствуют каналы');
      BytsPerSample := WavInfo.WaveFormat.wBitsPerSample div 8;
      if BytsPerSample = 0 then RaiseWavError('Неверная разрядность сэмплов');
      NumSamples := DataSize div (BytsPerSample * WavInfo.WaveFormat.nChannels);

      SetLength(WavInfo.Samples, NumSamples, WavInfo.WaveFormat.nChannels);
      fs.Position := DataPos;

      for I := 1 to NumSamples do
      begin
        for J := 1 to WavInfo.WaveFormat.nChannels do
        begin
          fs.ReadBuffer(WavInfo.Samples[I - 1, J - 1], BytsPerSample);
        end;
      end;
    end;

  finally
    fs.Free;
  end;
end;

procedure WriteWav(const FileName: string; const WavInfo: TWavInfo);
type
  TChunkID = packed array[0..3] of Char;

  THeader = packed record
    ChunkID: TChunkID;
    ChunkSize: Longword;
    Format: TChunkID;
    Subchunk1ID: TChunkID;
    Subchunk1Size: Longword;
    AudioFormat: Word;
    NumChannels: Word;
    SampleRate: Longword;
    ByteRate: Longword;
    BlockAlign: Word;
    BitsPerSample: Word;
    Subchunk2ID: TChunkID;
    Subchunk2Size: Longword;
  end;

var
  Header: THeader;
  NumSamples, BytsPerSample, Sample, I, J: Longword;
  fs: TFileStream;
begin
  NumSamples := Length(WavInfo.Samples);

  BytsPerSample := WavInfo.WaveFormat.wBitsPerSample div 8;

  Header.ChunkID := 'RIFF';
  Header.Format := 'WAVE';
  Header.Subchunk1ID := 'fmt ';
  Header.Subchunk1Size := 16;
  Header.AudioFormat := WAVE_FORMAT_PCM; // Только PCM
  Header.NumChannels := WavInfo.WaveFormat.nChannels;
  Header.SampleRate := WavInfo.WaveFormat.nSamplesPerSec;
  Header.BitsPerSample := BytsPerSample * 8;
  Header.BlockAlign := Header.NumChannels * BytsPerSample;
  Header.ByteRate := Header.SampleRate * Header.BlockAlign;
  Header.Subchunk2ID := 'data';
  Header.Subchunk2Size := NumSamples * Header.BlockAlign;
  Header.ChunkSize := Header.Subchunk2Size + SizeOf(Header) - 8;

  fs := TFileStream.Create(FileName, fmCreate);
  try
    fs.WriteBuffer(Header, SizeOf(Header));

    for I := 1 to NumSamples do
    begin
      for J := 1 to Header.NumChannels do
      begin
        fs.WriteBuffer(WavInfo.Samples[I - 1, J - 1], BytsPerSample);
      end;
    end;

  finally
    fs.Free;
  end;
end;

procedure TForm1.ButtonClick(Sender: TObject);
var
  WavInfo: TWavInfo;
begin
  if OpenDialog.Execute then
  begin
    ReadWavInfo(OpenDialog.FileName, WavInfo);

    Memo.ScrollBars := ssBoth;
    Memo.WordWrap := False;
    Memo.Clear;
    Memo.Lines.Add('Файл: ' + OpenDialog.FileName);
    Memo.Lines.Add('Формат: $' + IntToHex(WavInfo.WaveFormat.wFormatTag, 4));
    Memo.Lines.Add('Каналов: ' + IntToStr(WavInfo.WaveFormat.nChannels));
    Memo.Lines.Add('Сэмплов: ' + IntToStr(Length(WavInfo.Samples)));
    Memo.Lines.Add('Частота дискретизации: ' + IntToStr(WavInfo.WaveFormat.nSamplesPerSec) + ' сэмплов в секунду');
    Memo.Lines.Add('Разрядность сэмплов: ' + IntToStr(WavInfo.WaveFormat.wBitsPerSample) + ' бит');

    if WavInfo.WaveFormat.wFormatTag = WAVE_FORMAT_PCM then
    begin
      if SaveDialog.Execute then
      begin
        WriteWav(SaveDialog.FileName, WavInfo);
      end;
    end;
  end;
end;