Procedura zapisu do pliku

0

Witam, głowie się juz od kilku godzin z taka procedura zapisu do pliku struktury:

type
artists=^artist;
albums=^album;
songs=^song;

artist=record
  title:string;
  //id:integer;
  next:artists;
end;

album=record
  title:string;
  artist:artists;
  sizeA:integer;
  sizes:integer;
  song:songs;
  next:albums;
end;

song=record
  title:string;
  feature:artists;
  size:integer;
  next:songs;
end; 

procedure save(var AlbumH:albums;name:string);
var basealbums:file of albums;
    baseartists:file of artists;
    basefeatures:file of artists;
    basesongs:file of songs;
    temp,tail:albums;
    temp1,tail1,temp5:artists;
    temp2,tail2:songs;
    ArtistSize,FeaturesSize,SongsSize:integer;
begin
  assign(basealbums,name+'albums');
  assign(basesongs,name+'songs');
  assign(baseartists,name+'artists');
  assign(basefeatures,name+'artists');
  //writeln('Podaj nazwe bazy, umieszczonej w tym samym folderze);
  rewrite(baseartists);
  close(baseartists);
  //IF IOResult<>0 then writeln('Baza o taki nazwie nie moze zostac odczyta, wpisz poprawna nazwe');
  rewrite(basealbums);
  //IF IOResult<>0 then writeln('Baza o taki nazwie nie moze zostac odczyta, wpisz poprawna nazwe');
  rewrite(basesongs);
  //IF IOResult<>0 then writeln('Baza o taki nazwie nie moze zostac odczyta, wpisz poprawna nazwe');
  rewrite(basefeatures);
  //IF IOResult<>0 then writeln('Baza o taki nazwie nie moze zostac odczyta, wpisz poprawna nazwe');
  close(basefeatures);
  writeln('test');
  ArtistSize:=0;
  writeln(ArtistSize);
  while(AlbumH<>nil) do
    begin

     while(AlbumH^.artist<>nil) do
       begin
        ArtistSize:=1+ArtistSize;
        reset(baseartists);        
        seek(baseartists,FileSize(baseartists));
        writeln(FileSize(baseartists));
        write(baseartists,AlbumH^.artist);
        temp1:=AlbumH^.artist^.next;
        dispose(AlbumH^.artist);
        AlbumH^.artist:=temp1;
        //writeln(AlbumH^.artist^.title);
        readln;
        close(baseartists);
       end;
     SongsSize:=0;
     while(AlbumH^.song<>nil) do
       begin
        SongsSize:=1+SongsSize;
        FeaturesSize:=0;
        //AlbumH^.song:=AlbumH^.song^.next;
        while (AlbumH^.song^.feature<>nil) do
          begin
           FeaturesSize:=FeaturesSize+1;
           reset(basefeatures);
           seek(basefeatures,FileSize(basefeatures));
           write(basefeatures,AlbumH^.song^.feature);
           temp1:=AlbumH^.song^.feature^.next;
           dispose(AlbumH^.song^.feature);
           AlbumH^.song^.feature:=temp1;
           close(basefeatures);
          end;
        AlbumH^.song^.size:=FeaturesSize;
        write(basesongs,AlbumH^.song);
        temp2:=AlbumH^.song^.next;
        dispose(AlbumH^.song);
        AlbumH^.song:=temp2;
       end;
     AlbumH^.sizeA:=ArtistSize;
     AlbumH^.sizeS:=SongsSize;
     write(basealbums,AlbumH);
     temp:=AlbumH^.next;
     dispose(AlbumH);
     AlbumH:=temp;

    end;
  close(basealbums);
  close(basesongs);
//KONIEC
 //SPRAWDZENIE(TUTAJ WYRZUCA PUSTE ODPOWEIDZI,zapisywane elemnty istnieja, i sa usuwane z pamięci);
        reset(baseartists);       
        seek(baseartists,1);
        close(basealbums);
        reset(basealbums);
        seek(basealbums,1);
        new(temp);
        read(basealbums,temp);
        writeln(temp^.title,'NIEMA?');
                readln;
        close(baseartists);
  close(basealbums);
  close(basesongs);
end; 

Procedura poprawnie usuwa pamięć, jednak do plików, nie jest nic zapisywane, co sprawdzałem sobie nawet wewnątrz, tej samej procedury.
Procedura nie wyrzuca bledow, i porpawnei czysci pamięć o czym wspomniałem wyżej, wiec dobrze porusza się po zapisywanej strukturze.
Dzięki bardzo za jaką kolwiek pomoc.

1

Ta procedura to jest jeden wielki WTF. Skasuj i napisz jeszcze raz.

Milion razy zamykasz i otwierasz pliki nie wiadomo po co. Zapisujesz wskaźniki do pliku. Jakieś niepotrzebne seek wstawiasz. Przeczytaj jakiś kurs. A to co tu "stworzyłeś" skasuj.

Podejrzewam, że ta procedura jest częścią większego programu. Jeśli ten program jest napisany tak jak ta procedura to skasuj cały i napisz jeszcze raz po przeczytaniu kursu

1

i jeszcze totitle:string; (i podobne) się nie zapisze poprawnie

0
babubabu napisał(a):

Ta procedura to jest jeden wielki WTF. Skasuj i napisz jeszcze raz.

Milion razy zamykasz i otwierasz pliki nie wiadomo po co. Zapisujesz wskaźniki do pliku. Jakieś niepotrzebne seek wstawiasz. Przeczytaj jakiś kurs. A to co tu "stworzyłeś" skasuj.

Podejrzewam, że ta procedura jest częścią większego programu. Jeśli ten program jest napisany tak jak ta procedura to skasuj cały i napisz jeszcze raz po przeczytaniu kursu

Dzięki. Z kursem zaznajomiłem się już wcześniej. Dlaje nie wiem gdzie robie błąd. To nowy kod zapisu, dużo uproszczony. Dlaczego przy odczycie nic mi nie wyświetla. Struktury pozostały takie same.

procedure save(var AlbumH:albums;name:string);
var basealbums:file of albums;

    temp:albums;

begin
  assign(basealbums,name+'albums');

  rewrite(basealbums);

  write(basealbums,AlbumH);
  temp:=AlbumH^.next;
  dispose(AlbumH);
  AlbumH:=temp;

  close(basealbums);
//Czytanie
        reset(basealbums);
        //seek(basealbums,1);
        new(temp);
        read(basealbums,temp);
        writeln(temp^.title,':Album');
        close(basealbums);
end;   
0
abrakadaber napisał(a):

i jeszcze totitle:string; (i podobne) się nie zapisze poprawnie

Dlaczego?

0
Thank You napisał(a):
abrakadaber napisał(a):

i jeszcze totitle:string; (i podobne) się nie zapisze poprawnie

Dlaczego?

Dzięki za pomoc. To jak takie coś naprawić?

0
song=record
  title:string[100]; // ustalić stały rozmiar łańcucha...
  feature:artists;
  size:integer;
  next:songs;
end;

...albo nie korzystać z plików typowanych na rzecz amorficznych i strumieni do odczytu/zapisu.

0

I nie zapisuj wskaźników do pliku bo za chwile przylecisz na forum z pytaniem: "czemu lista się nie wczytuje? przecież wszystko dobrze jest" Zapisuj tylko dane do pliku a przy wczytywaniu twórz listę dynamicznie.

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