Típusos állomány - példaprogram

program aruk;
uses crt;
type TAru = record        {A fájl alaptípusa.}
         kod: string;
         nev: string[15];
         ar: real;
         t: boolean;      {Ez a mező jelzi, hogy e rekord törölt-e (logikai törlés).}
       end;

var bolt: file of TAru;
    aru: TAru;
    mkod: string;
    mvalasz: char;

{Megkeres egy adott kódú rekordot az állományban.}
function Van(kodja: string): boolean;
var talalt: boolean;
begin
  seek(bolt,0);
  talalt := false;
  while not Eof(bolt) and not talalt do
    begin
      read(bolt, aru);
      if (aru.kod = mkod) and not aru.t then
         talalt := true;
     end;
  van := talalt;
end;

{Egy rekord felvitele az állományba.}
procedure Bevitel;
begin
  ClrScr;
  WriteLn('Kerem a kodot!'); ReadLn(mkod);
  if not Van(mkod) then
    begin
      Seek(bolt, filesize(bolt));          {Pozicionálás a fájl végére.}
      WriteLn('Kerem az aru nevet!');
      ReadLn(aru.nev);
      WriteLn('Kerem az aru arat!');
      ReadLn(aru.ar);
      aru.t := false;
      aru.kod := mkod;
      Write(bolt, aru);
    end
  else
    begin
      WriteLn('Mar van ilyen kod!');
      ReadKey
    end
end;

{Egy rekord módosítása a fájlban.}
procedure Modosit;
begin
  ClrScr;
  WriteLn('Kerem az aru kodjat!');
  ReadLn(mkod);
  if Van(mkod) then
    begin
      Seek(bolt, FilePos(bolt) - 1);
      WriteLn('Kerem az aru nevet!');
      ReadLn(aru.nev);
      WriteLn('Kerem az aru arat!');
      ReadLn(aru.ar);
      aru.t := false;
      aru.kod := mkod;
      Write(bolt, aru);
    end
  else
    begin
      Writeln('Nincs ilyen aru!');
      ReadKey
    end;
end;

{Egy rekord logikai törlése: a t mezőt True értékűre állítja, 
 az ilyen rekordokat a program nem létezőnek tekinti. 
 Fizikai törlés kilépéskor.}
procedure Torles;
begin
  ClrScr;
  WriteLn('Kerem az aru kodjat!');
  ReadLn(mkod);
  if Van(mkod) then
    begin
      Seek(bolt, FilePos(bolt) - 1);
      aru.t := true;
      Write(bolt, aru);
    end
  else
    begin
      WriteLn('Nincs ilyen aru!');
      ReadKey
    end
end;

{A fájl tartalmának kiírása a képernyőre.}
procedure Lista;
begin
  ClrScr;
  Seek(bolt, 0);
  while not Eof(bolt) do
    begin
      Read(bolt, aru);
      if aru.t = false then
        begin
          Write(aru.kod);
          GotoXy(30, wherey); write(aru.nev);
          GotoXy(60, wherey); writeln(aru.ar:10:0);
        end;
    end;
   ReadKey
end;

{Fizikai törlés: azon rekordok átmásolása egy új állományba, melyek nincsenek logikailag törölve.
 A régi állomány törlése, az új fájl átnevezése a régi nevére.}
procedure Surites;
var ujfile: file of TAru;
begin
  Assign(ujfile, 'ujfile');
  Rewrite(ujfile);
  Seek(bolt, 0);
  while not Eof(bolt) do
    begin
      Read(bolt, aru);
      if aru.t = false then write(ujfile, aru);
     end;
  Close(bolt);
  Erase(bolt);
  Close(ujfile);
  Rename(ujfile, 'bolt');
end;

{Főprogram, menü.}
begin
  clrscr;
  Assign(bolt, 'bolt');
  {$I-}
  Reset(bolt);
  {$I+}
  if IOResult <> 0 then Rewrite(bolt);
  repeat
    ClrScr;
    WriteLn('1. Adatbevitel');
    WriteLn('2. Modositas');
    WriteLn('3. Torles');
    WriteLn('4. Listazas');
    WriteLn('5. Vege');
    WriteLn('Valassz!');
    repeat mvalasz := readkey until mvalasz in['1'..'5'];
    case mvalasz of
      '1': bevitel;
      '2': modosit;
      '3': torles;
      '4': lista;
      '5': surites;
    end;
  until mvalasz = '5';
end.