[PASCAL] BazaDanych + Zapis, odczyt

0

Witam. Piszę program bazy danych. Natknąłem się jednak na problem którego nie potrafię sam rozwiązać :/. Mam taki oto kod główny :

program Baza_danych;
        {$APPTYPE CONSOLE}
uses sysutils;
type
   PEL_listy= ^TEL_listy;
   TEL_listy= record
   Imie : string[15];
    Nazwisko : string[15];
   Auto : string[25];
   Data : string[12];
   nastepny: PEL_listy;
end;

procedure WstawNaKoniec(nimie,nnazwisko,nauto,ndata : string; var glowa: PEL_listy);
var
 temp,nowy: PEL_listy;
begin
 New(nowy);
 with nowy^ do begin
   Imie:= nimie;
   Nazwisko:=nnazwisko;
   Auto:= nauto;
   Data:= ndata;
   nastepny := nil;
 end;
 if glowa = nil then
   glowa := nowy
 else begin
   temp := glowa;
   while temp^.nastepny <> nil do begin
    temp := temp^.nastepny;
   end;
    temp^.nastepny :=nowy;
   end;
end;

function WypiszListe(glowa : PEL_listy): integer;
var
 temp: PEL_listy;
 licznik : integer;
begin
 licznik :=0;
 Writeln;
 if glowa = nil then
   writeln('Lista pusta !!!')
 else begin
   writeln('Zawartosc listy:');
   temp := glowa;
   while temp <> nil do begin
    write(licznik+1,'.','Imie i nazwisko:',temp^.Imie,' ',temp^.Nazwisko,'  ','Auto:',temp^.Auto,
    '  ','Data:',temp^.Data);
    writeln;
    temp:= temp^.nastepny;
    writeln;
    inc(licznik);
   end;
 end;
 writeln;
 WypiszListe := licznik;
end;

function Znajdz(szuk_imie,szuk_nazwisko :string;glowa:PEL_listy):PEL_listy;
var
 temp: PEL_listy;
begin
 temp:= glowa;
 write('Przeszukiwanie listy:');
 while temp <> nil do begin
 write('.');
   if (temp^.nazwisko = szuk_nazwisko) and (temp^.Imie = szuk_imie) then
    break
   else
    temp := temp^.nastepny;
 end;
 writeln;
 Znajdz := temp;
end;

function UsunListe(var glowa: PEL_listy):integer;
var
 temp: PEL_listy;
 licznik: integer;
begin
 licznik := 0;
 writeln;
 write('Usuwanie listy: ');
 while glowa <> nil do begin
   write('.');
   inc(licznik);
   temp:= glowa^.nastepny;
   dispose(glowa);
   glowa :=temp;
 end;
 UsunListe := licznik;
end;

var
 glowa : PEL_listy;
 temp : PEL_listy;
 opcja: char;
 i : integer;
 imie,nazwisko,auto,data :string;

begin
 glowa := nil;
 temp := nil;
 repeat
   Writeln;
   writeln('a. Dodaj nowe wyporzyczenie');
   writeln('b. Wypisz zawartosc listy');
   writeln('c. Znajdz..');
   writeln('d. Usun liste');
   writeln('x. Wroc');
   writeln;
   writeln('Twoj wybor:');
   readln(opcja);

   case UpCase(opcja) of
    'A' : begin
          writeln;
          writeln('Podaj imie:');
          readln(imie);
          writeln;
          writeln('Podaj nazwisko');
          readln(nazwisko);
          writeln;
          writeln('Podaj auto');
          readln(auto);
          writeln;
          writeln('Podaj date');
          readln(data);
          WstawNakoniec(imie,nazwisko,auto,data,glowa);
         end;
    'B' : WypiszListe(glowa);
    'C' : begin
          writeln;
          writeln('Podaj szukane imie: ');
          readln(imie);
          writeln('Podaj szukane nazwisko: ');
          readln(nazwisko);
          temp := Znajdz(imie,nazwisko,glowa);
          if temp = nil then
            writeln(' Szukane dane nie znajduja sie w liscie')
          else
            writeln;
            writeln('Znaleziono element: ');
            writeln('Imie i nazwisko:',temp^.Imie,' ',temp^.Nazwisko,' ','Auto:',temp^.Auto,
    ' ','Data:',temp^.Data );
         end;
    'D' : begin
          writeln;
          write('Czy na pewno chcesz usunac liste [T- usun]???');
          readln(opcja);
          if Upcase (opcja) = 'T' then
            UsunListe(glowa)
          else
            Writeln('Usuwanie listy anulowano !!!');
         end;
    'X' :;
    else Writeln('Niepoprawna opcja.');
   end;
   until (opcja = 'x') or (opcja= 'X');
   writeln;
   writeln;
   writeln('Wcisnij ENTER by zakonczyc prace...');
   readln;
end.

Teraz nie wiem jak połączyć ten poniższy kod, tak aby była możliwość zapisu do pliku, odczytu, wyszukiwania z pliku tak aby wszystko chodziło.

procedure ZapiszDoPliku(nazwa_pl: string; glowa: PEL_listy);
var
  P: File of TEL_listy;
  EL_bierz: PEL_listy;
  buf: TEL_listy;
begin
     Assign(P,nazwa_pl);
     Rewrite(P);
     EL_bierz := glowa;
     while EL_bierz <> nil do
           begin
                buf := EL_bierz^;
                Write(P, buf);
                EL_bierz := EL_bierz^.nastepny;
           end;
     Close(P);
end;

procedure OdczytajZPliku(nazwa_pl: string; var glowa: PEL_listy);
var
  P: File of TEL_listy;
  EL_bierz: PEL_listy;
  buf: TEL_listy;
begin
     Assign(P, nazwa_pl);   {$I-}
     Reset(P);              {$I+}
     if IOResult <> 0 Then Exit;
     New(EL_bierz);
     glowa := EL_bierz;
           while not Eof(P) do
                 begin
                      Read(P, buf);
                      EL_bierz^ := buf;
                      If not Eof(P) then
                         begin
                              New(EL_bierz^.nastepny);
                              EL_bierz := EL_bierz^.nastepny;
                         end else
                             EL_bierz^.nastepny := nil;
                         end;
end;

Proszę o pomoc osób które się znają na tym. Zapewne nie jest to skomplikowane ale dla mnie jako średnio zaawansowanego stwarza problem :/

0

Mrowa, kilka rad:

Nie używaj zmiennej IOResult, bo to sie kłóci z ideą windowsa. Dawniej w TP, owszem. W windowsie używa się klamr try..except..finally.end
Wyjątki

Następnie:
Wygodniej korzystać z klasy TFileStream, zamiast Read/Write. Generuje ona wyjątki za nas.
Strumienie

Olej bazę na własnym formacie i zainteresuj się SQLite (wiem co mówię, bo poświęciłem 15000 wierszy kodu na samą obsługę bazy).

A teraz do sedna:
masz drabinkę case..of

case UpCase(Opcja) of
 'A' :begin end;
 'B' :begin end;
 'L' :begin LoadFromFile(FileName); end;
 'S' :begin SaveToFile(FileName); end;
end; // case

Czy ty aby na pewno sam to pisałeś :>

0

Tą bazę znalazłem w internecie, ale moja wiedza na temat Pascala nie jest jeszcze na super poziomie ;) I nie mam pojęcia na razie jak rozwiązać ten problem co opisałem :/ :-/

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