Декомпилляция звукового файла формата 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}


Взято с http://delphiworld.narod.ru

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
Проверка
Антиспам проверка
Image CAPTCHA
...