Обработка данных типизированных файлов

program Nast2;{$R+} uses crt;
Type
    SH1=array[1..4] of string [56];
    STR=Record
              Nazv:string[12];
              Stran:string[11];
              Money:real;
              Vrema:real;
              Trans:string[9];
              end;
FL=file of STR;
St1=string[40];
var
Z:STR;
s1,s2:longint;
 
i,j:byte;
Fr,Fi:text;
b:char;
F:FL;
const
C:SH1=
('ЪДДДДДДДДДДДДДДДВДДДДДДДДДДДДДДДДВДДДДДДДДДДДВДДДДДДДДВДДДДДДДДДДДї',
 'і  Nazvanie     і  Strana        іMoney      іVrema   іTransport  і',
 'ГДДДДДДДДДДДДДДДЕДДДДДДДДДДДДДДДДЕДДДДДДДДДДДЕДДДДДДДДЕДДДДДДДДДДДґ',
 'АДДДДДДДДДДДДДДДБДДДДДДДДДДДДДДДДБДДДДДДДДДДДБДДДДДДДДБДДДДДДДДДДДЩ');
 {-------udalenie probelov----}
 Function FILTR(str:string):string;
 var i,j,l:integer;
 begin
 l:=length (str);
 for i:=1 to l do
 if str[i]<>''then for j:=l downto i do
 if str[j]<>''then
 begin Filtr:=Copy(str,i,j-i+1);
 exit;
 end;
 Filtr:='';
 End;
 {-------vivod odnastr---}
 procedure odnastr;
 begin
 with z do writeln (#179,'':3,Nazv,'':11-length(Nazv),
                       #179,'':4,Stran,'':7-length(Stran),
                       #179,'':3,Money:6:0,#179,Vrema:6:0,
                       #179,'':3,Trans,#179);
 end;
 {--------zapis dannuh v file-----}
 procedure ZDF(nf:st1);
 var FID :text;
 B:char;
 begin
 assign(Fid,nf);
 reset(FID);
 with z do
 while not seekeof(FID) do begin
 readln(FID,Nazv,B,Stran,Money,Vrema,Trans);
 Nazv:=Filtr(Nazv);
 odnastr;
 write(F,z);
 end;
 writeln(Fr,C[4]);
 close(FID);
 end;
 Procedure Chten;
 forward;
 {----sozdanie tip file----}
 procedure soz;
 begin
 writeln(Fr,'Sozdanie file');
 rewrite(F);
 ZDF('Nast2SOZ.DAT');
 close(F);
 write(FR,#10#13,'posle sozdaniya file:');
 Chten;
 end;
 {-------dop tip file----}
 procedure DOP;
 begin
 writeln(FR,'dopolnenie file');
 reset(F);
 seek(F,FILESIZE(F));
 ZDF('NAST2DOP.DAT');
 CLOSE(F);
 write(FR,#10#13,'posle dopolneniya file:');
 Chten;
 end;
 {-----------modifikaciya dannuh tip file---}
 procedure KOR;
 label mk;
 var
 tNazv:string[8];
 nVrema:real;
 begin
 writeln(Fr,#10#13,'modifikaciya file');
 assign(FI,'NAST2KOR.DAT');
 Reset(FI);
 Reset(F);
 Repeat
 readln(FI,tNazv,nVrema);
 tNazv:=FILTR(tNazv);
 writeln(FR,'Nasvanie and novoe vrema:');
 writeln(FR,'''',tNazv,'''','nVrema= ',nVrema:7:2);
 if tNazv= '' then begin
 writeln(FR,'net nazvaniya dlya modifikacii'); continue
 end;
 {nachalo poiska}
 seek(F,0);
 repeat
 read(F,Z);
 if tNazv=Z.Nazv then
 begin
 odnastr;
 Z.Vrema:=nVrema;odnastr;
 seek (F,FILEPOS(F)-1);
 write(F,z);
 goto mk
 end;
 until eof(F);
 writeln(FR,'nazvanie oshibka');
 mk:until (eof(FI));
 close(fi);
 close(F);
 write(FR,#10#13,'posle modifikacii file: ');
 Chten;
 end;
 {---chtenie zapisei iz tip file-----}
 procedure Chten;
 var n:integer;
 s:real;
 begin writeln(Fr,'chtenie filke');reset(F);
 N:=0;s:=0;
  repeat read(F,Z); odnastr;
  s:=s+z.Vrema;
  n:=n+1;
  UNTIL EOF(F);
  Close(F);
  writeln(FR,C[4]);
  writeln(FR,'s=',s:8:2,'n=',n);
  end;
  {---udalenie--}
  procedure udmet;
  label mku;var tNazv:st1;F2:FL;PR:boolean;
  begin
  assign(FI,'Nast2UD.DAT');reset(FI);
  assign(F2,'RAB.UD');reset(F);
  writeln('udalenie zapiseu s pometkoi udalennuh,',#10#13,
  'i perenovaniem file');
  pr:=false;
  repeat
  readln(FI,tNazv);
  tNazv:=FILTR(tnazv);
  writeln('udalenie zapisi po nazvaniu: ','''',tNazv,'''');
  if tNazv='' then begin writeln('net nazvaniya dlya udaleniya');
  continue
  end;
  seek(f,0);repeat
  read(F,Z);
  if tNazv=Z.Nazv then begin
  writeln('udalyaem zapis:');
  odnastr;
  Z.Nazv:='';PR:=true;
  seek(F,FILEPOS(F)-1);
  write(F,Z);
  goto mku;end;
  until eof(F);
  writeln('Nazvanie oshibka');
  mku:until eof(FI);
  close(F);close(FI);
  writeln(C[4]);
  if not PR then begin writeln ('net udalyaemuh zapisei');
  exit;
  end;
  reset(F);rewrite(F2);
  repeat
  read(F,Z);
  if Z.Nazv <> '' then write(F2,Z);
  until eof(F);
  close(F);close(F2);
  Erase(F);
  Rename(F2,'FNast2.TYP');
  writeln('posle udaleniya s pometkami i pereminovaniem file:');
  Chten;
  end;
  {---osnovnaya programma---}
  begin clrscr;
  assign(F,'Nast2.TYP');
  assign(fi,'Nast.DAT');
  assign(FR,'Nast2.rez');
  Rewrite(FR);
  for j:=1 to 4 do writeln(Fr,C[j]);
  soz;
  dop;
  chten;
  kor;
  udmet;
  close(FR);
  end.