Spojitý zoznam v pascale

{ BANKA.PAS                                                                 }
{                                                                           }
{ Program pracujici so spojitym zoznamom na uchovanie, editaciu a mazanie   }
{ bankovych operacii.                                                       }
{                                                                           }
{ Poskytované služby                                                        }
{ Klienti si v bance BVS zakládají účty, ukládají na ně peníze a provádějí  }
{ výběry. Když nejsou spokojeni, tak si účet zruší.                         }
{                                                                           }
{ Co banka potřebuje?                                                       }
{ Klienti jsou identifikováni pomocí unikátních šesticiferných čísel,       }
{ která nezačínají 0.                                                       }
{ V souboru bank.in jsou na každém řádku transakce z jednoho dne provozu    }
{ banky oddělené znakem středník (za poslední operací na řádku je taky).    }
{ Kódování jedné transakce je následující:  CISLO_UCTU:KOD:CASTKA;          }
{                                                                           }
{ kde:                                                                      }
{ CISLO_UCTU je šestimístné číslo, které jednoznačně identifikuje klienta.  }
{ KOD je velké písmeno, které určuje typ transakce. Možnosti jsou:          }
{     N .... založit nový účet (New)                                        }
{     Q....zrušit existující účet (Quit)                                    }
{     I .... zvýšit uloženou částku na daném účtu (Increase)                }
{     D....snížit uloženou částku na daném účtu (Decrease)                  }
{ CASTKA je kladné celé číslo (v případě N jde o iniciální vloženou částku, }
{ v případě I/D jde o přírůstek/úbytek a v případě Q na hodnotě nezáleží)   }
{                                                                           }
{ Program má za úkol provést zadané transakce pro všechny dny               }
{ (řádky souboru bank.in). Do souboru bank.out má potom vypsat pro          }
{ každý den hlášení o průběhu transakcí a výpis aktuálního stavu všech účtů.}
{ Výpis každého dne začíná řádkem:                                          }
{                                                                           }
{ === DAY ===                                                               }
{ kde DAY je číslo řádku vstupního souboru.                                 }
{ Hlášení o průběhu obsahuje řádek pro každou provedenou transakci.         }
{ Pokud je transakce úspěšná, příslušný řádek má být ve formátu:            }
{    TRANSAKCE OK                                                           }
{                                                                           }
{ V případě neúspěšné transakce chceme vědět kde se stala chyba.            }
{ Formát řádku, který přísluší k neúspěšné transakci, je:                   }
{    TRANSAKCE chyba: POPIS_CHYBY                                           }
{                                                                           }
{ POPIS_CHYBY je řetězec:                                                   }
{ "ucet neexistuje!" v případě, že pro dané číslo účtu nemáme žádný záznam  }
{ "ucet uz existuje!" v případě, že má být založen nový účet s číslem,      }
{                    které už je použité                                    }
{ "nizky stav uctu!" pokud by někdo chtěl vybírat víc než na má na účtě uloženo}
{                                                                           }
{ TRANSAKCE znamená trojici: CISLO_UCTU:KOD:CASTKA (bez středníku).         }
{                                                                           }
{ Po provedení všech transakcí z aktuálně zpracovávaného dne má být vypsán  }
{ oddělovací řádek: Poté bude následovat výpis stavů všech účtů ve formátu: }
{    CISLO_UCTU:CASTKA                                                      }
{ Ve výpisu musí být čísla účtů seřazena podle velikosti.                   }
{                                                                           }
{ Datum : 08.01.2014                                   http://www.trsek.com }
 
program banka_bvs;
 
type Pbank_pohyb = ^bank_pohyb;
     bank_pohyb = record    { obycejny spojity seznam }
       radek:word;          { radek v suboru bank.in }
       cislo_uctu:longint;  { cislo uctu s kterym se ma pracovat }
       kod:char;            { kod operace N,Q,I,D }
       castka:longint;      { financni castka }
       dalsi: Pbank_pohyb;  { smernik na nasledujici strukturu pohyb }
     end;
 
     { podle http://cs.wikipedia.org/wiki/Bin%C3%A1rn%C3%AD_vyhled%C3%A1vac%C3%AD_strom }
     Pbank_ucet = ^bank_ucet;
     bank_ucet = record     { struktura Binární vyhledávací stromu (BVS) }
       cislo_uctu:longint;  { cislo uctu }
       castka:longint;      { castka na uctu }
       levy:Pbank_ucet;     { smernik na levy list stromu }
       pravy:Pbank_ucet;    { smernik na pravy list stromu }
     end;
 
var  pohyb: Pbank_pohyb;    { zacatek spojiteho seznamu }
     ucet: Pbank_ucet;      { hlavni uzel BVS }
 
 
{ udela novou polozku pro seznam pohyb a zinicializuje jeji hodnoty na nuly }
function new_init_pohyb: Pbank_pohyb;
var new_pohyb: Pbank_pohyb;
begin
  GetMem(new_pohyb, sizeof(bank_pohyb));
  new_pohyb^.radek:=0;
  new_pohyb^.cislo_uctu:=0;
  new_pohyb^.kod:=' ';
  new_pohyb^.castka:=0;
  new_pohyb^.dalsi:=nil;
  new_init_pohyb:=new_pohyb;
end;
 
 
{ udela novou polozku (list BVS) a zinicializuje jeji hodnoty na nuly }
function new_init_ucet: Pbank_ucet;
var new_ucet: Pbank_ucet;
begin
  GetMem(new_ucet, sizeof(bank_ucet));
  new_ucet^.cislo_uctu:=0;
  new_ucet^.castka:=0;
  new_ucet^.levy:=nil;
  new_ucet^.pravy:=nil;
  new_init_ucet:=new_ucet;
end;
 
 
{ vycisteni binary tree podle uzlu }
procedure ucet_delete_tree(ucet_delete:Pbank_ucet);
begin
  if(ucet_delete<>nil)then
  begin
    ucet_delete_tree(ucet_delete^.levy);
    ucet_delete_tree(ucet_delete^.pravy);
    FreeMem(ucet_delete, sizeof(bank_ucet));
  end;
end;
 
 
{ vycisti pamet od alokovanych uctu, pohybu }
procedure vycisti_pamet;
var pohyb_temp: Pbank_pohyb;
begin
  while(pohyb <> nil) do
  begin
    pohyb_temp:=pohyb;
    pohyb:=pohyb^.dalsi;
    FreeMem(pohyb_temp, sizeof(bank_pohyb));
  end;
 
  ucet_delete_tree(ucet);
end;
 
 
{ prevede retezec na cislo }
function NaLongint(cislo:string):longint;
var value:longint;
    err:integer;
begin
  Val(cislo, value, err);
  NaLongint:=value;
end;
 
 
{ z vety ve formatu 2222:N:100 vrati prvni slovo, tedy 2222 }
function DejSlovo(var veta:string):string;
var slovo:string;
    pozice:integer;
begin
  pozice:=pos(':',veta);
  if(pozice>0)then
  begin
    slovo:=copy(veta,1, pozice-1);
    veta:=copy(veta,pozice+1, length(veta)-pozice);
    DejSlovo:=slovo;
  end
  else begin
    slovo:=veta;
    veta:='';
    DejSlovo:=slovo;
  end;
end;
 
{ nacte vstupni soubor s bankovnimi pohyby }
procedure nacti_soubor(sname:string);
var f:text;
    radek:word;
    slovo:string;
    veta:string;
    znak:char;
    new_pohyb: Pbank_pohyb;
    last_pohyb: Pbank_pohyb;
begin
  assign(f, sname);
  {$I-}
  reset(f);
  {$I+}
  if(IOResult<>0)then begin
     writeln('Chyba pri otevirani souboru.');
     halt(1);
  end;
 
  radek:=1;
  veta:='';
  last_pohyb:=nil;
  new_pohyb:=nil;
 
  while( not(eof(f))) do
  begin
     read(f,znak);
     { konec slova 0A - LF, 0D - CR }
     if(((znak=';') or (ord(znak)=$0A) or (ord(znak)=$0D)) 
     and (veta<>''))then
     begin
        GetMem(new_pohyb, sizeof(bank_pohyb));
        { jeste nemam prvni }
        if(pohyb=nil)then begin
           pohyb:=new_pohyb;
        end;
        { svazeme s predeslym }
        if(last_pohyb<>nil)then begin
           last_pohyb^.dalsi:=new_pohyb;
        end;
        { tohle je ted posledni }
        last_pohyb:=new_pohyb;
 
        new_pohyb^.radek:=radek;
        new_pohyb^.cislo_uctu:=NaLongint(DejSlovo(veta));
        slovo:=DejSlovo(veta);
        new_pohyb^.kod:=slovo[1];
        new_pohyb^.castka:=NaLongint(DejSlovo(veta));
        new_pohyb^.dalsi:=nil;
        veta:='';
     end;
     { konec radku, 0D - Carier Return }
     if(ord(znak)=$0D)then
        continue;
     { dalsi radek, 0A - Line Feed }
     if(ord(znak)=$0A)then
     begin
        radek:=radek+1;
        continue;
     end;
     { pridej k vete }
     if(znak <> ';')then
        veta:=veta+znak;
  end;
  { zavreme }
  close(f);
end;
 
 
{ hleda ucet v binarnim strome }
function ucet_hledej(ucet_tree:Pbank_ucet; cislo_uctu:longint):Pbank_ucet;
var temp:Pbank_ucet;
begin
  if(ucet_tree = nil)then
  begin
      ucet_hledej:=nil;
      exit;
  end;
 
  if(cislo_uctu = ucet_tree^.cislo_uctu)then
     ucet_hledej:=ucet_tree
  else if((cislo_uctu < ucet_tree^.cislo_uctu) and (ucet_tree^.levy <> nil))then
      ucet_hledej:=ucet_hledej(ucet_tree^.levy, cislo_uctu)
  else if((cislo_uctu > ucet_tree^.cislo_uctu) and (ucet_tree^.pravy <> nil))then
      ucet_hledej:=ucet_hledej(ucet_tree^.pravy, cislo_uctu)
  else
      ucet_hledej:=nil;
end;
 
 
{ hleda rodice uctu v binarnim strome }
function ucet_hledej_mem(ucet_tree:Pbank_ucet; ucet_find:Pbank_ucet):Pbank_ucet;
var ucet_temp:Pbank_ucet;
begin
  if(ucet_tree = nil)then
  begin
     ucet_hledej_mem:=nil;
  end
  { je to rodic }
  else if((ucet_tree^.levy = ucet_find) or (ucet_tree^.pravy = ucet_find))then
  begin
    ucet_hledej_mem:=ucet_tree;
  end
  else begin
    { zrus vlevo }
    ucet_temp := ucet_hledej_mem(ucet_tree^.levy, ucet_find);
    { tak vpravo }
    if(ucet_temp = nil)then
       ucet_temp:=ucet_hledej_mem(ucet_tree^.pravy, ucet_find);
    { vysledek }
    ucet_hledej_mem := ucet_temp;
  end;
end;
 
 
{ vlozi do binary tree novy ucet }
procedure ucet_zaloz(var tree_ucet:Pbank_ucet; novy_ucet:Pbank_ucet);
begin
    if(tree_ucet = nil)then
       tree_ucet := novy_ucet
    else if (novy_ucet^.cislo_uctu < tree_ucet^.cislo_uctu)then
       ucet_zaloz(tree_ucet^.levy, novy_ucet)
    else if (novy_ucet^.cislo_uctu > tree_ucet^.cislo_uctu)then
       ucet_zaloz(tree_ucet^.pravy, novy_ucet);
end;
 
 
{ zrusi ucet, a nasledne spoji binary strom }
procedure ucet_zruz(find_ucet:Pbank_ucet);
var temp_ucet:Pbank_ucet;
    rodic_ucet:Pbank_ucet;
begin
    { ma jenom praveho potomka }
    if((find_ucet^.levy = nil) and (find_ucet^.pravy <> nil))then
    begin
        temp_ucet := find_ucet^.pravy;
        find_ucet^.cislo_uctu := temp_ucet^.cislo_uctu;
        find_ucet^.castka := temp_ucet^.castka;
        find_ucet^.levy := temp_ucet^.levy;
        find_ucet^.pravy := temp_ucet^.pravy;
        FreeMem(temp_ucet, sizeof(bank_ucet));
        exit;
    end;
 
    { ma jenom leveho potomka }
    if((find_ucet^.levy <> nil) and (find_ucet^.pravy = nil))then
    begin
        temp_ucet := find_ucet^.levy;
        find_ucet^.cislo_uctu := temp_ucet^.cislo_uctu;
        find_ucet^.castka := temp_ucet^.castka;
        find_ucet^.levy := temp_ucet^.levy;
        find_ucet^.pravy := temp_ucet^.pravy;
        FreeMem(temp_ucet, sizeof(bank_ucet));
        exit;
    end;
 
    { Uzel má dva potomky, hledej pĹTedchĹŻdce (nejpravÄ>jší potomek levĂCho podstromu). }
    if((find_ucet^.levy <> nil) and (find_ucet^.pravy <> nil))then
    begin
        { zĂ­skej levĂCho potomka mazanĂCho uzlu }
        temp_ucet := find_ucet^.levy;
 
        { najdi nejpravÄ>jšího potomka podstromu levĂCho uzlu mazanĂCho uzlu (pĹTedchĹŻdce) }
        while (temp_ucet^.pravy <> nil) do
            temp_ucet := temp_ucet^.pravy;
 
        { zkopĂ­ruj hodnotu pĹTedchĹŻdce do mazanĂCho uzlu }
        find_ucet^.cislo_uctu := temp_ucet^.cislo_uctu;
        find_ucet^.castka := temp_ucet^.castka;
 
        { pozor temp ma levy, presuneme ho misto temp }
        if(temp_ucet^.levy <> nil)then
        begin
          rodic_ucet:=temp_ucet^.levy;
          temp_ucet^.cislo_uctu := rodic_ucet^.cislo_uctu;
          temp_ucet^.castka := rodic_ucet^.castka;
          temp_ucet^.levy := rodic_ucet^.levy;
          temp_ucet^.pravy := rodic_ucet^.pravy;
          { tento zmaz }          
          temp_ucet:=rodic_ucet;
        end
        else begin
          { list byl samotnej odstranime na nej odkaz z rodice }
          rodic_ucet:=ucet_hledej_mem(ucet, temp_ucet);
          if(rodic_ucet^.levy=temp_ucet)then
             rodic_ucet^.levy:=nil;
          if(rodic_ucet^.pravy=temp_ucet)then
             rodic_ucet^.pravy:=nil;
        end;
 
        { nynĂ­ smaĹľ pĹTedchĹŻdce - jeho hodnota byla pĹTesunuta do pĹŻvodnÄ> mazanĂCho uzlu }
        FreeMem(temp_ucet, sizeof(bank_ucet));
        exit;
    end;
 
    { je to list - odstran ho a taky info na nej }
    { najdi rodice }
    temp_ucet:=ucet_hledej_mem(ucet, find_ucet);
    { posledni prvek }
    if(temp_ucet = nil)then
       ucet:=nil
    else begin
      if(temp_ucet^.levy=find_ucet)then
         temp_ucet^.levy:=nil;
      if(temp_ucet^.pravy=find_ucet)then
         temp_ucet^.pravy:=nil;
    end;
    FreeMem(find_ucet, sizeof(bank_ucet));
end;
 
 
{ vypise seznam uctu }
procedure ucty_vypis(var f:text; ucet_vypis:Pbank_ucet);
begin
  if(ucet_vypis<>nil)then
  begin
    ucty_vypis(f,ucet_vypis^.levy);
    writeln(f,ucet_vypis^.cislo_uctu, ':', ucet_vypis^.castka);
    ucty_vypis(f,ucet_vypis^.pravy);
  end;
end;
 
 
procedure WriteHexWord(w: Word);
const
 hexChars: array [0..$F] of Char =
   '0123456789ABCDEF';
begin
 Write(hexChars[Hi(w) shr 4],
       hexChars[Hi(w) and $F],
       hexChars[Lo(w) shr 4],
       hexChars[Lo(w) and $F]);
end;
 
{ vypise seznam uctu }
procedure ucty_vypis_dsp(ucet_vypis:Pbank_ucet);
begin
  if(ucet_vypis<>nil)then
  begin
    ucty_vypis_dsp(ucet_vypis^.levy);
    write(ucet_vypis^.cislo_uctu, ':', ucet_vypis^.castka:8);
 
    write(' Ptr=');
    WriteHexWord(Seg(ucet_vypis^));
    write(' levy=');
    WriteHexWord(Seg(ucet_vypis^.levy^));
    write(' pravy=');
    WriteHexWord(Seg(ucet_vypis^.pravy^));
    writeln;
    ucty_vypis_dsp(ucet_vypis^.pravy);
  end;
end;
 
 
{ vykona operace a zaroven zapise do souboru }
procedure zpracuj_soubor(sname:string);
var f:text;
    radek:word;
    iradek:word;
    pohyb_move: Pbank_pohyb;
    find_ucet: Pbank_ucet;
    new_ucet: Pbank_ucet;
begin
  assign(f, sname);
  {$I-}
  rewrite(f);
  {$I+}
  if(IOResult<>0)then begin
     writeln('Chyba pri zapisu do souboru.');
     halt(1);
  end;
 
  if(pohyb=nil)then begin
     writeln('Nemam zadne udaje k zpracovani.');
     close(f);
     halt(1);
  end;
 
  pohyb_move:=pohyb;
  radek:=pohyb_move^.radek;
  writeln(f,'=== ', radek, ' ===');
 
  while(pohyb_move<>nil) do
  begin
    { skoncil den zapis aktualni stav }
    if(pohyb_move^.radek <> radek)then
    begin
      for iradek:=radek+1 to pohyb_move^.radek do begin
        { rekapitulace uctu }
        writeln(f,'======');
        ucty_vypis(f,ucet);
        { novy den }
        writeln(f,'=== ', iradek, ' ===');
      end;
      radek:=pohyb_move^.radek;
    end;
 
    { vypis operace }
    write(f, pohyb_move^.cislo_uctu, ':', pohyb_move^.kod, ':', pohyb_move^.castka);
 
    { jaka operace? }
    case(UpCase(pohyb_move^.kod)) of
    'N': begin      { N .... založit nový účet (New) }
           if( ucet_hledej(ucet,pohyb_move^.cislo_uctu) <> nil)then
               writeln(f,' chyba: ucet uz existuje!')
           else 
           { cislo uctu je 6-ti mistne cislo }
           if(( pohyb_move^.cislo_uctu >= 100000) and (pohyb_move^.cislo_uctu <= 999999))then 
           begin
               new_ucet:=new_init_ucet;
               new_ucet^.cislo_uctu:=pohyb_move^.cislo_uctu;
               new_ucet^.castka:=pohyb_move^.castka;
               ucet_zaloz(ucet, new_ucet);
               writeln(f,' OK');
           end
           else begin
               writeln(f,' chyba: ucet nema spravne cislo!')
           end;
         end;
    'Q': begin      { Q....zrušit existující účet (Quit) }
           find_ucet:=ucet_hledej(ucet,pohyb_move^.cislo_uctu);
           if( find_ucet = nil)then
               writeln(f,' chyba: ucet neexistuje!')
           else begin
{
               writeln('Hledam chybu - pred odstranenim');
               ucty_vypis_dsp(ucet);
               ucet_zruz(find_ucet);
               writeln('Hledam chybu - po odstraneni');
               ucty_vypis_dsp(ucet);
}
               ucet_zruz(find_ucet);
               writeln(f,' OK');
           end;
         end;
    'I': begin      { I .... zvýšit uloĹľenou částku na danĂCm účtu (Increase) }
           find_ucet:=ucet_hledej(ucet,pohyb_move^.cislo_uctu);
           if( find_ucet = nil)then
               writeln(f,' chyba: ucet neexistuje!')
           else begin
               find_ucet^.castka := find_ucet^.castka + pohyb_move^.castka;
               writeln(f,' OK');
           end;
         end;
    'D': begin      { D....snĂ­Ĺľit uloĹľenou částku na danĂCm účtu (Decrease) }
           find_ucet:=ucet_hledej(ucet,pohyb_move^.cislo_uctu);
           if( find_ucet = nil)then
               writeln(f,' chyba: ucet neexistuje!')
           else begin
             if( find_ucet^.castka < pohyb_move^.castka) then begin
                 writeln(f,' chyba: nizky stav uctu!');
             end
             else begin
                 find_ucet^.castka := find_ucet^.castka - pohyb_move^.castka;
                 writeln(f,' OK');
             end;
           end;
         end;
    end;
 
    { dalsi udaj }
    pohyb_move:=pohyb_move^.dalsi;
  end;
 
  { rekapitulace uctu }
  writeln(f,'======');
  ucty_vypis(f,ucet);
 
  { zatvor subor }
  close(f);
end;
 
 
begin
  writeln('Spracovani bankovnich operaci.');
  writeln('Nacitam soubor bank.in');
 
  pohyb:=nil;
  ucet:=nil;
  nacti_soubor('bank.in');
  zpracuj_soubor('bank.out');
  vycisti_pamet;
 
  writeln('Udaje zpracovany. Vysledek zapsan do souboru bank.out');
end.