Roszek

program ciupaga;
uses Crt;
const
nazwa2='I:\pliki\pliczekpom.dat';
nazwa='I:\pliki\pliczek.dat';
type
 plik=file of integer;
var p,q:plik;
    odp:char;

procedure dopis (var p:plik);
var a:integer;
begin
     assign(p,nazwa);
     {$I-}
     reset(p);
     {$I+}
     if IOResult=0 then seek(p,filesize(p)) else rewrite(p);
     write('Podaj liczbe: ');
     readln(a);
     write(p,a);
     close(p);
end;


procedure wypis (var p:plik);
var a,i:integer;
begin
     assign(p,nazwa);
     {$I-}
     reset(p);
     {$I+}
     if IOResult=0 then
       begin
            while not eof(p) do
                                   begin
                                      read(p,a);
                                      writeln(a);
                                   end;
       readkey;
       close(p);
       end else write('Plik nie istnieje');

end;


procedure ilosc(var p:plik);
var k,a,s:integer;
begin
     write('Jakiej wartosci poszukiwac?: ');
     readln(k);
     assign(p,nazwa);
     {$I-}
     reset(p);
     {$I+}
     s:=0;
     if IOResult=0 then
        begin
                while not eof(p) do
                                        begin
                                             read(p,a);
                                             if a=k then s:=s+1;
                                         end;


     close(p);
     writeln('W pliku znajduje sie ',s,' liczb(y) ktorych wartosc wynosi ',k);
     end else write('Plik nie istnieje');
     readkey;
end;

procedure usun(var p,q:plik);
var k,a,s:integer;
begin
     write('Jaka liczbe usunac z pliku?');
     readln(k);
     assign(q,nazwa2);
     rewrite(q);
     assign(p,nazwa);
     {$I-}
     reset(p);
     {$I+}
     s:=0;
     if IOResult=0 then
        begin
             while not eof(p) do
                                        begin
                                             read(p,a);
                                             write(q,a);
                                        end;
        close(p);
        close(q);
        rewrite(p);
        reset(q);
        while not eof(q) do
                                begin
                                        read(q,a);
                                        if a<>k then write(p,a) else s:=s+1;
                                end;
        close(p);
        close(q);
        writeln('Usunalem ',s,' liczb(y)');
     end else write('Plik nie istnieje');
     readkey;
end;

procedure menu;
var odp:char;
begin
	ClrScr;
        textcolor(green);
        writeln(' *===========================================*');
        writeln('|| 1 - Dopisywanie liczby do pliku           ||');
        writeln('|| 2 - Wypisanie listy  liczb                ||');
        writeln('|| 3 - Ilosc liczb o podaniej wartosci       ||');
        writeln('|| 4 - Usuwanie podawanej liczby z pliku     ||');
        writeln('|| Esc - Wyjscie                             ||');
        writeln(' *===========================================*');
        textcolor(red);
        writeln;
        writeln('Czego pragniesz?');
        textcolor(7);
	odp:=readkey;
        case odp of
        '1':dopis(p);
        '2':wypis(p);
        '3':ilosc(p);
        '4':usun(p,q);
        #27:halt;
        end;

end;






begin
	repeat menu;
	until false;
end.