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

Материал из DRKB


Интересно, есть ли технология преобразования 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
  TSampleIndex = 0..MaxN + 3;
  TDataStream = array[TSampleIndex] of Real;

var
  N: SampleIndex;

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

var
  K0R, K1R, K2R, K3R: TObservation;
  K0B, K1B, K2B, K3B: TObservation;

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

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

implementation

{$R *.DFM}

uses VarGraph, SysUtils;

{================== Стандартный формат WAV-файла ===================}
const
  MaxDataSize: LongInt = (MaxN + 1) * 2 * 2;
  MaxRIFFSize: LongInt = (MaxN + 1) * 2 * 2 + 36;
  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: TObservation);
var
  I: TSampleIndex;
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;

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

{================== Считывание/запись WAV-данных ===================}
type
  TTag = (F0, T1, M1);
  TFudgeNum = record
    case X: TTag of
      F0: (chrs: array[0..3] of Byte);
      T1: (lint: LongInt);
      M1: (up, dn: Integer);
  end;

var
  InFile, OutFile: file of Byte;
  ChunkSize: TFudgeNum;

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;

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;

procedure WriteOneDataBlock(var Ki, Kj: TObservation);
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;

procedure WriteWAVFile(var Ki, Kj: TObservation);
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);

  WriteChunkWord(Ki.WAV.formatTag);
  WriteChunkWord(Ki.WAV.nChannels);
  WriteChunkSize(Ki.WAV.nSamplesPerSec);
  WriteChunkSize(Ki.WAV.nAvgBytesPerSec);
  WriteChunkWord(Ki.WAV.nBlockAlign);
  WriteChunkWord(Ki.WAV.nBitsPerSample);

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

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

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

procedure InitSpecs;
begin
end;

procedure InitSignals(var Kk: TObservation);
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;

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

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;

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;

procedure ReadOneDataBlock(var Ki, Kj: TObservation);
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;

procedure ReadWAVFile(var Ki, Kj: TObservation);
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;

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

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

var
  DataBaseFile: file of TObservation;

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

procedure GetDatabaseItem(Kk: TObservation; N: LongInt);
begin
  if N <= LastDataBaseItem then
  begin
    Seek(DataBaseFile, N);
    Read(DataBaseFile, Kk);
  end
  else
    InitSignals(Kk);
end;
procedure PutDatabaseItem(Kk: TObservation; 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;

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;

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;

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

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;

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


Source: http://delphiworld.narod.ru
ID: 04307