Dze je subor www.TrSek.com/cover/ghostix/kartoteka.pas

{ KARTOTEKA.PAS                               Copyright (c) ghostix }
{ Jednoducha kartoteka pracujuca s datovym suborom.                 }
{                                                                   }
{ Author: Ghostix                                                   }
{ Date  : 15.02.2008                           http://www.trsek.com }

program kartoteka_prog;
uses  crt;
const dmena=15;
      dadr=25;

type  karta = record
           ec:integer;
           meno:string[dmena];
           adr:record
               miesto,
               ulica:string[dadr];
               end;
            end;
      kartoteka = file of karta;

var   f:kartoteka;
      k:karta;
      q:char;

procedure vstup_karta;
  var pocet:integer;
  begin
  reset(f);
  pocet:=filesize(f);
  seek(f,pocet);
  with k,adr do
    begin
    inc(pocet);
    ec:=pocet;
    gotoxy(1,8);
    writeln('Evidencne cislo : ':40,ec);
    writeln;
    write('Meno a priezvisko : ':40);readln(meno);
    writeln;
    write('  Adresa - miesto : ':40);readln(miesto);
    writeln;
    write('         -  ulica : ':40);readln(ulica);
    end;
  write(f,k);
end;

procedure vystup_karta;
   begin
   clrscr;
   gotoxy(1,8);
   with k,adr do
     begin
     writeln('  Evidencne cislo : ':40,ec);
     writeln;
     writeln('Meno a priezvisko : ':40,meno);
     writeln;
     writeln('  Adresa - miesto : ':40,miesto);
     writeln;
     writeln('          - ulica : ':40,ulica);
     end;
   readln;
   end;

procedure vystup_kartoteka;
  begin
  reset(f);
  while not eof(f) do
    begin
    read(f,k);
    vystup_karta;
    end;
  end;

procedure najdi;
  var hlmeno:string[dmena];
  begin
  gotoxy(20,12);
  write('Zadaj meno hladaneho: ');
  readln(hlmeno);
  reset(f);
  while not eof(f) do
    begin
    read(f,k);
    if k.meno=hlmeno then vystup_karta
    end
  end;

procedure odstran;
  var hlmeno:string[dmena];
      fn:kartoteka;
  begin
  gotoxy(20,12);
  write('Zadaj meno na odstranenie: ');
  readln(hlmeno);
  assign(fn,'pracov.pom');
  reset(f);rewrite(fn);
  while not eof(f) do
    begin
    read(f,k);
    if k.meno<>hlmeno then write(fn,k);
    end;
  close(f); close(fn);
  assign(f,'pracov.dat');  erase(f);
  assign(fn,'pracov.pom'); rename(fn,'pracov.dat');
  assign(f,'pracov.dat');
end;

procedure pocet;
  begin
  reset(f);
  gotoxy(30,12);
  writeln('Pocet pracovnikov: ',filesize(f));
  readln;
  end;

procedure menu;
  begin
  repeat
    clrscr;
    gotoxy(1,6);
    writeln('            ZALOZIT KARTU....................... 1');
    writeln;
    writeln('            NAJST PODLA MENA.................... 2');
    writeln;
    writeln('            ODSTRANIT S MENOM................... 3');
    writeln;
    writeln('            POCET PRACOVNIKOV................... 4');
    writeln;
    writeln('            ZOZNAM PRACOVNIKOV.................. 5');
    writeln;
    writeln('            KONIEC.............................. 0');
    q:=readkey;
    clrscr;
    case q of
      '1': vstup_karta;
      '2': najdi;
      '3': odstran;
      '4': pocet;
      '5': vystup_kartoteka;
    end;
  until q='0';
  close(f);
  end;

BEGIN
  clrscr;
  assign(f,'pracov.dat');
  gotoxy(10,12);
  write('Vytvorit novy subor pracovnikov (ano - A) ? ');
  {$I-} reset(f); {$I+}
  if (IOResult<>0) or (upcase(readkey)='A') then rewrite(f);
  menu;
END.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com