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

Previous  Top  Next

    
 

 

 

Интересно, есть ли технология преобразования Wave-формата в обычный набор звуковых данных? К примеру, мне необходимо удалить заголовок и механизм (метод) сжатия, которые могут компилироваться и сохраняться вместе с Wave-файлами.

 

У меня есть программа под D1/D2, которая читает WAV-файлы и вытаскивает исходные данные, но она не может их восстанавить, используя зашитый алгоритм сжатия.

 

Code:

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}

 

 

 

©Drkb::04307

       

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