Мир программирования

Найти:

на:

Меню

Партнеры

Счетчики

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

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 ; {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}

[Оглавление]

Опрос

Конкурсы

Web дизайн: Бурлаков Михаил

Web программирование: Бурлаков Михаил

Используются технологии uCoz