Delphi World - Декомпилляция звукового файла формата Wave и получение звуковых данных

Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Декомпилляция звукового файла формата Wave и получение звуковых данных
ИМХО - это аббревиатура.
Истинное Мнение Хр#н Оспоришь.
Интересно, есть ли технология преобразования Wave-формата в обычный набор звуковых данных? К примеру, мне необходимо удалить заголовок и механизм (метод) сжатия, которые могут компилироваться и сохраняться вместе с Wave-файлами.
У меня есть программа под D1/D2, которая читает WAV-файлы и вытаскивает исходные данные, но она не может их восстанавить, используя зашитый алгоритм сжатия.
unit LinearSystem;

interface

{============== Тип, описывающий формат WAV ==================}
type
  WAVHeader = record

    nChannels: Word;
    nBitsPerSample: LongInt;
    nSamplesPerSec: LongInt;
    nAvgBytesPerSec: LongInt;
    RIFFSize: LongInt;
    fmtSize: LongInt;
    formatTag: Word;
    nBlockAlign: LongInt;
    DataSize: LongInt;
  end;

  {============== Поток данных сэмпла ========================}
const
  MaxN = 300; { максимальное значение величины сэмпла }
type
  SampleIndex = 0..MaxN + 3;
type
  DataStream = array[SampleIndex] of Real;

var
  N: SampleIndex;

  {============== Переменные сопровождения ======================}
type
  Observation = record

    Name: string[40]; {Имя данного сопровождения}
    yyy: DataStream; {Массив указателей на данные}
    WAV: WAVHeader; {Спецификация WAV для сопровождения}
    Last: SampleIndex; {Последний доступный индекс yyy}
    MinO, MaxO: Real; {Диапазон значений yyy}
  end;

var
  K0R, K1R, K2R, K3R: Observation;

  K0B, K1B, K2B, K3B: Observation;

  {================== Переменные имени файла ===================}
var
  StandardDatabase: string[80];

  BaseFileName: string[80];
  StandardOutput: string[80];
  StandardInput: string[80];

  {=============== Объявления процедур ==================}
procedure ReadWAVFile(var Ki, Kj: Observation);
procedure WriteWAVFile(var Ki, Kj: Observation);
procedure ScaleData(var Kk: Observation);
procedure InitAllSignals;
procedure InitLinearSystem;

implementation
{$R *.DFM}
uses VarGraph, SysUtils;

{================== Стандартный формат WAV-файла ===================}
const
  MaxDataSize: LongInt = (MaxN + 1) * 2 * 2;
const
  MaxRIFFSize: LongInt = (MaxN + 1) * 2 * 2 + 36;
const
  StandardWAV: WAVHeader = (

    nChannels: Word(2);
    nBitsPerSample: LongInt(16);
    nSamplesPerSec: LongInt(8000);
    nAvgBytesPerSec: LongInt(32000);
    RIFFSize: LongInt((MaxN + 1) * 2 * 2 + 36);
    fmtSize: LongInt(16);
    formatTag: Word(1);
    nBlockAlign: LongInt(4);
    DataSize: LongInt((MaxN + 1) * 2 * 2)
    );

  {================== Сканирование переменных сопровождения ===================}

procedure ScaleData(var Kk: Observation);
var
  I: SampleIndex;
begin

  {Инициализация переменных сканирования}
  Kk.MaxO := Kk.yyy[0];
  Kk.MinO := Kk.yyy[0];

  {Сканирование для получения максимального и минимального значения}
  for I := 1 to Kk.Last do
  begin
    if Kk.MaxO < Kk.yyy[I] then
      Kk.MaxO := Kk.yyy[I];
    if Kk.MinO > Kk.yyy[I] then
      Kk.MinO := Kk.yyy[I];
  end;
end; { ScaleData }

procedure ScaleAllData;
begin

  ScaleData(K0R);
  ScaleData(K0B);
  ScaleData(K1R);
  ScaleData(K1B);
  ScaleData(K2R);
  ScaleData(K2B);
  ScaleData(K3R);
  ScaleData(K3B);
end; {ScaleAllData}

{================== Считывание/запись WAV-данных ===================}

var
  InFile, OutFile: file of Byte;

type
  Tag = (F0, T1, M1);
type
  FudgeNum = record

    case X: Tag of
      F0: (chrs: array[0..3] of Byte);
      T1: (lint: LongInt);
      M1: (up, dn: Integer);
  end;
var
  ChunkSize: FudgeNum;

procedure WriteChunkName(Name: string);
var
  i: Integer;

  MM: Byte;
begin

  for i := 1 to 4 do
  begin
    MM := ord(Name[i]);
    write(OutFile, MM);
  end;
end; {WriteChunkName}

procedure WriteChunkSize(LL: Longint);
var
  I: integer;
begin

  ChunkSize.x := T1;
  ChunkSize.lint := LL;
  ChunkSize.x := F0;
  for I := 0 to 3 do
    Write(OutFile, ChunkSize.chrs[I]);
end;

procedure WriteChunkWord(WW: Word);
var
  I: integer;
begin

  ChunkSize.x := T1;
  ChunkSize.up := WW;
  ChunkSize.x := M1;
  for I := 0 to 1 do
    Write(OutFile, ChunkSize.chrs[I]);
end; {WriteChunkWord}

procedure WriteOneDataBlock(var Ki, Kj: Observation);
var
  I: Integer;
begin

  ChunkSize.x := M1;
  with Ki.WAV do
  begin
    case nChannels of
      1: if nBitsPerSample = 16 then
        begin {1..2 Помещаем в буфер одноканальный 16-битный сэмпл}
          ChunkSize.up := trunc(Ki.yyy[N] + 0.5);
          if N < MaxN then
            ChunkSize.dn := trunc(Ki.yyy[N + 1] + 0.5);
          N := N + 2;
        end
        else
        begin {1..4 Помещаем в буфер одноканальный 8-битный сэмпл}
          for I := 0 to 3 do
            ChunkSize.chrs[I]
              := trunc(Ki.yyy[N + I] + 0.5);
          N := N + 4;
        end;
      2: if nBitsPerSample = 16 then
        begin {2 Двухканальный 16-битный сэмпл}
          ChunkSize.dn := trunc(Ki.yyy[N] + 0.5);
          ChunkSize.up := trunc(Kj.yyy[N] + 0.5);
          N := N + 1;
        end
        else
        begin {4 Двухканальный 8-битный сэмпл}
          ChunkSize.chrs[1] := trunc(Ki.yyy[N] + 0.5);
          ChunkSize.chrs[3] := trunc(Ki.yyy[N + 1] + 0.5);
          ChunkSize.chrs[0] := trunc(Kj.yyy[N] + 0.5);
          ChunkSize.chrs[2] := trunc(Kj.yyy[N + 1] + 0.5);
          N := N + 2;
        end;
    end; {with WAV do begin..}
  end; {четырехбайтовая переменная "ChunkSize" теперь заполнена}

  ChunkSize.x := T1;
  WriteChunkSize(ChunkSize.lint); {помещаем 4 байта данных}
end; {WriteOneDataBlock}

procedure WriteWAVFile(var Ki, Kj: Observation);
var
  MM: Byte;

  I: Integer;
  OK: Boolean;
begin

  {Приготовления для записи файла данных}
  AssignFile(OutFile, StandardOutput); { Файл, выбранный в диалоговом окне }
  ReWrite(OutFile);
  with Ki.WAV do
  begin
    DataSize := nChannels * (nBitsPerSample div 8) * (Ki.Last + 1);
    RIFFSize := DataSize + 36;
    fmtSize := 16;
  end;

  {Записываем ChunkName "RIFF"}
  WriteChunkName('RIFF');

  {Записываем ChunkSize}
  WriteChunkSize(Ki.WAV.RIFFSize);

  {Записываем ChunkName "WAVE"}
  WriteChunkName('WAVE');

  {Записываем tag "fmt_"}
  WriteChunkName('fmt ');

  {Записываем ChunkSize}
  Ki.WAV.fmtSize := 16; {должно быть 16-18}
  WriteChunkSize(Ki.WAV.fmtSize);

  {Записываем  formatTag, nChannels}
  WriteChunkWord(Ki.WAV.formatTag);
  WriteChunkWord(Ki.WAV.nChannels);

  {Записываем  nSamplesPerSec}
  WriteChunkSize(Ki.WAV.nSamplesPerSec);

  {Записываем  nAvgBytesPerSec}
  WriteChunkSize(Ki.WAV.nAvgBytesPerSec);

  {Записываем  nBlockAlign, nBitsPerSample}
  WriteChunkWord(Ki.WAV.nBlockAlign);
  WriteChunkWord(Ki.WAV.nBitsPerSample);

  {Записываем метку блока данных "data"}
  WriteChunkName('data');

  {Записываем DataSize}
  WriteChunkSize(Ki.WAV.DataSize);

  N := 0; {первая запись-позиция}
  while N <= Ki.Last do
    WriteOneDataBlock(Ki, Kj); {помещаем 4 байта и увеличиваем счетчик N}

  {Освобождаем буфер файла}
  CloseFile(OutFile);
end; {WriteWAVFile}

procedure InitSpecs;
begin
end; { InitSpecs }

procedure InitSignals(var Kk: Observation);
var
  J: Integer;
begin

  for J := 0 to MaxN do
    Kk.yyy[J] := 0.0;
  Kk.MinO := 0.0;
  Kk.MaxO := 0.0;
  Kk.Last := MaxN;
end; {InitSignals}

procedure InitAllSignals;
begin
  InitSignals(K0R);
  InitSignals(K0B);
  InitSignals(K1R);
  InitSignals(K1B);
  InitSignals(K2R);
  InitSignals(K2B);
  InitSignals(K3R);
  InitSignals(K3B);
end; {InitAllSignals}

var
  ChunkName: string[4];

procedure ReadChunkName;
var
  I: integer;

  MM: Byte;
begin

  ChunkName[0] := chr(4);
  for I := 1 to 4 do
  begin
    Read(InFile, MM);
    ChunkName[I] := chr(MM);
  end;
end; {ReadChunkName}

procedure ReadChunkSize;
var
  I: integer;

  MM: Byte;
begin

  ChunkSize.x := F0;
  ChunkSize.lint := 0;
  for I := 0 to 3 do
  begin
    Read(InFile, MM);
    ChunkSize.chrs[I] := MM;
  end;
  ChunkSize.x := T1;
end; {ReadChunkSize}

procedure ReadOneDataBlock(var Ki, Kj: Observation);
var
  I: Integer;
begin

  if N <= MaxN then
  begin
    ReadChunkSize; {получаем 4 байта данных}
    ChunkSize.x := M1;
    with Ki.WAV do
      case nChannels of
        1: if nBitsPerSample = 16 then
          begin {1..2 Помещаем в буфер одноканальный 16-битный сэмпл}
            Ki.yyy[N] := 1.0 * ChunkSize.up;
            if N < MaxN then
              Ki.yyy[N + 1] := 1.0 * ChunkSize.dn;
            N := N + 2;
          end
          else
          begin {1..4 Помещаем в буфер одноканальный 8-битный сэмпл}
            for I := 0 to 3 do
              Ki.yyy[N + I] := 1.0 * ChunkSize.chrs[I];
            N := N + 4;
          end;
        2: if nBitsPerSample = 16 then
          begin {2 Двухканальный 16-битный сэмпл}
            Ki.yyy[N] := 1.0 * ChunkSize.dn;
            Kj.yyy[N] := 1.0 * ChunkSize.up;
            N := N + 1;
          end
          else
          begin {4 Двухканальный 8-битный сэмпл}
            Ki.yyy[N] := 1.0 * ChunkSize.chrs[1];
            Ki.yyy[N + 1] := 1.0 * ChunkSize.chrs[3];
            Kj.yyy[N] := 1.0 * ChunkSize.chrs[0];
            Kj.yyy[N + 1] := 1.0 * ChunkSize.chrs[2];
            N := N + 2;
          end;
      end;
    if N <= MaxN then
    begin {LastN    := N;}
      Ki.Last := N;
      if Ki.WAV.nChannels = 2 then
        Kj.Last := N;
    end
    else
    begin {LastN    := MaxN;}
      Ki.Last := MaxN;
      if Ki.WAV.nChannels = 2 then
        Kj.Last := MaxN;

    end;
  end;
end; {ReadOneDataBlock}

procedure ReadWAVFile(var Ki, Kj: Observation);
var
  MM: Byte;

  I: Integer;
  OK: Boolean;
  NoDataYet: Boolean;
  DataYet: Boolean;
  nDataBytes: LongInt;
begin

  if FileExists(StandardInput) then
    with Ki.WAV do
    begin { Вызов диалога открытия файла }
      OK := True; {если не изменится где-нибудь ниже}
      {Приготовления для чтения файла данных}
      AssignFile(InFile, StandardInput); { Файл, выбранный в диалоговом окне }
      Reset(InFile);

      {Считываем ChunkName "RIFF"}
      ReadChunkName;
      if ChunkName <> 'RIFF' then
        OK := False;

      {Считываем ChunkSize}
      ReadChunkSize;
      RIFFSize := ChunkSize.lint; {должно быть 18,678}

      {Считываем ChunkName "WAVE"}
      ReadChunkName;
      if ChunkName <> 'WAVE' then
        OK := False;

      {Считываем ChunkName "fmt_"}
      ReadChunkName;
      if ChunkName <> 'fmt ' then
        OK := False;

      {Считываем ChunkSize}
      ReadChunkSize;
      fmtSize := ChunkSize.lint; {должно быть 18}

      {Считываем  formatTag, nChannels}
      ReadChunkSize;
      ChunkSize.x := M1;
      formatTag := ChunkSize.up;
      nChannels := ChunkSize.dn;

      {Считываем  nSamplesPerSec}
      ReadChunkSize;
      nSamplesPerSec := ChunkSize.lint;

      {Считываем  nAvgBytesPerSec}
      ReadChunkSize;
      nAvgBytesPerSec := ChunkSize.lint;

      {Считываем  nBlockAlign}
      ChunkSize.x := F0;
      ChunkSize.lint := 0;
      for I := 0 to 3 do
      begin
        Read(InFile, MM);
        ChunkSize.chrs[I] := MM;
      end;
      ChunkSize.x := M1;
      nBlockAlign := ChunkSize.up;

      {Считываем  nBitsPerSample}
      nBitsPerSample := ChunkSize.dn;
      for I := 17 to fmtSize do
        Read(InFile, MM);

      NoDataYet := True;
      while NoDataYet do
      begin
        {Считываем метку блока данных "data"}
        ReadChunkName;

        {Считываем DataSize}
        ReadChunkSize;
        DataSize := ChunkSize.lint;

        if ChunkName <> 'data' then
        begin
          for I := 1 to DataSize do
            {пропуск данных, не относящихся к набору звуковых данных}
            Read(InFile, MM);
        end
        else
          NoDataYet := False;
      end;

      nDataBytes := DataSize;
      {Наконец, начинаем считывать данные для байтов nDataBytes}
      if nDataBytes > 0 then
        DataYet := True;
      N := 0; {чтение с первой позиции}
      while DataYet do
      begin
        ReadOneDataBlock(Ki, Kj); {получаем 4 байта}
        nDataBytes := nDataBytes - 4;
        if nDataBytes <= 4 then
          DataYet := False;
      end;

      ScaleData(Ki);
      if Ki.WAV.nChannels = 2 then
      begin
        Kj.WAV := Ki.WAV;
        ScaleData(Kj);
      end;
      {Освобождаем буфер файла}
      CloseFile(InFile);
    end
  else
  begin
    InitSpecs; {файл не существует}
    InitSignals(Ki); {обнуляем массив "Ki"}
    InitSignals(Kj); {обнуляем массив "Kj"}
  end;
end; { ReadWAVFile }

{================= Операции с набором данных ====================}

const
  MaxNumberOfDataBaseItems = 360;
type
  SignalDirectoryIndex = 0..MaxNumberOfDataBaseItems;

var
  DataBaseFile: file of Observation;

  LastDataBaseItem: LongInt; {Номер текущего элемента набора данных}
  ItemNameS: array[SignalDirectoryIndex] of string[40];

procedure GetDatabaseItem(Kk: Observation; N: LongInt);
begin

  if N <= LastDataBaseItem then
  begin
    Seek(DataBaseFile, N);
    Read(DataBaseFile, Kk);
  end
  else
    InitSignals(Kk);
end; {GetDatabaseItem}

procedure PutDatabaseItem(Kk: Observation; N: LongInt);
begin

  if N < MaxNumberOfDataBaseItems then
    if N <= LastDataBaseItem then
    begin
      Seek(DataBaseFile, N);
      Write(DataBaseFile, Kk);
      LastDataBaseItem := LastDataBaseItem + 1;
    end
    else
      while LastDataBaseItem <= N do
      begin
        Seek(DataBaseFile, LastDataBaseItem);
        Write(DataBaseFile, Kk);
        LastDataBaseItem := LastDataBaseItem + 1;
      end
  else
    ReportError(1); {Попытка чтения MaxNumberOfDataBaseItems}
end; {PutDatabaseItem}

procedure InitDataBase;
begin

  LastDataBaseItem := 0;
  if FileExists(StandardDataBase) then
  begin
    Assign(DataBaseFile, StandardDataBase);
    Reset(DataBaseFile);
    while not EOF(DataBaseFile) do
    begin
      GetDataBaseItem(K0R, LastDataBaseItem);
      ItemNameS[LastDataBaseItem] := K0R.Name;
      LastDataBaseItem := LastDataBaseItem + 1;
    end;
    if EOF(DataBaseFile) then
      if LastDataBaseItem > 0 then
        LastDataBaseItem := LastDataBaseItem - 1;
  end;
end; {InitDataBase}

function FindDataBaseName(Nstg: string): LongInt;
var
  ThisOne: LongInt;
begin

  ThisOne := 0;
  FindDataBaseName := -1;
  while ThisOne < LastDataBaseItem do
  begin
    if Nstg = ItemNameS[ThisOne] then
    begin
      FindDataBaseName := ThisOne;
      Exit;
    end;
    ThisOne := ThisOne + 1;
  end;
end; {FindDataBaseName}

{======================= Инициализация модуля ========================}

procedure InitLinearSystem;
begin

  BaseFileName := '\PROGRA~1\SIGNAL~1\';
  StandardOutput := BaseFileName + 'K0.wav';
  StandardInput := BaseFileName + 'K0.wav';

  StandardDataBase := BaseFileName + 'Radar.sdb';

  InitAllSignals;
  InitDataBase;
  ReadWAVFile(K0R, K0B);
  ScaleAllData;
end; {InitLinearSystem}

begin {инициализируемый модулем код}

  InitLinearSystem;
end. {Unit LinearSystem}