Советы по 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 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} [000008]




Начало  Назад  Вперед



Книжный магазин