{$M 2048,0,68096}
Uses Objects, Strings, WinDos, Crt;
Const
AppTxt: Array[0..63]Of Char = '<APP BYTES>';
Var
s, s2: Array[0..63]Of Char;
Buf: Array[0..16383]Of Char;
Bread: Word;
f, t: TBufStream;
Count: Word;
a, b: Word;
Size2, Size3, Total, Size, Posi: LongInt;
Ratio2, Ratio3, Ratio: Real;
Best2, Best3, Signa: Word;
C10: Word; C10A, C10B: Real;
C11: Word; C11A, C11B: Real;
Var
wFormatTag,
nChannels: Word;
nSamplesPerSec,
nAvgBytesPerSec: LongInt;
nBlockAlign,
Bits: Word;
Begin
f.Init('e:\pelit\sc3\star001.voc', stOpenRead, $FE00);
f.Read(Count, 2);
WriteLn('Voice clip count: ', Count);
Total := 0;
Ratio2 := 0;
Ratio3 := 100;
For a := 2900 To Count-1 Do
Begin
f.Seek(2 + a*4);
f.Read(Posi, 4);
f.Read(Size2, 4);
If Posi = 0 Then Continue;
{
Repeat f.Read(Size2, 4)Until Size2 <> 0;
Dec(Size2, Posi);
}
If Size2>0 Then Dec(Size2, Posi);
If(Size2 < 30000)Or(a >= 3000)Then
Begin
f.Seek(Posi);
f.Read(Signa, 2);
f.Read(Size, 4)
End
Else
Size := Size2;
If KeyPressed Then Break;
Write(a:4,': ',Size:5,' bytes'#13);
{If(Size >= 30000)And(Signa <> 0)Then Continue;}
If a < 3000 Then
Begin
f.Seek(Posi);
f.Read(Signa, 2);
f.Read(Size, 4)
End;
Str(a+1:4, s2);
strcpy(s, 'd:\sc3_wav\sc3_');
For b := 0 To 3 Do If s2[b]=' ' Then s2[b] := '0';
strcat(s, s2);
If Signa=32 Then strcat(s, '.wac')
Else If Signa= 0 Then strcat(s, '.wav')
Else
strcat(s, '.___');
Inc(Total, Size);
TextAttr := 15;
Write(s,': ');
t.Init(s, stOpenRead, 512);
If(t.Status = stOk)And(t.GetSize = Size)Then
Begin
t.Done;
Continue
End;
t.Done;
t.Init(s, stCreate, 512);
t.Done;
t.Init(s, stOpen, 2048);
t.Seek(0);
Size2 := Size;
Write(#8#8' Size:',Size:7);
C10 := 0;
C11 := 0;
Repeat
BRead := SizeOf(Buf);
If BRead > Size Then BRead := Size;
f.Read(Buf, BRead);
For b := 0 To BRead-1 Do
Begin
If Buf[b] = '' Then Inc(C10);
If Buf[b] = '' Then Inc(C11)
End;
t.Write(Buf, BRead);
Dec(Size, BRead)
Until Size <= 0;
t.CopyFrom(f, Size);
Size3 := t.GetPos;
{
t.Write(AppTxt, strlen(AppTxt));
t.CopyFrom(f, Size2 - Size - 6);}
WriteLn(' Free: ',DiskFree(Ord(UpCase(s[0]))-Ord('A')+1));
TextAttr := 7;
If(Signa = 32)Or(Signa=0)Then
Begin
t.Seek(20); {'RIFF', size, 'WAVE', 'fmt ', size}
t.Read(wFormatTag, 2);
t.Read(nChannels, 2);
t.Read(nSamplesPerSec, 4);
t.Read(nAvgBytesPerSec,4);
t.Read(nBlockAlign, 2);
t.Read(Bits, 2);
t.Read(Size, 4); {'data'}
Size2 := Size3;
t.Read(Size, 4);
TextAttr := 3; Write(' FORMAT ');
TextAttr := 9; Write(wFormatTag);
TextAttr := 3; Write(': ');
TextAttr := 9;
If nChannels=1 Then Write('MONO')
Else If nChannels=2 Then Write('STEREO')
Else Write('Chans: ',nChannels);
TextAttr := 9; Write(' ',nSamplesPerSec/1000:0:2,' kHz ',Bits);
TextAttr := 3; WriteLn(' bits');
TextAttr := 3; Write(' Size: ');
TextAttr := 9; Write(Size:6);
TextAttr := 3; Write(' File: ');
TextAttr := 9; Write(Size2:6);
TextAttr := 3; Write(' Ratio: ');
Ratio := Size2*100/Size;
TextAttr := 9; Write(Ratio:0:1);
If Ratio > Ratio2 Then Begin Ratio2 := Ratio; Best2 := a; C10A := C10*100.0/Size; C11A := C11*100.0/Size End;
If Ratio < Ratio3 Then Begin Ratio3 := Ratio; Best3 := a; C10B := C10*100.0/Size; C11B := C11*100.0/Size End;
TextAttr := 3; WriteLn('% of original');
If Signa=0 Then WriteLn('*** NOT COMPRESSED, NOTE!')
End;
t.Done
End;
TextAttr := 7;
WriteLn('LEAST COMPRESSED ITEM WAS NUMBER',Best2:5,' (',Ratio2:0:1,'% OF ORIGINAL, :',C10A:0:4,'%, :',C11A:0:4,'%)');
WriteLn(' MOST COMPRESSED ITEM WAS NUMBER',Best3:5,' (',Ratio3:0:1,'% OF ORIGINAL, :',C10B:0:4,'%, :',C11B:0:4,'%)');
f.Done
End.
Author
Logged
