Umístnení souboru www.TrSek.com/zadania/ssl_zozn.pas

{ SSL_ZOZN.PAS              Copyright (c) TrSek alias Zdeno Sekerak }
{ Program nacita zoznam cisel a ulozi ich do spojiteho zoznamu.     }
{ Zoznam je rozdeleny na parne/neparne.                             }
{                                                                   }
{ Datum:18.01.2005                             http://www.trsek.com }

program spojity_seznam;
uses crt,dos;

const SOUB1 ='cisla.txt';
      SPARNE='cparne.txt';
      SNEPAR='cnepar.txt';

type IdentZaznam = ^Zaznam;
     Zaznam=record
      cislo:integer;
      dalsi:IdentZaznam;
     end;

var s_parne:IdentZaznam;            { smernik na start parne   }
    s_nepar:IdentZaznam;            { smernik na start neparne }

    parne:IdentZaznam;              { pracovny smernik na parne   }
    nepar:IdentZaznam;              { pracovny smernik na neparne }

    f:text;                         { pro praci se souborem }
    cis:integer;                    { docasne ulozi cislo nez ho spracuje }

{ prida parne cislo - na zacatek }
procedure pridajParne(cis:integer);
var pom:IdentZaznam;
begin
  { naalokujeme pamet }
  new(pom);

  { novy zaciatok }
  s_parne:=pom;
  s_parne^.dalsi:=parne;

  { pridame zaznam na zaciatok SSL }
  parne:=s_parne;

  { ulozime cislo }
  parne^.cislo:=cis;
end;

{ prida neparne cislo - na konec }
procedure pridajNeparne(cis:integer);
var pom:IdentZaznam;
begin
  { naalokujeme pamet }
  new(pom);

  { este nebolo pridane ziadne cislo }
  if(s_nepar=NIL)then
     s_nepar:=pom
  else { pridame zaznam do SSL }
     nepar^.dalsi:=pom;

  { ulozime cislo a dalsi smernik zatial na NIL }
  nepar:=pom;
  nepar^.cislo:=cis;
  nepar^.dalsi:=NIL;
end;

{ vycistime pamet od alokovanych dat }
procedure clrParne;
var pom:IdentZaznam;
begin
  parne:=s_parne;

  { prejdeme vsetky prvky zazanmu a odstranime ich }
  while(parne<>NIL) do begin
    pom:=parne^.dalsi;
    dispose(parne);     { uvolni tuto pamet }
    parne:=pom;
  end;
end;

{ vycistime pamet od alokovanych dat }
procedure clrNeparne;
var pom:IdentZaznam;
begin
  nepar:=s_nepar;

  { prejdeme vsetky prvky zaznamu a odstranime ich }
  while(nepar<>NIL) do begin
    pom:=nepar^.dalsi;
    dispose(nepar);     { uvolni tuto pamet }
    nepar:=pom;
  end;
end;

begin
  clrscr;
  writeln('Program nacitava soubor cisel ', SOUB1);

  { znulujeme }
  s_parne :=NIL;
  s_nepar:=NIL;

  parne :=NIL;
  nepar:=NIL;

  { zacneme citat soubor cisel }
  assign(f, SOUB1);
  reset(f);

  repeat
    read(f,cis);

    { zistime ci su parne alebo neparne a prida do zoznamu }
    if((cis mod 2)=0) then
       pridajParne(cis)
    else
       pridajNeparne(cis);

  until( eof(f));

  { zavrieme subor }
  close(f);

  { mame zoznam parnych, neparnych }
  { zapiseme do suboru parne }
  assign(f, SPARNE);
  rewrite(f);
  parne:=s_parne;

  while( parne<>NIL ) do begin
     write(f,parne^.cislo,' ');
     parne:=parne^.dalsi;
  end;
  close(f);

  { zapiseme do suboru neparne }
  assign(f, SNEPAR);
  rewrite(f);
  nepar:=s_nepar;

  while( nepar<>NIL ) do begin
     write(f,nepar^.cislo,' ');
     nepar:=nepar^.dalsi;
  end;
  close(f);

  { vycistime pamet }
  clrParne;
  clrNeparne;

  { napisem ze skoncil }
  writeln('Subor ', SOUB1, ' som rozdelil na parne a neparne cisla');
  writeln('do suborov ', SPARNE, ' a ', SNEPAR );
  ReadLn;
end.

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