"Советы по Delphi. Версия 1.0.6" - читать интересную книгу автора (Озеров Валентин)

Декомпиляция звукового файла формата 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 lt; kk.yyy[i] then kk.maxo:= kk.yyy[i];

  if kk.mino gt; 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 Nlt;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 Nlt;=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 nlt;=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 Nlt;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 Nlt;=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, K : 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 ChunkNamelt;gt;'RIFF' then OK:= False;

   {Считываем ChunkSize}

   ReadChunkSize;

   RIFFSize:= ChunkSize.lint; {должно быть 18,678}

   {Считываем ChunkName "WAVE"}

   ReadChunkName;

   if ChunkNamelt;gt;'WAVE' then OK:= False;

   {Считываем ChunkName "fmt_"}

   ReadChunkName;

   if ChunkNamelt;gt;'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 lt;gt; 'data' then begin

     for I:= 1 to DataSize do  {пропуск данных, не относящихся к набору звуковых данных}

      Read(InFile, MM);

    end else NoDataYet:= False;

   end;

   nDataBytes:= DataSize;

   {Наконец, начинаем считывать данные для байтов nDataBytes}

   if nDataBytesgt;0 then DataYet:= True;

   N:=0; {чтение с первой позиции}

   while DataYet do begin

    ReadOneDataBlock(Ki,Kj); {получаем 4 байта}

    nDataBytes:= nDataBytes-4;

    if nDataByteslt;=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 Nlt;MaxNumberOfDataBaseItems then begin

  Seek(DataBaseFile, N);

  Read(DataBaseFile, Kk);

 end else InitSignals(Kk);

end; {GetDatabaseItem}

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

begin

 if  Nlt;MaxNumberOfDataBaseItems then if Nlt;=LastDataBaseItem then begin

  Seek(DataBaseFile, N);

  Write(DataBaseFile, Kk);

  LastDataBaseItem:= LastDataBaseItem+1;

 end else while lastdatabaseitemlt;=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 LastDataBaseItemgt;0 then LastDataBaseItem:= LastDataBaseItem-1;

 end;

end; {InitDataBase}

function FindDataBaseName(Nstg: String): LongInt;

var ThisOne : LongInt;

begin

 ThisOne:= 0;

 FindDataBaseName:= –1;

 while ThisOnelt;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}