Program works with a data file - write, read, edit, pascal source

{ DATANKA.PAS               Copyright (c) TrSek alias Zdeno Sekerak }
{ Program pracuje s datovym suborom typu file of obyvatel.          }
{ Program ukazuje ako sa z takehoto suboru cita alebo don zapisuje. }
{                                                                   }
{ Datum:02.09.1995                             http://www.trsek.com }
 
program Databanka_file;
 
uses crt,dos;
 
type obyvatel=record            { Definovana struktura obyvatel }
     meno:string[20];
     priezvisko:string[35];
     cislo:integer;
     end;
 
var obyv:obyvatel;              { premenna obyv je typu obyvatel }
    f:file of obyvatel;         { subor z ktoreho sa bude citat je typu obyvatel }
    meno:string;                { meno suboru s ktorym sa pracuje }
    ch:char;                    { kvoli zisteniu aka bola klavesa stlacena }
 
 
procedure zapis( meno: string );  { vstupuje meno suboru }
var i:integer;                    { pouzita lokalna premenna na pocet viet }
 
begin
 writeln('Zapis do suboru ',meno);
 assign(f,meno);
 {$F-}                            { zakaz DOSu vypisovat chybove hlasky }
 rewrite(f);
 {$F+}                            { povol DOSu vypisovat chyby ak nastanu }
 if ioresult<>0 then begin        { nastala chyba pri vytvarani suboru }
                     writeln('Nastala chyba ...');
                     exit;        { ukonci svoju cinnost a vrat sa do hlavneho }
                     repeat until keypressed;
                                  { cakacia slucka }
                     end;
 i:=0;
 repeat
  i:=i+1;                         { precitaj meno ... , a zapis do suboru }
  write('Meno:');readln(obyv.meno);
  write('Priezvisko:');readln(obyv.priezvisko);
  write('cislo (-1 koniec):');readln(obyv.cislo);
  if (obyv.cislo<>-1) then write(f,obyv);
 until (obyv.cislo=-1);           { opakuj az pokial nezada cislo -1 }
 close(f);
end;
 
 
procedure citaj( meno: string );  { vstupuje meno suboru s ktorym sa pracuje }
var i,poc: integer;
    max: longint;
 
begin
 writeln('Citanie zo suboru ',meno);
 assign(f,meno);
 {$F-}
 reset(f);
 {$F+}
 if ioresult<>0 then begin
                     writeln('Nastala chyba ...');
                     exit;
                     repeat until keypressed;
                                  { cakacia slucka }
                     end;
 i:=0;
 repeat
  writeln;
  write('Zadaj polozku, ktoru mam precitat (-1 koniec):');readln(poc);
  max:=filesize(f);               { zisti kolko je vsetkych viet }
                                  { pokracuj len ked chce spravnu vetu }
  if (poc>=0) and (poc<max) then begin
                  seek(f,poc);
                  read(f,obyv);
                  writeln('Meno:',obyv.meno,'  priezvisko:',obyv.priezvisko,
                          '  cislo:',obyv.cislo);
                 end
                                  { chcel vetu, ktora neexistuje }
             else writeln('Nemozno vybrat vetu.');
 until (poc=-1);
 close(f);                        { uzavri subor }
end;
 
 
procedure zapis_citanie( meno: string);
var i,poc: integer;
    max: longint;
    s: string;
 
begin
 writeln('Citanie aj zapis do suboru ',meno);
 assign(f,meno);
 {$F-}
 reset(f);
 {$F+}
 if ioresult<>0 then begin
                     writeln('Nastala chyba ...');
                     exit;
                     repeat until keypressed;
                                  { cakacia slucka }
                     end;
 i:=0;
 repeat
  writeln;
  write('Zadaj polozku, ktoru mam precitat (-1 koniec):');readln(poc);
  max:=filesize(f);
  if (poc>=0) and (poc<max) then begin
                  seek(f,poc);
                  read(f,obyv);
                  writeln('Meno:',obyv.meno,'  priezvisko:',obyv.priezvisko,
                          '  cislo:',obyv.cislo);
 
                                  { rozhodol sa modifikovat udaje }
 
                  write('Prepisat [a/n] ???');readln(s);
                  if (UpCase(s[1])='A') then begin
                                  { precitaj nove udaje }
                        write('Meno:');readln(obyv.meno);
                        write('Priezvisko:');readln(obyv.priezvisko);
                        write('cislo:');readln(obyv.cislo);
 
                        seek(f,poc);    { nastav poziciu v subore }
                        write(f,obyv);  { zapis na nastavenu poziciu }
                       end;
                  end
             else writeln('Nemozno vybrat vetu.');
 until (poc=-1);
 close(f);
end;
 
begin
 meno:='obyvatel.dat';               { default meno suboru }
 repeat
  clrscr;
  writeln('Program urceny na ucebne ucely ITAS Presov 1995');
  writeln('                                                  Software by TRSEK');
  writeln('-------------------------------------------------------------------');
  writeln('Menu:');
  writeln(' 1. Zapis do suboru.');
  writeln(' 2. Citanie zo suboru.');
  writeln(' 3. Databanka citanie + opravy.');
  writeln(' 4. Meno suboru:', meno);
  writeln(' 5. Koniec.');
  ch:=readkey;                          { v ch znak klavesnice, aky si vybral }
  case (ch) of
   '1':zapis(meno);
   '2':citaj(meno);
   '3':zapis_citanie(meno);
   '4':begin
       write('Meno suboru je:',meno,' zmenit na :');readln(meno);
       end;
   end;
 until (ch='5');                        { skonci volbou 5 }
 clrscr;                                { nezadubnut zmazat obrazovku }
end.