(* verÄandert : sieher Laden und Speichern , Was ist mit erster ?
Anfang oder erster^.next Anfang ?
*)
(* jetzt 2-fach verkettete Liste ! *)
(**************************************************************************)
(* Programm 8.5 von Rene' Scholz *)
(* Erstellen einer Bibliotheks-kartei mit Funktionen *)
(**************************************************************************)
program bibliothek (input,output);
uses crt;
const
Legal = [ 'E','e','S','s','W','w','L','l',
'A','a','Z','z' ,'K','k', 'I','i' ];
type
wort = string[70];
karte = ^kartei;
kartei = record
Au : wort; (* Autor *)
Bu : wort; (* Buch *)
Vlg : wort; (* Verlag *)
FG : wort; (* Fachgebiet *)
BSN : wort; (* Bestandsnummer *)
next : karte; (* naechste Karte *)
davor : karte; (* vorige Karte *)
end;
bibo_datei = File of kartei;
var erste, aktuelle,
vorige, naechste : karte;
wk : kartei;
bd : bibo_datei;
liste : boolean;
laenge, akt_nummer : integer;
dat : wort;
procedure wln( z : integer); { zeilenvorschub }
var i :integer;
begin
for i:=1 to z do writeln;
end;
procedure dok;
begin
clrscr;
writeln(' Welcome to ** BIBO ** (c) By Rene'' Scholz ');
wln(2);
writeln('Mit BIBO koennen Sie bequem ihre Bibliotheks-Kartei verwalten .');
wln(3);
writeln('Eine Kartei-Karte enthaelt die folgenden Informationen : ');
writeln;
writeln('** Autor, Buch, Verlag, Fachgebiet und Bestandsnummer ** ');
wln(3);
writeln('Sie koennen folgende Aktionen durchfuehren : ');
wln(4);
writeln(' E_infuegen, Streichen, ');
writeln(' K_orrigieren und Anzeigen von Eintraegen . ');
writeln(' W_ildcard-Suche in den Eintraegen . ');
writeln(' L_aden ihrer BiBo-Dateien . ');
writeln(' A_bspeichern ihrer BiBo-Dateien . ');
writeln(' I_nformationen anzeigen . ');
readln;
end;
function Menu : char;
var eg:string[1];
begin
repeat
clrscr;
writeln(' Welcome to ** BIBO ** (c) By Rene'' Scholz ');
wln(3);
writeln(' E_infuegen ');
writeln(' S_treichen ');
writeln(' Z_eigen ');
writeln(' W_ildcard-Suche ');
writeln(' L_aden ');
writeln(' A_bspeichern ');
writeln(' K_orrigieren ');
writeln(' I_nfo''s ');
wln(2);
writeln('Sie beenden ** BIBO ** mit Enter ');
wln(3);
write('Was wollen Sie durchfuehren ? : ');
readln(eg);
until (eg[1] in Legal) or (eg='');
if eg='' then menu:=' '
else menu:=eg[1];
clrscr;
end; { of Menu }
procedure Info;
begin
clrscr;
if liste then
begin
wln(5);
if laenge > 1 then
writeln('Zur Zeit existieren ',laenge,' Eintraege in ihrer Liste .')
else writeln('Zur Zeit existiert 1 Eintrag in ihrer Liste .');
wln(3);
if dat='' then writeln('Sie haben aber noch keine Datei angelegt ! ')
else writeln('Ihre aktuelle Datei ist ---> ',dat);
end
else
begin
writeln('Zur Zeit existiert noch keine Liste !!! ');
wln(5);
writeln('Sie koennen Eintraege einfuegen ',
'oder eine BIBO-Datei einladen . ');
end;
readln;
end; { of Info }
procedure suche_eintrag( nr:integer);
begin
if (akt_nummer < nr) then { Eintrag vorwÄrts suchen }
while (akt_nummer<nr) do
begin aktuelle:=aktuelle^.next; inc(akt_nummer) end
else if (akt_nummer > nr) then { Eintrag rÜckwÄrts suchen }
while (akt_nummer > nr) do
begin aktuelle:=aktuelle^.davor; dec(akt_nummer) end
end; { of suche_eintrag }
procedure zeige_eintrag( nr:integer);
begin
suche_eintrag(nr);
writeln(' --- Eintrag Nr. ' ,nr:6, ' --- ');
writeln;writeln;writeln;
with aktuelle^ do
begin
writeln('Autor : ' , au);
writeln('Buch : ' , bu);
writeln('Verlag : ' , vlg);
writeln('Fachgebiet : ' , FG);
writeln('Bestandsnummer : ' , BSN);
end;
writeln;writeln;writeln;
end; { of zeige_eintrag }
procedure E_infuegen;
var weiter : string[1];
begin
repeat
clrscr;
writeln(' --- Einfuegen von Eintrag Nr. ',laenge+1,
' in Ihre BiBo-Datei --- ');
writeln(' --- Gesamt-Eintraege : ',laenge ,' --- ' );
wln(2);
if laenge > 0 then
begin
suche_eintrag(laenge); { am Ende der Liste einfuegen }
vorige:=aktuelle;
new(aktuelle);
end
else
begin { 1. karte erzeugen }
new(aktuelle);
vorige:=erste;
end;
with aktuelle^ do
begin
repeat write('Autor ? '); readln(au); until au <>'';
repeat write('Buch ? '); readln(bu); until bu <>'';
repeat write('Verlag ? '); readln(vlg); until vlg <>'';
repeat write('Fachgebiet ? '); readln(FG); until FG <>'';
repeat write('Bestandsnummer ? '); readln(BSN); until BSN <>'';
end;
vorige^.next:=aktuelle;
aktuelle^.next:=NIL;
aktuelle^.davor:=vorige;
laenge:=laenge+1;
akt_nummer:=akt_nummer + 1;
wln(4); write('Weiter einfuegen ? (J/n) '); readln(weiter);
until (weiter='N') or (weiter='n');
end; { of einfuegen }
procedure L_aden;
begin
clrscr;
writeln(' --- Einladen Ihrer BiBo-Datei --- ');
wln(2);
writeln(' --- Default Datei ---> Bibo.BIB ');
writeln(' --- Default Extension ---> *.bib ');
wln(3);
write('Welche Datei wollen Sie einladen ? '); readln(dat);
if dat='' then dat:='bibo';
if pos('.',dat)=0 then dat:=dat + '.bib';
wln(2);
writeln(' ---> ',dat);
assign(bd,dat);
reset(bd);
aktuelle :=erste;
vorige :=erste;
laenge:=0;
akt_nummer:=0;
while not eof(bd) do
begin
new(aktuelle);
read(bd,aktuelle^);
vorige^.next:=aktuelle;
aktuelle^.davor:=vorige;
vorige:=aktuelle;
laenge:=laenge + 1;
end;
aktuelle^.next:=NIL;
if laenge > 0 then
begin
akt_nummer:=1;
aktuelle:=erste^.next;
end;
wln(3);
writeln(' ---> Gesamt-Eintraege : ',laenge );
wln(3);
readln;
end; { of Laden }
procedure A_bspeichern;
var i : integer;
temp : karte;
begin
clrscr;
writeln(' --- Abspeichern Ihrer BiBo-Datei --- ');
writeln(' --- Gesamt-Eintraege : ',laenge ,' --- ' );
wln(2);
writeln(' --- Default Datei ---> Bibo.BIB ');
writeln(' --- Default Extension ---> *.bib ');
wln(3);
write('Welche Datei wollen Sie abspeichern ? '); readln(dat);
if dat='' then dat:='bibo';
if pos('.',dat)=0 then dat:=dat + '.bib';
wln(2);
writeln(' ---> ',dat);
assign(bd,dat);
rewrite(bd);
temp:=aktuelle;
aktuelle:=erste;
for i:=1 to laenge do
begin
aktuelle:=aktuelle^.next;
write(bd,aktuelle^);
end;
close(bd);
aktuelle:=temp;
end; { of A_bspeichern }
procedure lese_wildcard ( var wk :kartei);
begin
clrscr;
wln(2);
writeln('Eingaben wie bei DOS, fuer ein beliebiges Wort',
' betaetigen Sie "Enter" . ');
wln(2);
writeln('Beispiel : fuer Autor --> "Sch*" eingeben ');
writeln('oder : fuer Buch --> "*buch*" eingeben ');
wln(2);
writeln('Geben Sie jetzt ihre Wildcards ein : ');
wln(3);
with wk do
begin
write(' Autor ? '); readln(au);
write(' Buch ? '); readln(bu);
write(' Verlag ? '); readln(vlg);
write(' Fachgebiet ? '); readln(FG);
write(' Nummer ? '); readln(BSN);
end;
clrscr;
end; { of lese_wildcard }
function w_wort_vgl ( ws,hs :wort) : boolean;
var i,lws,lhs,lw_string : integer;
erg : boolean;
w_string : wort;
begin
erg:=true;
lws:=length(ws);
lhs:=length(hs);
w_string:=ws;
if ws[lws]='*' then w_string:=copy(ws,1,lws-1);
lw_string:=length(w_string);
if ws[1]='*' then w_string:=copy(w_string,2,lw_string-1);
lw_string:=length(w_string);
if (ws[1]='*') and (ws[lws]='*')
then erg:=(pos(w_string,hs) <> 0)
else if (ws[1]<>'*') and (ws[lws]<>'*')
then erg:=(w_string=hs)
else if (ws[1]='*') and (ws[lws]<>'*')
then erg:=( copy(hs,lhs-lw_string,lw_string) = w_string )
else erg:=(pos(w_string,hs) = 1 );
w_wort_vgl:=erg;
end;
function w_vergleich ( wk :kartei) :boolean;
var erg : boolean;
begin
erg:=true;
with aktuelle^ do
begin
if (wk.au<>'') and (wk.au<>'*')
then
begin
erg:=w_wort_vgl(wk.au , aktuelle^.au) and erg;
end;
if (wk.bu<>'') and (wk.bu<>'*')
then
begin
erg:=w_wort_vgl(wk.bu , aktuelle^.bu) and erg;
end;
if (wk.vlg<>'') and (wk.vlg<>'*')
then
begin
erg:=w_wort_vgl(wk.vlg , aktuelle^.vlg) and erg;
end;
if (wk.FG<>'') and (wk.FG<>'*')
then
begin
erg:=w_wort_vgl(wk.FG , aktuelle^.FG) and erg;
end;
if (wk.BSN<>'') and (wk.BSN<>'*')
then
begin
erg:=w_wort_vgl(wk.BSN , aktuelle^.BSN) and erg;
end;
end; { of with }
w_vergleich:=erg;
end;
procedure W_ildcard_suche;
var i : integer;
eg : string[1];
gef : boolean;
begin
gef:=false;
repeat
clrscr;
writeln(' --- Suchen in Ihrer BiBo-Datei --- ');
writeln(' --- Gesamt-Eintraege : ',laenge:6 ,' --- ' );
lese_wildcard(wk);
aktuelle:=erste;
akt_nummer:=0;
i:=1;
repeat
aktuelle:=aktuelle^.next;
akt_nummer:=akt_nummer + 1;
if w_vergleich(wk) then { gefundenen Eintrag anzeigen }
begin
gef:=true;
clrscr;
writeln(' --- Anzeigen Ihrer BiBo-Datei --- ');
writeln(' --- Gesamt-Eintraege : ',laenge:6,' --- ');
wln(2);
writeln(' --- Eintrag Nr. ' ,i:6, ' --- ');
wln(3);
with aktuelle^ do
begin
writeln('Autor : ' , au);
writeln('Buch : ' , bu);
writeln('Verlag : ' , vlg);
writeln('Fachgebiet : ' , FG);
writeln('Bestandsnummer : ' , BSN);
end;
wln(2);
write(' Enter for more '); readln;
end;
i:=i+1;
until (aktuelle^.next=NIL); { alle Karten wurden angesehen }
wln(3);
if not gef then
writeln(' Es wurden keine passenden Eintraege gefunden !!! ');
wln(2);
write(' Suchen fortsetzen ? (j/N) '); readln(eg);
until (eg='') or (eg[1]='N') or (eg[1]='n');
end; { of W_ildcard_suche }
procedure streiche_eintrag ( nr :integer);
var temp : karte;
begin
suche_eintrag(nr); temp:=aktuelle^.davor;
if nr < laenge then
begin
aktuelle^.davor^.next:=aktuelle^.next;
aktuelle^.next^.davor:=aktuelle^.davor;
end
else aktuelle^.davor^.next:=NIL;
dispose(aktuelle);
dec(laenge); dec(akt_nummer); aktuelle:=temp;
if laenge=0 then begin liste:=false; dat:='' end;
end; { of streiche_eintrag }
procedure S_treichen;
var eg : string[1];
i,n1,n2 : integer;
gef : boolean;
begin
repeat
clrscr;
writeln(' --- Streichen in Ihrer BiBo-Datei --- ');
writeln(' --- Gesamt-Eintraege : ',laenge ,' --- ' );
wln(2);
write('Streichen mit Wild-Cards oder mit Nummern ? (W/n) ');
readln(eg);
if (eg[1]='N') or (eg[1]='n') then
begin
repeat
write(' Nummer des 1. Eintrages ? '); readln(n1);
until n1>0; if n1>laenge then n1:=laenge;
repeat
write(' Nummer des 2. Eintrages ? '); readln(n2);
until n2>=n1; if n2>laenge then n2:=laenge;
for i:=n2 downto n1 do
begin
clrscr;
zeige_eintrag(i);
write(' wollen Sie wirklich diesen Eintrag loeschen ? (j/N) ');
readln(eg);
if (eg[1]='J') or (eg[1]='j') then streiche_eintrag(i);
end; { of for }
end; { of if }
if (eg[1]='W') or (eg[1]='w') or (eg='') then
begin { Wildcard-loeschen }
gef:=false;
lese_wildcard(wk); { hier auch CLS }
i:=1;
repeat
suche_eintrag(i);
if w_vergleich(wk) then { gefundenen Eintrag anzeigen }
begin
gef:=true;
clrscr;
zeige_eintrag(i);
write('Wollen Sie wirklich diesen Eintrag loeschen ? (j/N) ');
readln(eg);
if (eg[1]='J') or (eg[1]='j') then
begin
streiche_eintrag(i);
i:=i-1;
end;
end;
i:=i+1;
until (aktuelle^.next=NIL); { alle Karten wurden angesehen }
wln(3);
if not gef then
writeln(' Es wurden keine passenden Eintraege gefunden !!! ');
wln(2);
end;
write(' Streichen fortsetzen ? (j/N) '); readln(eg);
until (eg='') or (eg[1]='N') or (eg[1]='n');
end; { of S_treichen }
procedure aendere_eintrag; { den jeweils aktuellen Eintrag ! }
const Komponenten = [ 'A','a', 'B','b', 'V','v', 'F','f', 'N','n' ];
var eg : string[1];
begin
repeat
writeln('Was wollen Sie korrigieren : A_utor ');
writeln(' B_uch ');
writeln(' V_erlag ');
writeln(' F_achgebiet ');
writeln(' N_ummer ');
wln(2);
write(' ? '); readln(eg);
until (eg[1] in Komponenten) or (eg='');
wln(2);
case eg[1] of
'A','a' : begin
write('Autor ? '); readln(aktuelle^.au);
end;
'B','b' : begin
write('Buch ? '); readln(aktuelle^.bu);
end;
'V','v' : begin
write('Verlag ? '); readln(aktuelle^.vlg);
end;
'F','f' : begin
write('Fachgebiet ? '); readln(aktuelle^.FG);
end;
'N','n' : begin
write('Bestands-Nummer ? '); readln(aktuelle^.BSN);
end;
end; { of case }
end; { of aendere_eintrag }
procedure K_orrigieren;
var eg : string[1];
n1,n2,i : Integer;
gef : boolean;
begin
repeat
clrscr;
writeln(' --- Aendern Ihrer BiBo-Datei --- ');
writeln(' --- Gesamt-Eintraege : ',laenge ,' --- ' );
wln(2);
write('Korrigieren mit Wildcards oder mit Nummern ? (W/n) ');
readln(eg);
if (eg[1]='N') or (eg[1]='n') then
begin { aendern mit Nummern }
repeat
write('Nummer des 1. zu korrigierenden Eintrags ? '); readln(n1);
until (n1>0);
if n1>laenge then n1:=laenge;
repeat
write('Nummer des 2. zu korrigierenden Eintrags ? '); readln(n2);
until (n2>=n1);
if n2>laenge then n2:=laenge;
for i:=n1 to n2 do
begin
clrscr;
zeige_eintrag(i);
aendere_eintrag;
end;
end; { of aendern mit Nummern }
if (eg[1]='W') or (eg[1]='w') or (eg='') then
begin { aendern mit Wildcards }
gef:=false;
lese_wildcard(wk); { hier auch CLS }
i:=1;
repeat
suche_eintrag(i);
if w_vergleich(wk) then { gefundenen Eintrag zeigen }
begin
gef:=true;
clrscr;
zeige_eintrag(i);
aendere_eintrag;
end;
i:=i+1;
until (aktuelle^.next=NIL); { alle Karten wurden angesehen }
if not gef then
begin
wln(5);
writeln(' Es wurden keine passenden Eintraege gefunden !!! ');
end;
end;
write(' Korrigieren fortsetzen ? (j/N) ');
readln(eg);
until (eg[1]<>'J') and (eg[1]<>'j');
end; { of Korrigieren }
procedure Z_eigen;
var eg : string[1];
i,n1,n2 : integer;
begin
repeat
clrscr;
writeln(' --- Anzeigen Ihrer BiBo-Datei --- ');
writeln(' --- Gesamt-Eintraege : ',laenge:6,' --- ' );
wln(3);
repeat
write(' 1. anzuzeigender Eintrag ? '); readln(n1);
until (n1>0);
if n1>laenge then n1:=laenge;
repeat
write(' 2. anzuzeigender Eintrag ? '); readln(n2);
until (n2>=n1);
if n2>laenge then n2:=laenge;
for i:=n1 to n2 do { Anzeigen der Eintraege in der Liste }
begin
clrscr;
writeln(' --- Anzeigen Ihrer BiBo-Datei --- ');
writeln(' --- Gesamt-Eintraege : ',laenge:6,' --- ' );
writeln(' Eintraege ',n1,' bis ', n2 );
wln(4);
zeige_eintrag(i);
wln(2);
write(' --> Enter <-- for more '); readln;
end;
{ Eintraege wurden angezeigt }
wln(2);
write(' Anzeigen fortsetzen ? (j/N) ');
readln(eg);
until (eg[1]='N') or (eg[1]='n') or (eg='');
end; { of Z_eigen }
(* ------------- This is the Main-Program of BIBO ------------------ *)
var weiter : string[1];
wahl : char;
begin
clrscr;
write('Wollen Sie die Dokumentation lesen oder gleich starten ? (j/N) ');
readln(weiter); if (weiter='J') or (weiter='j') then dok;
new(erste);
with erste^ do
begin
au:='';
bu:='';
vlg:='';
FG:='';
BSN:='';
next:=NIL;
davor:=NIL;
end;
liste:=false;
laenge:=0;
akt_nummer:=0;
dat:='';
repeat
wahl:=menu;
case wahl of
'E','e' : begin
E_infuegen;
liste:=true;
end;
'S','s' : begin
if liste then S_treichen
else
begin
writeln('Es ist noch keine Liste vorhanden !!! ');
readln;
end;
end;
'W','w' : begin
if liste then W_ildcard_suche
else
begin
writeln('Es ist noch keine Liste vorhanden !!! ');
readln;
end;
end;
'L','l' : begin
L_aden;
Liste:=true;
end;
'A','a' : begin
if liste then A_bspeichern
else
begin
writeln('Es ist noch keine Liste vorhanden !!! ');
readln;
end;
end;
'Z','z' : begin
if liste then Z_eigen
else
begin
writeln('Es ist noch keine Liste vorhanden !!! ');
readln;
end;
end;
'K','k' : begin
if liste then K_orrigieren
else
begin
writeln('Es ist noch keine Liste vorhanden !!! ');
readln;
end;
end;
'I','i' : Info;
end; { of case }
until wahl=' ';
clrscr;
writeln('By.');
end.