uses dos,crt;
var
f,fs:file of byte;
i,j,start:word;
filedata:array[0..31] of byte;
fn,fnn:string;
const block:word=2048;
      sector:word=9;
      sectorbyte:word=512;
      unusedsector:word=4;


Procedure savefile;
var savefpos:int64;
 tomb:array[0..2047] of byte;
 blkpos:integer;
begin
savefpos:=filepos(f);
assign(fs,fn);
reset(fs,1);
for i:=16 to 31 step 2 do 
begin
blkpos:=filedata[i]+256*filedata[i];
If blkpos>0 then
begin
seek(f,start+block*blkpos);
blockread(f,tomb,2048);
blockwrite(fs,2048);
end;
end;
close(fs);
seek(f,savefpos);
end;

Procedure filedatawriter;
Begin;
Writeln('Image name:',paramstr(1));
Writeln('User nr.:',filedata[0]);
Write('Filename: ');
For i:=1 to 8  do  write(filedata[i],'(',chr(filedata[i]),') ');
writeln;
write('File extension: ');
for i:=9 to 11 do write(filedata[i],'(',chr(filedata[i]),') ');
writeln;
writeln('ex:',filedata[12]);
writeln('s1:',filedata[13]);
writeln('s2:',filedata[14]);
writeln('re:',filedata[15]);
write('Block Nr.:');
for i:=16 to 31 do write(filedata[i],' ');writeln;
end;

        begin
start:=sector*sectorbyte*unusedsector;
if paramstr(1)='' then begin;write('Filename:');readln(fnn);end else fnn:=paramstr(1);
assign(f,fnn);
reset(f,1);
seek(f,start);
For j:= 0 to 127 do
Begin
blockread(f,filedata,32);
fn:='';
If filedata[0] <16 then
begin
 For i:=1 to 8  do  fn:=fn+chr(filedata[i]);
 fn:=fn+'.';
 For i:=9 to 11  do  fn:=fn+chr(filedata[i]);
 write(fn);filedatawriter;input(s);if s='s' then savefile;
end;
end;
close(f);
readln;
end.