Советы по Delphi
Декомпилляция звукового файла формата 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 dobeginif 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 ofF0 : (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 dobeginMM := 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 dobegincase nChannels of1:if nBitsPerSample=16then 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;endelse 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=16then begin {2 Двухканальный 16-битный сэмпл}ChunkSize.dn := trunc(Ki.yyy[N]+0.5);ChunkSize.up := trunc(Kj.yyy[N]+0.5);N := N+1;endelse 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 dobegin 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;
beginInitSignals(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 dobeginRead(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 dobeginRead(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 thenbeginReadChunkSize; {получаем 4 байта данных}ChunkSize.x:=M1;with Ki.WAV docase nChannels of1:if nBitsPerSample=16then 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;endelse 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=16then begin {2 Двухканальный 16-битный сэмпл}Ki.yyy[N]:=1.0*ChunkSize.dn;Kj.yyy[N]:=1.0*ChunkSize.up;N := N+1;endelse 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;endelse 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)thenwith Ki.WAV dobegin { Вызов диалога открытия файла }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 dobegin 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 dobegin{Считываем метку блока данных "data"}ReadChunkName;
{Считываем DataSize}ReadChunkSize;DataSize := ChunkSize.lint;
if ChunkName<>'data' thenbeginfor I := 1 to DataSize do {пропуск данных, не относящихся к набору звуковых данных}Read(InFile,MM);endelse NoDataYet := False;end;
nDataBytes := DataSize;{Наконец, начинаем считывать данные для байтов nDataBytes}if nDataBytes>0 then DataYet := True;N:=0; {чтение с первой позиции}while DataYet dobeginReadOneDataBlock(Ki,Kj); {получаем 4 байта}nDataBytes := nDataBytes-4;if nDataBytes<=4 then DataYet := False;end;
ScaleData(Ki);if Ki.WAV.nChannels=2then begin Kj.WAV := Ki.WAV;ScaleData(Kj);end;{Освобождаем буфер файла}CloseFile( InFile );endelse beginInitSpecs;{файл не существует}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<=LastDataBaseItemthen beginSeek(DataBaseFile, N);Read(DataBaseFile, Kk);endelse InitSignals(Kk);end; {GetDatabaseItem}
procedure PutDatabaseItem( Kk : Observation; N : LongInt );
begin
if N<MaxNumberOfDataBaseItemsthenif N<=LastDataBaseItemthen beginSeek(DataBaseFile, N);Write(DataBaseFile, Kk);LastDataBaseItem := LastDataBaseItem+1;endelse while LastDataBaseItem<=N dobeginSeek(DataBaseFile, LastDataBaseItem);Write(DataBaseFile, Kk);LastDataBaseItem := LastDataBaseItem+1;endelse ReportError(1); {Попытка чтения MaxNumberOfDataBaseItems}end; {PutDatabaseItem}
procedure InitDataBase;
begin
LastDataBaseItem := 0;if FileExists(StandardDataBase)thenbeginAssign(DataBaseFile,StandardDataBase);Reset(DataBaseFile);while not EOF(DataBaseFile) dobeginGetDataBaseItem(K0R, LastDataBaseItem);ItemNameS[LastDataBaseItem] := K0R.Name;LastDataBaseItem := LastDataBaseItem+1;end;if EOF(DataBaseFile)then if LastDataBaseItem>0then LastDataBaseItem := LastDataBaseItem-1;end;end; {InitDataBase}
function FindDataBaseName( Nstg : String ):LongInt;
var ThisOne : LongInt;
begin
ThisOne := 0;FindDataBaseName := -1;while ThisOne<LastDataBaseItem dobeginif Nstg=ItemNameS[ThisOne]then beginFindDataBaseName := 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}
[000008]
