Struktury dynamiczne- problem

0

Witam.
Robie program w pascalu (bazę danych) i nie potrafie dalej przejść. Oto program :

program baza_adresowa;
uses crt,sysutils;

type
Plista = ^Tlista;
Tlista = record

                   nazwisko : string;
                   imie     : string;
                   telefon  : string;
                   adres    : string;
                   miasto   : string;
                   nast1    : Plista;
                   pop1     : plista;
                 end;
        tfile = file of tlista;

var
glowa : plista;
Nowy : plista;
menu : char;
BazaP : tfile;

procedure wstaw(nowy : Plista; var glowa : Plista);
var temp : Plista;
begin
temp := glowa;
new(glowa);
with glowa^ do begin

  glowa<sup>.nazwisko     := nowy</sup>.nazwisko;
  glowa<sup>.imie         := nowy</sup>.imie;
  glowa<sup>.adres        := nowy</sup>.adres;
  glowa<sup>.telefon      := nowy</sup>.telefon;
  glowa<sup>.miasto       := nowy</sup>.miasto;
  nast1    := temp;
end;

end;

procedure usun;
var
temp,delete : Plista;
naz : string;
tele: string;
znaleziono : boolean;
begin

writeln('Podaj nazwisko osoby : ');
readln(naz);
writeln('Podaj numer telefonu osoby : ');
readln(tele);
begin
temp:=glowa;
znaleziono:=false;
while( (temp <> nil) and ( not znaleziono)) do
begin
if (temp.nazwisko = naz) and (temp.telefon = tele) then
begin
glowa:=glowa^.nast1;
dispose(temp);
znaleziono:=true;
end
else
temp:=temp^.nast1;
end; {while}
if znaleziono then begin

      end else if (not znaleziono) then
      writeln('Nie ma takiego rekordu. Sprubuj jeszcze raz.');
      readln;

end;
end;
function pokaz(glowa : Plista):integer;
var
temp : plista;
licznik : integer;

begin
licznik:=1;
WriteLn;
if glowa = nil then WriteLn('Lista pusta !!!')
else begin
WriteLn;
temp := glowa;
while temp <> nil do begin
writeln('Numer pozycji = ',licznik); writeln;
writeLn(' Nazwisko : ',temp^.nazwisko);
writeln(' Imie : ',temp^.imie);
writeln(' Adres : ',temp^.adres);
writeln(' Miasto : ',temp^.miasto);
writeln(' Numer tel. : ',temp^.telefon);
temp := temp^.nast1;
Inc(licznik);
end;
end;

pokaz := licznik;

end;

procedure zapiszdoPliku;
var
temp : plista;
begin
temp:=glowa;
assign(bazap,'C:\baza.dat');
rewrite(bazap);
while temp <> nil do
begin
write(bazap,temp^);
temp := temp^.nast1;
end; close(bazap);
writeln;
writeln('Baza zapisana do pliku.Wcisnij ENTER.'); readln;
end;

begin

glowa:=nil;

repeat     clrscr;
          WriteLn;
          writeln('A-Dodaj dane do bazy.');
          writeln('B-Usun dane z bazy.');
          writeln('C-Edytuj dane znajdujace sie w bazie');
          writeln('D-Sortuj alfabetycznie wg. nazwiska');
          writeln('E-Wyszukaj osobe lub grupe');
          writeln('F-Zamknij i zapisz baze.');
          writeln('W-Wyjdz bez zapisywania');     writeln;
          writeln('         Wybierz jedna z opcji: ');


          readln(menu);

            case upcase(menu) of
              'A' : begin

              New(Nowy);
              with Nowy^ do begin

              Write('Podaj nazwisko: ');
              ReadLn( nazwisko );

              Write('Podaj imie: ');
              ReadLn( imie );

              write('Podaj adres(ulice oraz numer domu) : ');
              Readln(adres);

              write('Podaj miasto w ktorym mieszkasz : ');
              Readln(miasto);

              write('Podaj numer telefonu: ');
              Readln( telefon );

              nast1 := nil;
              wstaw(nowy,glowa);

              end;
              end;

              'B'  : begin
              if  glowa=nil then begin writeln('Lista pusta. Wcisnij ENTER.'); readln; end else
              if  glowa<>nil then begin
              pokaz(glowa);
              usun;end;
              end;


              'C'  : begin pokaz(glowa);
               end;

              'F'  : begin zapiszdopliku;
              end;

              'W' :;
              else writeln;writeln('Nie ma takiej opcji,wcisnij ENTER zeby wybrac jeszcze raz'); readln;
              end;
              until (menu='w') or (menu='W');

           end.

Proszę o pomoc, na zaliczenie na jutro, :( muszę dokończyć usuwanie z bazy elementów , wczytywanie z pliku, sortowanie, edycję. Proszę Was wszystkich. Proszę :(

0

Co do usuwania, od razu rzuca się w oczy jedna rzecz - zwalniasz z pamięci nie przypisując uprzednio w poprzednim elemencie wskaźnika na następny.

Spróbuj coś takiego:

procedure usun;
var
temp, temp1, delete : Plista;
naz :  string;
tele:  string;
znaleziono : boolean;
begin
  writeln('Podaj nazwisko osoby : ');
  readln(naz);
  writeln('Podaj numer telefonu osoby : ');
  readln(tele);
  temp:=glowa;
  temp1:=nil;
  znaleziono:=false;
  while( (temp <> nil) and ( not znaleziono)) do begin
    if (temp^.nazwisko = naz) and (temp^.telefon = tele) then begin
      if temp1=nil then glowa:=glowa^.nast1
      else temp1^.nast1:=temp^.nast1;
      dispose(temp);
      znaleziono:=true;
      end
    else begin
      temp1:=temp;
      temp:=temp^.nast1;
      end;
    end;     {while}
  if not znaleziono then writeln('Nie ma takiego rekordu. ort! jeszcze raz.');
  readln;
  end;

1 użytkowników online, w tym zalogowanych: 0, gości: 1