Обработка через VAL полей ввода, зациклить ввод полей в файл

Type programma=record {Zapis, sootvetstvuyushaya programme}
        Gorod:string; {Nazvanie Goroda}
    Dlitelnost:STRING; {Dlitelnost marshruta}
    vidtran:string; {Vid transporta}
        mes,den:STRING; {Mes i den nachala}
    stoimost:STRING; {Stoimost poezdki}
end;

Program TuristicheskieMarshruti;
Uses Crt;
Type programma=record {Zapis, sootvetstvuyushaya programme}
        Gorod:string; {Nazvanie Goroda}
    Dlitelnost:integer; {Dlitelnost marshruta}
    vidtran:string; {Vid transporta}
        mes,den:integer; {Mes i den nachala}
    stoimost:integer; {Stoimost poezdki}
end;
    fail=file of programma;
 
Const
     NORM=14; { cvet nevydelennogo punkta }
     SEL=32;  { cvet vydelennogo punkta }
     N=14;
Var
     menu:array[1..N] of string[16]; { nazvaniya punktov menu }
     punkt:integer;  { nomer vydelennogo punkta }
     ch:char;        { vvedenniy simvol }
     x,y:integer;    { koordinaty pervoy stroki menu }
     b:boolean;
 
{---Procedura sozdaniya faila---}
 
Procedure CreateFile(var f:fail);
var prog:programma;
k:longint;
begin
clrscr;
rewrite(f); {Otkrytie faila dlya chteniya}
writeln('            Vvedite svedeniya o turisticheskih marshrutah <Enter>');
writeln('              Dlya nachala vvoda dannyh nazhimayte lubuyu klavishu');
writeln('                          Dlya vyhoda nazmite <Esc>');
if readkey=#27 then exit;
repeat
    with prog do
                begin
write(' Gorod:  '); readln(gorod);
write(' Dlitelnost (Ne bolee 30):  '); readln(dlitelnost);
if (dlitelnost < 1) or (dlitelnost > 30) then writeln('Oshibka vvoda, poprobuite snova') else begin
                   write(' Vid tranporta:  '); readln(vidtran);
                    write(' Mesiac (Ot 1 to 12):  '); readln(mes);
                     if (mes < 1) or (mes > 12) then writeln('Oshibka vvoda, poprobuite snova') else begin
                      write(' Den (Ot 1 to 31):  '); readln(den);
                        if ((mes = 1) or (mes = 3) or (mes = 5) or (mes = 7) or (mes = 8) or (mes = 10) or (mes = 12)) and ((den >= 1) and (den <=31 )) then begin
                                                                           write(' Stoimost(Ne bolee 32767): '); readln(stoimost); end;
                                                                           if ((mes = 2)) and ((den >=1)and(den <= 28)) then begin write(' Stoimost(Ne bolee 32767): '); readln(stoimost);
                                                                           if ((mes = 4) or (mes = 6) or (mes = 9) or (mes = 11))and ((den >= 1) and (den <= 30)) then begin write('Stoimost(Ne bolee 32767)'); readln(stoimost);end;
                                                                         end;
                                                                         end;
                                                                         end;
                                                                         end;
   write(f,prog);
until readkey=#27;
close(f);
readln;
end;
{---Procedurka proverki nado sozdavat fail ili net---}
 
procedure Check(var f:fail);
var m:char;
begin
clrscr;
writeln('                    Do you really want to rewrite file?');
writeln('             Press "Y" to rewrite file or any other key to exit');
m:=readkey;
case m of
'y':CreateFile(f);
end;
end;
 
{Procedura optkritia faila}
procedure OpenFile(var f:fail;var b:boolean);
begin
    b:=true;
    {$I-} reset(f); {$I+}
    if IOResult<>0 then
        begin
        b:=false;
        writeln('     File eshe ne sozdan. Vernites v menu programmy');
      readln;
        CreateFile(f);
        end;
end;
 
{---Procedura prosmotra faila---}
procedure ReadFile(var f:fail);
var prog:programma;
sh:longint;
p:char;
begin
    clrscr;
        sh:=0;
    OpenFile(f,b);
    writeln('                            Full list of the turmarshruti');
        writeln('                       Press <Esc> to exit to the main menu');
        writeln('                       Press "P" dla ocherednogo vivoda');
    writeln;
        while not eof(f) do
        begin
            read(f,prog);
                        sh:=sh+1;
                        with prog do
            begin   writeln('__________Zapis Nomer: ',sh,'__________');
                    writeln('Nazvanie goroda: ',gorod);
                    writeln('Dlitelnost: ',dlitelnost);
                    writeln('Vid transporta: ',vidtran);
                    writeln('Mesiac: ',mes);
                    writeln('Den: ',den);
                                writeln('Stoimost: ',stoimost);
                                writeln();
                                p:=readkey;
                                case p of       #27:exit;   end;
                end;
        end;
if readkey=#27 then exit;
close(f);
end;
 
{---Procedura izmenenia zapisi---}
 
procedure Zamena(var f:fail);
var n:integer;
    prog:programma;
begin
clrscr;
OpenFile(f,b);
write(' Vibirite nomer zapisi dla izmenenia. n= ');
readln(n);
if(n<1)or(filesize(f)<n) then
 begin
  writeln(' The file does not contain record with this number!');
  readln;
  exit;
 end;
writeln(' Vvedite novye svedenia o turisticheskih marshrutah:');
with prog do
begin
write(' Gorod:  '); readln(gorod);
write(' Dlitelnost (Ne bolee 30):  '); readln(dlitelnost);
if (dlitelnost < 1) or (dlitelnost > 30) then writeln('Oshibka vvoda, vernites v menu i poprobuite snova') else begin
                   write(' Vid tranporta:  '); readln(vidtran);
                   write(' Mesiac (Ot 1 to 12):  '); readln(mes);
                   if (mes < 1) or (mes > 12) then writeln('Oshibka vvoda, vernites v menu i poprobuite snova') else begin
                   write(' Den (Ot 1 to 31):  '); readln(den);
                   if ((mes = 1) or (mes = 3) or (mes = 5) or (mes = 7) or (mes = 8) or (mes = 10) or (mes = 12)) and ((den >= 1) and (den <=31 )) then begin
                                                                           write(' Stoimost: '); readln(stoimost); end
                                                                           else  begin
                                                                           writeln('Oshibka vvoda, vernites v menu i poprobuite snova');
                   if ((mes = 2)) and ((den >=1)and(den <= 28)) then begin write(' Stoimost: '); readln(stoimost); end  else
                                                                           writeln('Oshibka vvoda, vernites v menu i poprobuite snova');
                   if ((mes = 4) or (mes = 6) or (mes = 9) or (mes = 11))and ((den >= 1) and (den <= 30)) then begin write(' Stoimost: '); readln(stoimost);
                                                                         end;
                                                                         end;
                                                                         end;
                                                                         end;
   end;
seek(f,n-1);
write(f,prog);
close(f);
if readkey=#27 then exit;
readln;
end;
 
{---Procedura dobavleniya zapisi v fail---}
 
procedure Add(var f:fail);
var prog:programma;
begin
clrscr;
OpenFile(f,b);
writeln(' Vvedite svedeniya o dobavlyaemom turisticheskom marhrute:');
writeln;
with prog do
  begin
write(' Gorod:  '); readln(gorod);
write(' Dlitelnost (Ne bolee 30):  '); readln(dlitelnost);
if (dlitelnost < 1) or (dlitelnost > 30) then writeln('Oshibka vvoda, vernites v menu i poprobuite snova') else begin
                   write(' Vid tranporta:  '); readln(vidtran);
                   write(' Mesiac (Ot 1 to 12):  '); readln(mes);
                   if (mes < 1) or (mes > 12) then writeln('Oshibka vvoda, vernites v menu i poprobuite snova') else begin
                   write(' Den (Ot 1 to 31):  '); readln(den);
                   if ((mes = 1) or (mes = 3) or (mes = 5) or (mes = 7) or (mes = 8) or (mes = 10) or (mes = 12)) and ((den >= 1) and (den <=31 )) then begin
                                                                           write(' Stoimost: '); readln(stoimost); end
                                                                           else  begin
                                                                           writeln('Oshibka vvoda, vernites v menu i poprobuite snova');
                   if ((mes = 2)) and ((den >=1)and(den <= 28)) then begin write(' Stoimost: '); readln(stoimost); end  else
                                                                           writeln('Oshibka vvoda, vernites v menu i poprobuite snova');
                   if ((mes = 4) or (mes = 6) or (mes = 9) or (mes = 11))and ((den >= 1) and (den <= 30)) then begin write(' Stoimost: '); readln(stoimost);
                                                                         end;
                                                                         end;
                                                                         end;
                                                                         end;
   end;
seek(f,filesize(f));
write(f,prog);
close(f);
if readkey=#27 then exit;
readln;
end;
 
{Procedura udalenia zapisi is faila}
procedure Del_N(var f:fail); {Udalenie zapisi po nomeru}
var n,i,code:integer;
    c:char;
    st:string;
    prog:programma;
begin
clrscr;
write(' Vvedite nomer zapisi kotoruu hotite udalit. n=');
repeat
readln(st); {Vvodim nomer zapisi}
val(st,n,code);
until (code=0) and (n<=32767) and (n>0);
reset(f);
if (filesize(f)<n)or(n<0) then
 begin
  writeln(' Zapisi s takim nomerom v faile ne sushestvuet');
  close(f);
  write(' Press <Enter> to exit to the Global menu');
  readln;
  exit;
 end;
if n=filesize(f)then {Esli zapis poslednyaa}
 begin
  seek(f,filesize(f)-1);
  truncate(f);
  close(f);
  write(' Zapis bila udalena. Press <Enter> to exit to the Global menu');
  readln;
  exit;
 end;
seek(f,n-1); {esli ne poslednyaa}
for i:=n-1 to filesize(f)-2 do
 begin
  seek(f,i+1);
  read(f,prog);
  seek(f,i);
  write(f,prog);
 end;
seek(f,filesize(f)-1);
truncate(f);
close(f);
write(' The record was succesfully deleted. Press <Enter> to exit to the main menu');
readln
end;
 
{---Procedura sortirovki polia Gorod---}
procedure SortGor(var f:fail);
var st,a,b,prog:programma;
I,j:longint;
begin
clrscr;
writeln(' Sortirovka po polu gorod ');
reset(f);
for i:=0 to filesize(f)-2 do
for j:=i+1 to filesize(f)-1 do
  begin
    seek(f,i);
    read(f,a);
    seek(f,j);
    read(f,b);
    if a.gorod>b.gorod then
      begin
       st:=a;
       a:=b;
       b:=st;
       seek(f,i);
       write(f,a);
       seek(f,j);
       write(f,st);
      end;
   end;
close(f);
if readkey=#27 then exit;
readln;
end;
 
{---Procedura sortirovki polia Dlitelnost---}
procedure SortDlit(var f:fail);
var st,a,b,prog:programma;
I,j:longint;
begin
clrscr;
writeln(' Sortirovka po polu DLITELNOST ');
reset(f);
for i:=0 to filesize(f)-2 do
for j:=i+1 to filesize(f)-1 do
  begin
    seek(f,i);
    read(f,a);
    seek(f,j);
    read(f,b);
    if a.dlitelnost < b.dlitelnost then
      begin
       st:=a;
       a:=b;
       b:=st;
       seek(f,i);
       write(f,a);
       seek(f,j);
       write(f,st);
      end;
   end;
close(f);
if readkey=#27 then exit;
readln;
end;
 
{---Procedura sortirovki polia vid transporta---}
procedure SortVidTran(var f:fail);
var st,a,b,prog:programma;
I,j:longint;
begin
clrscr;
writeln(' Sortirovka po polu VID TRANSPORTA ');
reset(f);
for i:=0 to filesize(f)-2 do
for j:=i+1 to filesize(f)-1 do
  begin
    seek(f,i);
    read(f,a);
    seek(f,j);
    read(f,b);
    if a.vidtran > b.vidtran then
      begin
       st:=a;
       a:=b;
       b:=st;
       seek(f,i);
       write(f,a);
       seek(f,j);
       write(f,st);
      end;
   end;
close(f);
if readkey=#27 then exit;
readln;
end;
 
{---Procedura sortirovki polia mesiac---}
procedure SortMes(var f:fail);
var st,a,b,prog:programma;
I,j:longint;
begin
clrscr;
writeln(' Sortirovka po polu MESIAC ');
reset(f);
for i:=0 to filesize(f)-2 do
for j:=i+1 to filesize(f)-1 do
  begin
    seek(f,i);
    read(f,a);
    seek(f,j);
    read(f,b);
    if a.mes < b.mes then
      begin
       st:=a;
       a:=b;
       b:=st;
       seek(f,i);
       write(f,a);
       seek(f,j);
       write(f,st);
      end;
   end;
close(f);
if readkey=#27 then exit;
readln;
end;
 
{---Procedura sortirovki polia den---}
procedure SortDen(var f:fail);
var st,a,b,prog:programma;
I,j:longint;
begin
clrscr;
writeln(' Sortirovka po polu DEN ');
reset(f);
for i:=0 to filesize(f)-2 do
for j:=i+1 to filesize(f)-1 do
  begin
    seek(f,i);
    read(f,a);
    seek(f,j);
    read(f,b);
    if a.den < b.den then
      begin
       st:=a;
       a:=b;
       b:=st;
       seek(f,i);
       write(f,a);
       seek(f,j);
       write(f,st);
      end;
   end;
close(f);
if readkey=#27 then exit;
readln;
end;
 
{---Procedura sortirovki polia stoimost---}
procedure SortStoimost(var f:fail);
var st,a,b,prog:programma;
I,j:longint;
begin
clrscr;
writeln(' Sortirovka po polu STOIMOST ');
reset(f);
for i:=0 to filesize(f)-2 do
for j:=i+1 to filesize(f)-1 do
  begin
    seek(f,i);
    read(f,a);
    seek(f,j);
    read(f,b);
    if a.stoimost < b.stoimost then
      begin
       st:=a;
       a:=b;
       b:=st;
       seek(f,i);
       write(f,a);
       seek(f,j);
       write(f,st);
      end;
   end;
close(f);
if readkey=#27 then exit;
readln;
end;
 
{--Vivod marshrutov ne vishe zadannoy stoimosti--}
procedure marnevstzad(var f:fail);
var k,ukstoim:integer;
prog:programma;
begin
clrscr;
OpenFile(f,b);
writeln('Vvedite trebuemuu stoimost: ');
read(ukstoim);
writeln('Vse Marshruti ne vishe zadannoi stoimosty');
writeln();
writeln('Dlia vihoda najmite "esc"');
writeln('__________________________________________');
k:=0;
while not eof(f) do begin
read(f,prog);
with prog do begin
if stoimost < ukstoim then begin k:=k+1;
                                 writeln('Gorod: ',gorod);
                                 writeln('Dlitelnost: ',dlitelnost);
                                 writeln('vidtransporta: ',vidtran);
                                 writeln('Den: ',den);
                                 writeln('Mesiac: ',mes);
                                 writeln('Stoimost:',stoimost);
                                 writeln('________________________________________________');
                           end;
                           end;
end;
if k = 0 then begin writeln('Takih marshrutov net');  writeln('__________________________________________');  end;
if readkey=#27 then exit;
readln;
end;
 
{--Vivod marshrutov s dlitelnostiu ne nige zadannoi--}
procedure mardlit(var f:fail);
var k,ukdlit:integer;
prog:programma;
begin
clrscr;
OpenFile(f,b);
writeln('Vvedite trebuemuu dlitelnost: ');
read(ukdlit);
writeln('Vse Marshruti ne nige zadannoi dlitelnosti');
writeln();
writeln('Dlia vihoda najmite "esc"');
writeln('__________________________________________');
k:=0;
while not eof(f) do begin
read(f,prog);
with prog do begin
if dlitelnost > ukdlit then begin k:=k+1;
                                 writeln('Gorod: ',gorod);
                                 writeln('Dlitelnost: ',dlitelnost);
                                 writeln('vidtransporta: ',vidtran);
                                 writeln('Den: ',den);
                                 writeln('Mesiac: ',mes);
                                 writeln('Stoimost:',stoimost);
                                 writeln('________________________________________________');
                           end;
                           end;
end;
if k = 0 then begin writeln('Takih marshrutov net'); writeln('__________________________________________'); end;
if readkey=#27 then exit;
readln;
end;
 
{---Procedura menu--}
Procedure MenuToScr; { Vyvod menu na ekran }
var i:integer;
begin
     ClrScr;
     for i:=1 to N do begin
          GoToXY(x,y+i-1);
          write(menu[i]);
     end;
     TextAttr:=SEL;
     GoToXY(x,y+punkt-1);
     write(menu[punkt]); { Vydelenie stroki menu }
     TextAttr:=NORM;
end;
 
{ Telo programmy }
Var f:fail;
Begin
clrscr;
assign(f,'fail.dat'); {Svyazyvanie peremennoy s imenem faila}
     menu[1]:=' Create new file ';
     menu[2]:=' Watch file ';
     menu[3]:=' Uslovie #1 '; {Vse marshruti so stoimostiu ne vishe zadannoy}
     menu[4]:=' Uslovie #2 '; {Vse marshruti c dlitelnostiu ne nije zadannoy}
     menu[5]:=' Redaktirovanie ';
     menu[6]:=' Dobavit zapis ';
     menu[7]:=' Udalenie zapisi ';
     menu[8]:=' Sort Gooroda ';
     menu[9]:=' Sort Dlitelnosti ';
     menu[10]:=' Sort Vidtransporta ';
     menu[11]:=' Sort Mesiac ';
     menu[12]:=' Sort Den ';
     menu[13]:=' Sort Stoimost ';
     menu[14]:=' Exit ';
     punkt:=1;
     x:=15;
     y:=15; TextAttr:=NORM;
     MenuToScr;
     repeat
          ch:=ReadKey;
          if ch=char(0) then begin
               ch:=ReadKey;
               case ch of
                    chr(80): { strelka vniz }
                         if punkt<N then begin
                              GoToXY(x,y+punkt-1);
                              write(menu[punkt]);
                              punkt:=punkt+1;
                              TextAttr:=SEl;
                              GoToXY(x,y+punkt-1);
                              write(menu[punkt]);
                              TextAttr:=NORM;
                         end;
                    chr(72): { strelka vverh }
                         if punkt>1 then begin
                              GoToXY(x,y+punkt-1);
                              write(menu[punkt]);
                              punkt:=punkt-1;
                              TextAttr:=SEl;
                              GoToXY(x,y+punkt-1);
                              write(menu[punkt]);
                              TextAttr:=NORM;
                         end;
                 end;
              end
          else
               if ch=chr(13) then begin { nazhata klavisha <Enter> }
                    case punkt of
                         1:Check(f);
                         2:ReadFile(f);
                         3:marnevstzad(f);
                         4:mardlit(f);
                         5:Zamena(f);
                         6:Add(f);
                         7:Del_N(f);
                         8:SortGor(f);
                         9:SortDlit(f);
                         10:SortVidTran(f);
                         11:SortMes(f);
                         12:SortDen(f);
                         13:SortStoimost(f);
                         14:ch:=chr(27);{ vyhod }
                    end;
                    MenuToScr;
               end;
     until ch=chr(27);{ 27 - kod <Esc> }
end.

val(string,integer,code);