Unit bux_unit;
{Tarcsi Adam --- ADE}
INTERFACE
Uses crt; {NEWDELAY kell}
Type
  TReszveny = Record
		Sorszam : integer;
		Nev : string[30];
	      End;

  TForgalmiAdat = Record
		   Sorszam : integer;
		   nyitoar, zaroar, min, max, atlag : longint;
		  End;
Const nmax=260;
      elvalaszto='/';
      maxertek=9999999;
      maxe=99999.99;
      maxes='99999.99';
Var f,munkaf, reszvenyf:text;
    be:string;
    ch:char;
    hiba:boolean;
    a:TForgalmiAdat;

    Function Letezik_e(Filename:string):Boolean;
    Function maxn:integer;
    Procedure nyit(var f:text; fn:string; melyik:boolean);
    Procedure zar(var f:text);
    Procedure NedikNyit(var f:text; nedik:integer);
    Function ReszvenyNev(n:integer):string;
    Function ReszvenySorszam(s:string):integer;
    Function MaxReszveny:integer;
    Function MilyenNap(nap:integer):string;
    Procedure NapOlvas(sorszam : Integer; var kimeno : TForgalmiAdat);
    Procedure Olvas(nap: integer; hanyadikat : Integer; var kimenet : TForgalmiAdat);
    Procedure FeltoltReszveny(db:integer);
    Procedure FeltoltMunka(nap:integer);
    Procedure FeltoltMunkakat;
    Procedure FeltoltMindent;
    Procedure Feltolt;
    Procedure ListazMunka(hanyadik:integer);
    Procedure Listaz;
    Procedure ListazReszveny;

IMPLEMENTATION

Function Letezik_e(FileName: string): Boolean;
{L�tezik-e a FileName nevezet� f�jl}
Var
  f: file;
Begin
  {$I-}
  Assign(f, FileName);
  Reset(f);
  Close(f);
  {$I+}
  Letezik_e:= (IOResult = 0) and (FileName <> '');
End;

Function maxn:integer;
{Megadja, melyik napn�l tartunk a felt�lt�sn�l...}
Var i:integer;
    filenev,szam:string;
Begin
  i:=1;
  str(i,szam);
  filenev:='munka.'+szam;
  While (i<=nmax) and letezik_e(filenev) do
   Begin
    i:=i+1;
    str(i,szam);
    filenev:='munka.'+szam;
   End;
  maxn:=i-1;
End;

Procedure nyit(var f:text; fn:string; melyik:boolean);
{Ha melyik=true -->      olvas
		kulonben ir}
Begin
 {$I-}
 If melyik then begin
		 if letezik_e(fn) then begin
					assign(f,fn);
					reset(f);
				       end
				  else hiba:=true;
		end
	   else begin
		 assign(f,fn);
		 rewrite(f);
		end;
 {$I+}
End;

Procedure zar(var f:text);
Begin
  {$I-}
  close(f);
  {$I+}
End;

Procedure NedikNyit(var f:text; nedik:integer);
{Megnyitja az munka.nedik nev� f�jlt.}
Var szam:string;
Begin
 str(nedik,szam);
 If letezik_e('munka.'+szam) then nyit(f,'munka.'+szam,true)
			     else hiba:=true;
End;

Function ReszvenyNev(n:integer):string;
Var be,sz:string;
    szam,ok,i:integer;
Begin
  nyit(reszvenyf,'reszveny.txt',true);
  szam:=0;
  While not eof(reszvenyf) and (szam<>n) do
   Begin
     readln(reszvenyf,be);
     i:=1;
     While (be[i]<>elvalaszto) and (i<=length(be)) do i:=i+1;
     sz:=copy(be,0,i-1);
     val(sz,szam,ok);
   End;
   delete(be,1,i);
   If szam=n then ReszvenyNev:=be
	     else ReszvenyNev:='';
   zar(reszvenyf);
End;

Function ReszvenySorszam(s:string):integer;
Var be,sz:string;
    szam,ok,i:integer;
Begin
  nyit(reszvenyf,'reszveny.txt',true);
  szam:=0;
  be:='';
  While not eof(reszvenyf) and (be<>s) do
   Begin
     readln(reszvenyf,be);
     i:=1;
     While (be[i]<>elvalaszto) and (i<=length(be)) do i:=i+1;
     sz:=copy(be,0,i-1);
     be:=copy(be,i+1,length(be));
   End;
   val(sz,szam,ok);
   If (be=s) and (ok=0) then ReszvenySorszam:=szam
			else ReszvenySorszam:=0;
   zar(reszvenyf);
End;

Function MaxReszveny:integer;
{Megadja, hogy h�ny r�szv�ny van �sszesen}
var i:integer;
    be:string;
Begin
  nyit(reszvenyf,'reszveny.txt',true);
  i:=0;
  While not eof(reszvenyf) do
   Begin
    readln(reszvenyf,be);
    i:=i+1;
   End;
  Zar(reszvenyf);
  MaxReszveny:=i;
End;

Function MilyenNap(nap:integer):string;
Begin
  Case nap mod 5 of
    0: MilyenNap:='H�tf�';
    1: MilyenNap:='Kedd';
    2: MilyenNap:='Szerda';
    3: MilyenNap:='Cs�t�rt�k';
    4: MilyenNap:='P�ntek';
  End;
End;

Procedure NapOlvas(sorszam : Integer; var kimeno : TForgalmiAdat);
Var be,ki:string;
    i,j,ok:integer;
    szam:longint;
Begin
 If sorszam>maxreszveny then hiba:=true
			else Begin
			  Readln(f,ki);
			  szam:=0;
			  i:=1;
			  While (i<sorszam) and not eof(f) do
			    Begin
			      i:=i+1;
			      readln(f,ki);
			    End;
			  if i=sorszam then Begin
			  i:=2;
			  While ki[i]<>elvalaszto do i:=i+1;
			  j:=i+1;
			  While ki[j]<>elvalaszto do
			  Begin
			   j:=j+1;
			  End;
			  be:=copy(ki,i+1,j-i-1);
			  val(be,szam,ok);
			  If ok=0 then kimeno.nyitoar:=szam
				  else hiba:=true;
			  i:=j+1;
			  j:=j+1;
			  While ki[i]<>elvalaszto do i:=i+1;
			  be:=copy(ki,j,i-j);
			  val(be,szam,ok);
			  If ok=0 then kimeno.zaroar:=szam
				  else hiba:=true;
			  j:=i+1;
			  i:=i+1;
			  While ki[j]<>elvalaszto do j:=j+1;
			  be:=copy(ki,i,j-i);
			  val(be,szam,ok);
			  If ok=0 then kimeno.min:=szam
				  else hiba:=true;
			  i:=j+1;
			  j:=j+1;
			  While ki[i]<>elvalaszto do i:=i+1;
			  be:=copy(ki,j,i-j);
			  val(be,szam,ok);
			  If ok=0 then kimeno.max:=szam
				  else hiba:=true;
			  i:=i+1;
			  be:=copy(ki,i,length(ki));
			  val(be,szam,ok);
			  If ok=0 then kimeno.atlag:=szam
				  else hiba:=true;
			  kimeno.sorszam:=sorszam;
			  End
			  Else
			  Begin
			   hiba:=true;
			  End;
  End;
End;

Procedure Olvas(nap: integer; hanyadikat : Integer; var kimenet : TForgalmiAdat);
{Napodik napon, a hanyadikat r�szv�ny adatait kiolvassa}
Var be:string;
Begin
  if nap>maxn then Begin
		  hiba:=true;
		  kimenet.sorszam:=0;
		 End
	      else Begin
		     str(nap,be);
		     be:='munka.'+be;
		     nyit(f,be,true);
		     NapOlvas(hanyadikat,kimenet);
		   End;
End;

Procedure FeltoltReszveny(db:integer);
Var i:integer;
    sor,is:string;
    joe:boolean;
    c:char;
Begin
 nyit(reszvenyf,'reszveny.txt',false);
 For i:=1 to db do
  Begin
    str(i,is);
    sor:=is+elvalaszto;
    joe:=true;
    Repeat
     write('Irja be a(z) ',i,'. r�szv�ny nev�t: ');
     readln(is);
     If (length(is)>30) then joe:=false
     else begin
      write('A r�szv�ny neve megfelel�? (I/N) ');
      Repeat
       c:=readkey;
       write(c);
      Until c in['I','i','N','n'];
      writeln;
      If (c='i') or (c='I') then joe:=true
			    else joe:=false;
     end;
    Until joe;
    sor:=sor+is;
    writeln(reszvenyf,sor);
  End;
 zar(reszvenyf);
End;

Procedure FeltoltMunka(nap:integer);
Var sor,be,be1:string;
    i,j,ok:integer;
    szam:longint;
    mn,mx:real;
    joe,tule:boolean;
    f:text;
    c:char;
    a:TForgalmiAdat;
    szamreal:real;
Begin
 tule:=false;
 If nap=nmax+1 then Begin
			For i:=1 to nmax-1 do
			  Begin
			    str(i,be);
			    assign(f,'munka.'+be);
			    erase(f);
			  End;
			  str(nmax,be);
			  assign(f,'munka.'+be);
			  rename(f,'munka.0');
			  tule:=true;
			be:='1';
		      End
	       else str(nap,be);
 nyit(f,'munka.'+be,false);
 For i:=1 to MaxReszveny do
  Begin
    str(i,be);
    sor:=be;
    joe:=true;
    szamreal:=0;
    Writeln(nap,'. munkanap, ',nap div 5,'. h�t, ',milyennap(nap));
    If (nap=1) and not(tule) then Begin
      Repeat
       Write('Adja meg a ',ReszvenyNev(i),' r�szv�ny nyit� �r�t: (0-',maxes,') ');
       Readln(be);
       val(be,szamreal,ok);
       If (ok=0) and ((szamreal>=0) and (szamreal<=maxe)) then
	 begin
	   Write('Az �rt�k megfelel�? (I/N) ');
	   Repeat
	     c:=readkey;
	     write(c);
	   Until c in['I','i','N','n'];
	   writeln;
	   If (c='i') or (c='I') then joe:=true
				 else joe:=false;
	 end
	 Else joe:=false;
	 szam:=round(szamreal*100);
	 str(szam,be);
      Until joe;
      joe:=true;
      end
      else Begin
	     If tule then Olvas(0,i,a)
		     else Olvas(nap-1,i,a);
	     szam:=a.zaroar;
	     str(szam,be);
	   End;
    sor:=sor+elvalaszto+be;
    szamreal:=0;
    Repeat
     Write('Adja meg a ',ReszvenyNev(i),' r�szv�ny z�r� �r�t: (0-',maxes,') ');
     Readln(be);
     val(be,szamreal,ok);
     If (ok=0) and ((szamreal>=0) and (szamreal<=maxe)) then
       begin
	 Write('Az �rt�k megfelel�? (I/N) ');
	 Repeat
	   c:=readkey;
	   write(c);
	 Until c in['I','i','N','n'];
	 writeln;
	 If (c='i') or (c='I') then joe:=true
			       else joe:=false;
       end
       Else joe:=false;
       szam:=round(szamreal*100);
       str(szam,be);
    Until joe;
    sor:=sor+elvalaszto+be;
    szamreal:=0;
    joe:=true;
    Repeat
     Write('Adja meg a ',ReszvenyNev(i),' r�szv�ny legolcs�bb elad�si �r�t: (0-',maxes,') ');
     Readln(be);
     val(be,szamreal,ok);
     If (ok=0) and ((szamreal>=0) and (szamreal<=maxe)) then
       begin
	 Write('Az �rt�k megfelel�? (I/N) ');
	 Repeat
	   c:=readkey;
	   write(c);
	 Until c in['I','i','N','n'];
	 writeln;
	 If (c='i') or (c='I') then joe:=true
			       else joe:=false;
       end
       Else joe:=false;
       szam:=round(szamreal*100);
       str(szam,be);
    Until joe;
    mn:=szamreal; joe:=true;
    sor:=sor+elvalaszto+be;
    be1:=be;
    If mn=0 then sor:=sor+elvalaszto+'0'+elvalaszto+'0'
	    else Begin
		  joe:=true;
		  szamreal:=0;
		  Repeat
		  Write('Adja meg a ',ReszvenyNev(i),' r�szv�ny legdr�g�bb elad�si �r�t: (',mn:length(be):2,'-',maxes,'-ig) ');
		    Readln(be);
		    val(be,szamreal,ok);
		    If (ok=0) and ((szamreal>=mn) and (szamreal<=maxe)) then
		       begin
			 Write('Az �rt�k megfelel�? (I/N) ');
			 Repeat
			   c:=readkey;
			   write(c);
			 Until c in['I','i','N','n'];
			 writeln;
			 If (c='i') or (c='I') then joe:=true
					       else joe:=false;
		       end
		       Else joe:=false;
		  Until joe;
		  szam:=round(szamreal*100);
		  str(szam,be);
		  mx:=szamreal;
		  sor:=sor+elvalaszto+be;
		  szamreal:=0;
		  joe:=true;
		  Repeat
Write('Adja meg a ',ReszvenyNev(i),' r�szv�ny �tlagos elad�si �r�t: (',mn:length(be1):2,'-',mx:length(be):2,'-ig) ');
		    Readln(be);
		    val(be,szamreal,ok);
		    If (ok=0) and ((szamreal>=mn) and (szamreal<=mx)) then
		       begin
			 Write('Az �rt�k megfelel�? (I/N) ');
			 Repeat
			   c:=readkey;
			   write(c);
			 Until c in['I','i','N','n'];
			 writeln;
			 If (c='i') or (c='I') then joe:=true
					       else joe:=false;
		       end
		       Else joe:=false;
		  Until joe;
		 End;
    szam:=round(szamreal*100);
    str(szam,be);
    sor:=sor+elvalaszto+be;
    writeln(f,sor);
  End;
 zar(f);
If tule then Begin
		assign(f,'munka.0');
		erase(f);
	     End;
End;

Procedure FeltoltMindent;
Var szam,ok,i:integer;
    be:string;
    c:char;
    joe:boolean;
Begin
 {Reszveny feltoltese}
 joe:=true;
 Repeat
   Write('H�ny r�szv�ny van ');
   Readln(be);
   val(be,szam,ok);
   If (ok=0) and ((szam>=0) and (szam<=maxertek)) then
       begin
	 Write('Az �rt�k megfelel�? (I/N) ');
	 Repeat
	   c:=readkey;
	   write(c);
	 Until c in['I','i','N','n'];
	 writeln;
	 If (c='i') or (c='I') then joe:=true
			       else joe:=false;
       end
       Else joe:=false;
 Until joe;
 FeltoltReszveny(szam);
 {Munka feltoltese}
 If szam>0 then Begin 
 joe:=true;
 Repeat
   Write('H�ny napot akat feltolteni (0-',nmax,')-ig ');
   Readln(be);
   val(be,szam,ok);
   If (ok=0) and ((szam>=0) and (szam<=nmax)) then
       begin
	 Write('Az �rt�k megfelel�? (I/N) ');
	 Repeat
	   c:=readkey;
	   write(c);
	 Until c in['I','i','N','n'];
	 writeln;
	 If (c='i') or (c='I') then joe:=true
			       else joe:=false;
       end
       Else joe:=false;
 Until joe;
 For i:=1+maxn to szam+maxn do FeltoltMunka(i);
 End;
End;

Procedure FeltoltMunkakat;
 Var szam,ok,i:integer;
     be:string;
     c:char;
     joe:boolean;
 Begin
	joe:=true;
	Repeat
	  Write('H�ny napot akat feltolteni (0-',nmax,')-ig ');
	  Readln(be);
	  val(be,szam,ok);
	  If (ok=0) and ((szam>=0) and (szam<=nmax)) then
			begin
			  Write('Az �rt�k megfelel�? (I/N) ');
			  Repeat
			    c:=readkey;
			    write(c);
			  Until c in['I','i','N','n'];
			  writeln;
			  If (c='i') or (c='I') then joe:=true
						else joe:=false;
			end
			Else joe:=false;
	Until joe;
	For i:=1+maxn to szam+maxn do FeltoltMunka(i);
End;

Procedure Feltolt;
Var szam,ok,i:integer;
    be:string;
    c:char;
    joe:boolean;
Begin
 joe:=true;
 Writeln('Mit akar feltolteni? ');
 Writeln('Nyomja meg a megfelelo billentyut ');
 Writeln('Mindent: - 1 bill. Figyelem: Torli az osszes munka fajlt, a reszveny fajlt! ');
 Writeln('Ujabb munkanap bevitele: - 2 bill. ');
 Writeln('Megsem, visszalepes - 3 bill. ');
 Write('Valasszon (1 vagy 2 vagy 3): ');
 Repeat
    c:=readkey;
    write(c);
 Until c in ['1','2','3'];
 writeln;
 Case c of
   '1': Begin
       FeltoltMindent;
      End;
   '2': Begin
       FeltoltMunkakat;
      End;
   else Begin End;
 end;
End;

Procedure ListazMunka(hanyadik:integer);
   var lap,i,j,reszv:integer;
       a:TForgalmiAdat;
       c:char;
   Begin
     lap:=1;i:=1;
     reszv:=MaxReszveny;
     While i<=reszv do
	  Begin
	    j:=1;
	    clrscr;
	    Writeln('��������������������������� A(z) ',hanyadik,'. nap eredm�nyei  ������������������������������ ');
	    GotoXY(25,2); Write(hanyadik div 5, '. h�t, ',MilyenNap(hanyadik));
	    GotoXY(1,3);  Write('R�SZV�NYN�V');
	    GotoXY(30,3); Write('NYIT�R');
	    GotoXY(40,3); Writeln('Z�R�R');
	    GotoXY(50,3); Writeln('MINIMUM�R');
	    GotoXY(60,3); Writeln('MAXIMUM�R');
	    GotoXY(70,3); Writeln('�TLAGOS�R');
	    While (j<=19) and (i<=reszv) do
		  begin
		    Olvas(hanyadik,i,a);
		    GotoXY(1,j+3); Write(Reszvenynev(a.sorszam));
		    GotoXY(30,j+3);Write(a.nyitoar);
		    GotoXY(40,j+3);Write(a.zaroar);
		    GotoXY(50,j+3);Write(a.min);
		    GotoXY(60,j+3);Write(a.max);
		    GotoXY(70,j+3);Write(a.atlag);
		    j:=j+1; i:=i+1;
		  End;
	     GotoXY(35,24); Writeln(lap,'. oldal');
	     GotoXY(1,25); Write('Nyomjon meg egy billenty�t a folytat�shoz!');
	     c:=readkey;
	     inc(lap);
	  End;
     writeln;
   End;

Procedure Listaz;
 var be:string;
     ok,szam:integer;
     joe:boolean;
     c:char;
Begin
  joe:=true;
  If maxn>=1 then begin
  Repeat
   Write('H�nyadik napot akarja kilist�zni? (1-',maxn,') ');
   Readln(be);
   val(be,szam,ok);
   If (ok=0) and ((szam>=0) and (szam<=maxn)) then joe:=true
					      else joe:=false;
  Until joe;
  If szam>0 then ListazMunka(szam);
 end
 else begin
	writeln('Nincsenek munkafajlok! Toltson fel munkafajlokat! ');
	write('Feltolti most? (I/N) ');
	repeat
	 c:=readkey;
	 write(c);
	until c in ['i','I','n','N'];
	If c in ['i','I','n','N'] then begin
					If letezik_e('reszveny.txt') then FeltoltMunkakat
								     else FeltoltMindent;
				       end;
      end;
End;

Procedure ListazReszveny;
   Var lap,i,j,reszv:integer;
       a:TForgalmiAdat;
       c:char;
   Begin
     if letezik_e('reszveny.txt') then begin
     lap:=1;i:=1;
     reszv:=MaxReszveny;
     While i<=reszv do
	  Begin
	    j:=1;
	    clrscr;
	    Writeln('������������������������ Az �rt�kt�zsde r�szv�nyei:  ������������������������������ ');
	    GotoXY(1,2);  Write('SORSZ�M');
	    GotoXY(15,2); Write('R�SZV�NYN�V');
	    While (j<=20) and (i<=reszv) do
		  begin
		    GotoXY(1,j+3); Write(i);
		    GotoXY(15,j+3);Write(Reszvenynev(i));
		    j:=j+1; i:=i+1;
		  End;
	     GotoXY(35,24); Writeln(lap,'. oldal');
	     GotoXY(1,25); Write('Nyomjon meg egy billenty�t a folytat�shoz!');
	     c:=readkey;
	     inc(lap);
	  End;
     writeln;
     end
     else
      Begin
	writeln('Nincsenek reszvenyek! Toltse fel a reszvenyeket! ');
	write('Feltolti? (I/N) ');
	repeat
	 c:=readkey;
	 write(c);
	until c in ['i','I','n','N'];
	writeln;
	IF c in ['i','I'] then FeltoltMindent;
   End;
END.