Jednoduchá kartotéka pracujúca s dátovým súborom

Kategórie: KMP (Programy mladých programátorů)

Autor: ghostix
Program: Kartoteka.pas
Soubor exe: Kartoteka.exe
Potřebné: Pracov.dat

{ 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.