[Pascal]Bład, Exitcode 216


(Maartin 14) #1

Podczas dodawania produktu w moim programie, po wpisaniu ceny w zakładce wyświetla się taki błąd pascalyb1.th.jpg

Oto kod mojego programu

program biuro;

        uses crt;


        const sciezka = 'c:\biuro.dat';

        type osoba = record

                            nazwa:string; {nazwa wyrobu lub nazwa czesci rzezniczej}

                            zar: real; {cena jednostkowa}

                            typ:char; {k-kobieta lub m-mezczyzna}

                            rodzaj:string; {}


                     end;


             lista = ^element_listy; { lista }

             element_listy = record { element listy }

                             n : lista; { nastepny element }

                             p : lista; { poprzedni element }

                             dane: osoba; { dane o miesku }

                       end;

        var l:lista;

            pamiec:longint;

            znak:char;



procedure przegladaj(var l:lista; jak,ile:integer); forward;

procedure sortuj(var l:lista); forward;




procedure dodaj(var l:lista; var dane:osoba);

          var pom:lista;

begin


     new(pom);

     pom^.dane:=dane;


     if l=nil then

        begin

             pom^.n:=nil;

             pom^.p:=nil;

             l:=pom;

        end

     else if ((l^.n=nil) and (l^.p=nil))

             or ((l^.n=nil) and (l^.pnil)) then

          begin

               pom^.n:=nil;

               pom^.p:=l;

               l^.n:=pom;

               l:=pom;

          end

     else if (l^.nnil) and (l^.p=nil) then

          begin

               pom^.p:=nil;

               pom^.n:=l;

               l^.p:=pom;

               l:=pom;

          end

     else

         begin

              pom^.p:=l^.p;

              l^.p^.n:=pom;

              l^.p:=pom;

              pom^.n:=l;

         end;

end;



procedure usun(var l:lista);

          var pom:lista;

begin

     if l=nil then exit

     else if (l^.n=nil) and (l^.p=nil) then

          begin

               dispose(l);

               l:=nil;

          end

     else if (l^.nnil) and (l^.p=nil) then

          begin

               pom:=l;

               l:=l^.n;

               l^.p:=nil;

               pom^.n:=nil;

               dispose(pom);

          end

     else if (l^.n=nil) and (l^.pnil) then

          begin

               pom:=l;

               l:=l^.p;

               l^.n:=nil;

               pom^.p:=nil;

               dispose(pom);

          end

     else

         begin

              pom:=l;

              l:=l^.n;

              l^.p:=pom^.p;

              pom^.p^.n:=l;

              pom^.p:=nil;

              pom^.n:=nil;

              dispose(pom);

         end;

end;






procedure rysuj_ekran_menu;

begin

     clrscr;

     gotoxy(1,1);write(' BIURO MATRYMONIALNE');

     gotoxy(1,2);write('--------------------------------------------------------------------------------');



     write('');

     gotoxy(1,25); write('D - dodaj S - szukaj P - przegladaj X - wyjscie');

end;



procedure dodaj_miesko;

          var dane:osoba;

              znak:char;

begin

     clrscr;

     gotoxy(1,1);write(' BIURO MATRYMONIALNE');

     gotoxy(1,2);write('--------------------------------------------------------------------------------');

     gotoxy(1,24);

     write('--------------------------------------------------------------------------------');

     gotoxy(1,25); write('DODAWANIE NOWEJ POZYCJI');


     gotoxy(1,23);write('typ: k-kobieta, m-mezczyzna');

     repeat

           gotoxy(10,9); write('Typ........................ ');

           znak:=readkey;

     until (znak='m') or (znak='k');


     if znak='m' then write('mezczyzna')

     else write('wedlina');


     dane.typ:=znak;

     if dane.typ='k' then

        begin

             gotoxy(10,10); write('Nazwa wyrobu:.............. ');

             readln(dane.nazwa);

             gotoxy(1,23);write('Cena: np. 15.99 ');

             gotoxy(10,11); write('Cena jednostkowa:.......... ');

             readln(dane.zar);

        end

     else if dane.typ='m' then

          begin

             gotoxy(10,10); write('Nazwa czesci rzezniczej.... ');

             readln(dane.nazwa);

             gotoxy(1,23);write('Rodzaj miesa: wolowina, wieprzowina, drob..');

             gotoxy(10,11); write('Rodzaj miesa............... ');

             readln(dane.rodzaj);

             gotoxy(1,23);write('Cena: np. 15.99 ');

             gotoxy(10,12); write('Cena jednostkowa........... ');

             readln(dane.zar);

          end;

     dodaj(l, dane);

     gotoxy(1,20); writeln('miesko dodane...');

     sortuj(l);

     delay(1500);

end;




procedure usun_miesko(var l:lista);

          var znak:char;

begin

     gotoxy(1,20); write('Na pewno? [t/n]');

     repeat znak:=readkey;

     until (znak='t') or (znak='T') or (znak='n') or (znak='N');


     if (znak='t') or (znak='T') then

        begin

             usun(l);

             gotoxy(1,20); write('usunieto... ');

             delay(1500);

             gotoxy(1,20); write(' ');

        end

     else

         begin

              gotoxy(1,20); write(' ');

         end;

end;



procedure znajdz;

          var rodzaj:string;

              wyniki:lista;

              wynik:integer;

begin

     clrscr;

     gotoxy(1,1);write(' BIURO MATRYMONIALNE');

     gotoxy(1,2);write('--------------------------------------------------------------------------------');

     gotoxy(1,23);write('rodzaj miesa: wolowina, wieprzowina, drob..');

     gotoxy(1,24);

     write('--------------------------------------------------------------------------------');

     gotoxy(1,25); write('WYSZUKIWANIE MIESA WG PODANEGO RODZAJU');

     gotoxy(1,20); write('Podaj rodzaj miesa do wyszukania: ');

     readln(rodzaj);


     while l^.pnil do l:=l^.p;


     wynik:=0;

     wyniki:=nil;

     while true do

          begin

               if l^.dane.typ in ['m','M'] then

                  begin

                       if rodzaj = l^.dane.rodzaj then

                          begin

                               dodaj(wyniki,l^.dane);

                               inc(wynik);

                          end;

                  end;

               if l^.nnil then l:=l^.n

               else break;

           end;


     if wynik=0 then

        begin

             gotoxy(1,20); write(' ');

             gotoxy(1,20); write('Nic nie znaleziono... ');

             delay(1000);

        end

     else

         begin

              sortuj(wyniki);

              przegladaj(wyniki, 2, wynik);

              while wynikinil do usun(wyniki);

         end;

end;


procedure sortuj(var l:lista);

          var ls, max:lista;

              maxn:string;

begin

     if l=nil then exit;

     ls:=nil;

     ls^.n:=nil;

     ls^.p:=nil;

     while true do

           begin

                maxn:='';

                while l^.pnil do l:=l^.p;

                while true do

                      begin

                       if l^.dane.nazwamaxn then

                          begin

                               max:=l;

                               maxn:=max^.dane.nazwa;

                          end;

                       if l^.nnil then l:=l^.n

                       else break;

                      end;


                if (max^.p=nil) and (max^.n=nil) then l:=nil

                else if max^.p=nil then

                     begin

                          l:=max^.n;

                          l^.p:=nil;

                          max^.n:=nil;

                     end

                else if max^.n=nil then

                     begin

                          l:=max^.p;

                          l^.n:=nil;

                          max^.p:=nil;

                     end

                else if (max^.pnil) and (max^.nnil) then

                     begin

                          l:=max^.p;

                          l^.n:=max^.n;

                          l^.n^.p:=l;

                          max^.n:=nil;

                          max^.p:=nil;

                     end;


                {dodawanie max'a do posortowanej listy}

                if ls=nil then

                   begin

                        ls:=max;

                        ls^.p:=nil;

                        ls^.n:=nil;

                   end

                else

                    begin

                         ls^.p:=max;

                         max^.n:=ls;

                         max^.p:=nil;

                         ls:=max;

                    end;

                if l=nil then break;

           end;

     l:=ls;

end;



procedure modyfikacja;

          var znak:char;

              nowa:string;

              i:integer;

              zar:real;

begin

     clrscr;

     gotoxy(1,1);write(' BIURO MATRYMONIALNE');

     gotoxy(1,2);write('--------------------------------------------------------------------------------');

     gotoxy(1,23); write('puste pole [ENTER] - pozycja bez zmian');

     gotoxy(1,24);

     write('--------------------------------------------------------------------------------');

     gotoxy(1,25);

     write('MODYFIKACJA DANYCH X powrót');


     gotoxy(10, 5); write('AKTUALNE DANE:');

     gotoxy(10, 6); write('----------------------------------------');

     gotoxy(10, 7); write('Typ: ');

     if l^.dane.typ='m' then write('mezczyzna') else write('wedlina');


     if l^.dane.typ='k' then

       begin

          gotoxy(10,8); write('Nazwa wyrobu: ', l^.dane.nazwa);

          gotoxy(10,9); write('Cena jednostkowa: ', l^.dane.zar:4:2,' zl/kg');

       end;

     if l^.dane.typ='m' then

       begin

          gotoxy(10,8); write('Nazwa czesci rzezniczej: ', l^.dane.nazwa);

          gotoxy(10,9); write('Rodzaj miesa: ', l^.dane.rodzaj);

          gotoxy(10,10);write('Cena jednostkowa: ', l^.dane.zar:4:2,' zl/kg');

       end;



     gotoxy(10, 12); write('NOWE DANE:');

     gotoxy(10, 13); write('----------------------------------------');

     { typ }

     gotoxy(1,22); write('Typ: m-mezczyzna, w-wedlina');

     gotoxy(10, 14); write('Typ.......................... ');

     repeat

           gotoxy(40,14);

           znak:=readkey;

     until (znak=#13) or (znak='m') or (znak='M') or (znak='w') or (znak='W');

     gotoxy(40,14);

     if ((znak=#13) and (l^.dane.typ='m')) or ((znak='m') or (znak='M')) then write('mezczyzna')

     else if ((znak=#13) and (l^.dane.typ='w')) or ((znak='w') or (znak='W')) then write('wedlina');

     if znak#13 then l^.dane.typ:=znak;


     { wedlina }

     if l^.dane.typ='w' then

       begin

          { nazwa wyrobu}

          gotoxy(1,22); write(' ');

          gotoxy(10,15); write('Nazwa wyrobu................. ');

          nowa:='';

          gotoxy(40,15); readln(nowa);

          if length(nowa)0 then l^.dane.nazwa:=nowa

          else

              begin

                   gotoxy(40,15);

                   write(l^.dane.nazwa);

              end;


          {cena jednostkowa}

          gotoxy(1,22); write('Cena: np. 15.99 ');

          gotoxy(10,16); write('Cena jednostkowa (zl/kg)..... ');

          nowa:='';

          gotoxy(40,16); readln(nowa);

          if length(nowa)0 then

             begin

                  val(nowa, zar, i);

                  if i=0 then l^.dane.zar:=zar;

             end

          else

              begin

                   gotoxy(40,16);

                   write(l^.dane.zar:4:2);

              end;

       end;


     {mezczyzna}

     if l^.dane.typ='m' then

       begin

          {nazwa czesci rzezniczej}

          gotoxy(10,15); write('Nazwa czesci rzezniczej...... ');

          nowa:='';

          gotoxy(40,15); readln(nowa);

          if length(nowa)0 then l^.dane.nazwa:=nowa

          else

              begin

                   gotoxy(40,15);

                   write(l^.dane.nazwa);

              end;


          {rodzaj miesa}

          gotoxy(1,22); write('Np. wieprzowina, wolowina, drob...');

          gotoxy(10,16); write('Rodzaj miesa................. ');

          nowa:='';

          gotoxy(40,16); readln(nowa);

          if length(nowa)0 then l^.dane.rodzaj:=nowa

          else

              begin

                   gotoxy(40,16);

                   write(l^.dane.rodzaj);

              end;


          {cena jednostkowa}

          gotoxy(1,22); write('Cena: np. 15.99 ');

          gotoxy(10,17); write('Cena jednostkowa (zl/kg)..... ');

          nowa:='';

          gotoxy(40,17); readln(nowa);

          if length(nowa)0 then

             begin

                  val(nowa, zar, i);

                  if i=0 then l^.dane.zar:=zar;

             end

          else

              begin

                   gotoxy(40,17);

                   write(l^.dane.zar:4:2);

              end;

       end;


     gotoxy(1,20);write('Zmodyfikowano dane...');

     sortuj(l);

     delay(1500);

end;


procedure zapisz_do_pliku;

          var plik:file of osoba;

begin

     {$I-}

     assign(plik, sciezka);

     rewrite(plik);

     {$I+}


     gotoxy(1,25);

     if ioresult0 then exit;

     while l^.pnil do l:=l^.p;

     while l^.n nil do

           begin

                write(plik, l^.dane);

                writeln(l^.dane.nazwa); delay(30);

                l:=l^.n;

           end;

     write(plik, l^.dane);

     writeln(l^.dane.nazwa); delay(30);


     write('--------------- zapisano'); delay(100);

     close(plik);

end;




procedure odczytaj_z_pliku;

          var plik:file of osoba;

              dane:osoba;

begin

     {$I-}

     assign(plik, sciezka);

     reset(plik);

     {$I+}

     if ioresult0 then exit;

     while not eof(plik) do

           begin

                read(plik, dane);

                dodaj(l, dane);

                writeln(dane.nazwa);

                delay(50);

           end;

     close(plik);

     writeln;write('odczytano...');delay(200);

end;





procedure przegladaj(var l:lista; jak,ile:integer);

          var znak:char;

begin

     if l=nil then

        begin

             gotoxy(1,20);

             writeln('Pusto w lodowce.... ');

             delay(1500);

             exit;

        end;

     while l^.pnil do l:=l^.p;

     repeat

           clrscr;

           gotoxy(1,1);write(' BIURO MATRYMONIALNE');

           gotoxy(1,2);write('--------------------------------------------------------------------------------');

           gotoxy(1,24);

           write('--------------------------------------------------------------------------------');

           gotoxy(1,25);

           if jak=1 then write('U usun M modyfikuj + dalej - wstecz X powrót')

                    else write('Znaleziono: ',ile:3,' + dalej - wstecz X powrót');


           if l=nil then break;


           gotoxy(10, 9); write(' ');

           gotoxy(10,10); write(' ');

           gotoxy(10,11); write(' ');

           gotoxy(10,12); write(' ');


           gotoxy(10, 9); write('Typ: ');

           if l^.dane.typ='m' then write('mezczyzna') else write('wedlina');


           if l^.dane.typ='w' then

              begin

                   gotoxy(10,10); write('Nazwa wyrobu: ', l^.dane.nazwa);

                   gotoxy(10,11); write('Cena jednostkowa: ', l^.dane.zar:4:2,' zl/kg');

              end;


           if l^.dane.typ='m' then

              begin

                   gotoxy(10,10); write('Nazwa czesci rzezniczej: ', l^.dane.nazwa);

                   gotoxy(10,11); write('Rodzaj miesa: ', l^.dane.rodzaj);

                   gotoxy(10,12); write('Cena jednostkowa: ', l^.dane.zar:4:2,' zl/kg');

              end;


           repeat znak:=readkey

           until znak in ['u','U','z','Z','+','=','-','x','X'];

           case znak of

                'u', 'U': if jak=1 then usun_miesko(l);

                'z', 'Z': if jak=1 then modyfikacja;

                '+', '=': if l^.nnil then l:=l^.n;

                '-' : if l^.pnil then l:=l^.p;

           end;

     until (znak='x') or (znak='X');

end;




procedure wyjscie;

begin

     gotoxy(1,20); write('Na pewno? [t/n]');

     repeat znak:=readkey;

     until (znak='t') or (znak='T') or (znak='n') or (znak='N');


     if (znak='t') or (znak='T') then

        begin

             zapisz_do_pliku;

             while lnil do usun(l);

             writeln;

             delay(200);

             clrscr;

             halt;

        end

     else

         begin

              gotoxy(1,20); write(' ');

              exit;

         end;


end;


begin



     odczytaj_z_pliku;

     sortuj(l);


     repeat

           rysuj_ekran_menu;

           znak:=readkey;

           case znak of

                'd', 'D' : dodaj_miesko;

                's', 'S' : znajdz;

                'p', 'P' : przegladaj(l,1,0);

                'x', 'X' : wyjscie;

           end;

     until false;


end.

Siedzę już nad tym parę dni i nic z tego nie wychodzi, byłbym wdzięczny za pomoc .


(Gina Gina) #2

W mojej kompilacji (TP7) ten błąd nie ujawnia się ;/

Prawdopodobnie pojawia się w pewnym układzie danych ....

Polecam Google

http://www.google.pl/search?hl=pl&q=Exi ... Google&lr=

a szczególnie

http://groups.google.pl/group/pl.comp.l ... 201&rnum=2